1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
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;
|
