with FLTK.Screen, FLTK.Event, Misc; package body Displays is package WD renames FLTK.Widgets.Groups.Windows.Double; package B renames FLTK.Widgets.Boxes; function Create (X, Y, W, H : in Integer; Text : in String) return Display is My_Width : Integer := Misc.Max (Message_Box_Width, W); My_Height : Integer := Misc.Max (Message_Box_Height + Stat_Box_Height, H); begin return This : Display := (WD.Double_Window'(WD.Forge.Create (X, Y, My_Width, My_Height, Text)) with Message_Box => B.Box'(B.Forge.Create (0, 0, Message_Box_Width, Message_Box_Height, "")), Level_Box => B.Box'(B.Forge.Create (0, Message_Box_Height, Stat_Box_Width, Stat_Box_Height, "")), Move_Box => B.Box'(B.Forge.Create (Stat_Box_Width, Message_Box_Height, Stat_Box_Width, Stat_Box_Height, "")), Current_Grid => null, Key_Func => null, Mouse_Func => null) do This.Add (This.Message_Box); This.Add (This.Level_Box); This.Add (This.Move_Box); This.Message_Box.Set_Label_Size (Text_Size); This.Level_Box.Set_Label_Size (Text_Size); This.Move_Box.Set_Label_Size (Text_Size); This.Set_Icon (Logo); end return; end Create; function Create (W, H : in Integer) return Display is begin return Create (0, 0, W, H, "Sokoban"); end Create; function Create return Display is begin return Create (0, 0, Message_Box_Width, Message_Box_Height, "Sokoban"); end Create; procedure Set_Grid (This : in out Display; To : in out Grids.Grid) is begin if This.Current_Grid /= null then This.Remove (This.Current_Grid.all); end if; This.Current_Grid := To'Unchecked_Access; This.Add (To); This.Ensure_Correct_Size; end Set_Grid; procedure Adjust_Grid (This : in out Display; Cols, Rows : in Natural) is begin This.Current_Grid.Set_Cols (Cols); This.Current_Grid.Set_Rows (Rows); This.Ensure_Correct_Size; end Adjust_Grid; procedure Ensure_Correct_Size (This : in out Display) is New_Width : Integer := Misc.Max (Message_Box_Width, This.Current_Grid.Get_W); New_Height : Integer := Message_Box_Height + This.Current_Grid.Get_H + Stat_Box_Height; Grid_X : Integer := Misc.Max (0, (Message_Box_Width - This.Current_Grid.Get_W) / 2); begin This.Current_Grid.Reposition (Grid_X, 0); This.Message_Box.Resize (New_Width, This.Message_Box.Get_H); This.Message_Box.Reposition (This.Message_Box.Get_X, This.Current_Grid.Get_H); This.Level_Box.Resize (New_Width / 2, This.Level_Box.Get_H); This.Level_Box.Reposition (0, New_Height - Stat_Box_Height); This.Move_Box.Resize (New_Width / 2, This.Move_Box.Get_H); This.Move_Box.Reposition (New_Width / 2, New_Height - Stat_Box_Height); This.Resize (New_Width, New_Height); end Ensure_Correct_Size; procedure Centre_On_Screen (This : in out Display) is use FLTK.Screen; begin This.Reposition (Get_X + (Get_W - This.Get_W) / 2, Get_Y + (Get_H - This.Get_H) / 2); 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_Level_Number (This : in out Display; To : in Natural) is begin This.Level_Box.Set_Label ("Level:" & Natural'Image (To)); end Set_Level_Number; procedure Set_Move_Number (This : in out Display; To : in Natural) is begin This.Move_Box.Set_Label ("Moves:" & Natural'Image (To)); end Set_Move_Number; procedure Set_Keyboard_Callback (This : in out Display; Func : in Keyboard_Callback) is begin This.Key_Func := Func; end Set_Keyboard_Callback; procedure Set_Mouse_Callback (This : in out Display; Func : in Mouse_Callback) is begin This.Mouse_Func := Func; end Set_Mouse_Callback; function Handle (This : in out Display; Event : in FLTK.Event_Kind) return FLTK.Event_Outcome is use type FLTK.Event_Kind, FLTK.Event_Outcome; begin if This.Key_Func /= null and then Event = FLTK.Keydown and then This.Key_Func (FLTK.Press (FLTK.Event.Last_Key)) = FLTK.Handled then return FLTK.Handled; elsif This.Mouse_Func /= null and then Event = FLTK.Release and then This.Mouse_Func (FLTK.Event.Mouse_X, FLTK.Event.Mouse_Y) = FLTK.Handled then return FLTK.Handled; else return WD.Double_Window (This).Handle (Event); end if; end Handle; end Displays;