1 files changed, 135 insertions, 0 deletions
diff --git a/src/displays.adb b/src/displays.adb
new file mode 100644
index 0000000..dcb3932
--- /dev/null
+++ b/src/displays.adb
@@ -0,0 +1,135 @@
+
+
+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;
+