with FLTK.Screen; package body Displays is package WD renames FLTK.Widgets.Groups.Windows.Double; package B renames FLTK.Widgets.Boxes; function Max (A, B : in Integer) return Integer is begin if B > A then return B; else return A; end if; end Max; function Min (A, B : in Integer) return Integer is begin if B < A then return B; else return A; end if; end Min; function Create (X, Y, W, H : in Integer; 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 return This : Display := (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 This.Add (This.Message_Box); This.Message_Box.Set_Label_Size (Text_Size); 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 := Max (Message_Box_Width, This.Current_Grid.Get_W); New_Height : Integer := Message_Box_Height + This.Current_Grid.Get_H; Grid_X : Integer := 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.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; end Displays;