diff options
Diffstat (limited to 'src/displays.adb')
| -rw-r--r-- | src/displays.adb | 50 |
1 files changed, 42 insertions, 8 deletions
diff --git a/src/displays.adb b/src/displays.adb index dcb3932..03a0d43 100644 --- a/src/displays.adb +++ b/src/displays.adb @@ -2,7 +2,8 @@ with - FLTK.Screen; + FLTK.Screen, + FLTK.Event; package body Displays is @@ -32,11 +33,6 @@ package body Displays is Text : in String) return Display is - Message_Text : String := - "Move with the arrow keys. Press u for undo." & ASCII.LF & - "To move to a square where there is a clear path, click with the mouse." & ASCII.LF & - "Press n to skip this level, q to quit, and r to restart this level."; - My_Width : Integer := Max (Message_Box_Width, W); My_Height : Integer := Max (Message_Box_Height, H); begin @@ -44,8 +40,9 @@ package body Displays is (WD.Double_Window'(WD.Create (X, Y, My_Width, My_Height, Text)) with Message_Box => B.Box'(B.Create - (0, 0, Message_Box_Width, Message_Box_Height, Message_Text)), - Current_Grid => null) do + (0, 0, Message_Box_Width, Message_Box_Height, "")), + Current_Grid => null, + Key_Func => null) do This.Add (This.Message_Box); This.Message_Box.Set_Label_Size (Text_Size); @@ -131,5 +128,42 @@ package body Displays is end Centre_On_Screen; + + + procedure Set_Message + (This : in out Display; + Msg : in String) is + begin + This.Message_Box.Set_Label (Msg); + end Set_Message; + + + + + procedure Set_Keyboard_Callback + (This : in out Display; + Func : in Keyboard_Callback) is + begin + This.Key_Func := Func; + end Set_Keyboard_Callback; + + + + + function Handle + (This : in out Display; + Event : in FLTK.Event_Kind) + return FLTK.Event_Outcome + is + use type FLTK.Event_Kind; + begin + if This.Key_Func /= null and Event = FLTK.Keydown then + return This.Key_Func (FLTK.Event.Last_Keypress); + else + return WD.Double_Window (This).Handle (Event); + end if; + end Handle; + + end Displays; |