-
Notifications
You must be signed in to change notification settings - Fork 0
/
snake.ada
283 lines (215 loc) · 7.58 KB
/
snake.ada
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Vectors;
package Snake is
-- Keyboard management
type directions is (Up, Down, Right, Left, Quit, Restart, Invalid);
-- Redefining this standard procedure as function to allow Get_Keystroke as an expression function
function Get_Immediate return Character;
Arrow_Prefix : constant Character := Character'Val(224); -- works for windows
function Get_Keystroke return directions;
-- )
-- The container for game data
type gameBoard is array (Natural range <>, Natural range <>) of Character;
-- Initilize the board
procedure init;
-- Run the game
procedure run;
-- Displaying the board
procedure Display_Board;
-- Clear the board from content
procedure ClearBoard;
-- coordinates data structure
type coord is tagged record
X,Y : Integer;
end record;
-- list of coordinate (one coordinate for each body part of the snake)
package snakeBody is new Ada.Containers.Vectors (Natural, coord);
use snakeBody;
-- update snake's part depending on the snakeDirection and checking colicion (with borders and snak's part)
function moveSnake return Boolean;
-- generate food if it was eaten
procedure generateFood;
-- Add snake and food to the board
procedure addDataToBoard;
-- generate random integer between 1 and upperBound to generate random food position
function getRandomInteger(upperBound : Integer) return Integer;
private
width, height : Positive := 10;
board : gameBoard := (0 .. (width+1) => (0 .. (height+1) => ' '));
snake : Vector := (1,1) & (2,1) & (3,1);
snakeDirection : directions := Right;
food : coord := (5,5);
end Snake;
-- Snake.adb
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
package body Snake is
-----------------------------------------------------------------------------
-- Redefining this standard procedure as function to allow Get_Keystroke as an expression function (copy from 2048 game)
function Get_Immediate return Character is
begin
return Answer : Character do Ada.Text_IO.Get_Immediate(Answer);
end return;
end Get_Immediate;
-----------------------------------------------------------------------------
-- (copy from 2048 game)
function Get_Keystroke return directions is
(case Get_Immediate is
when 'Q' | 'q' => Quit,
when 'R' | 'r' => Restart,
when 'W' | 'w' => Left,
when 'A' | 'a' => Up,
when 'S' | 's' => Down,
when 'D' | 'd' => Right,
-- Windows terminal
when Arrow_Prefix => (case Character'Pos(Get_Immediate) is
when 72 => Up,
when 75 => Left,
when 77 => Right,
when 80 => Down,
when others => Invalid),
-- Unix escape sequences
when ASCII.ESC => (case Get_Immediate is
when '[' => (case Get_Immediate is
when 'A' => Up,
when 'B' => Down,
when 'C' => Right,
when 'D' => Left,
when others => Invalid),
when others => Invalid),
when others => Invalid);
-----------------------------------------------------------------------------
procedure init is
begin
for Row in 0 .. width+1 loop
for Column in 0 .. height+1 loop
if Row = 0 or Row = width+1 then
board(Row,Column) := '#';
-- Insert(board(Row,0), Column, '#');
else
if Column = 0 or Column = height+1 then
board(Row,Column) := '#';
-- Insert(board, board(Row, Column), "#");
else
board(Row,Column) := ' ';
-- Insert(board, board(Row, Column), " ");
end if;
end if;
end loop;
end loop;
end;
-----------------------------------------------------------------------------
procedure run is
task T;
task body T is
begin
loop
snakeDirection := Get_Keystroke;
end loop;
end T;
begin
init;
loop
exit when snakeDirection = Quit;
if moveSnake = False then
Put_Line("GAME OVER!!!");
Put_Line("Your score is:" & Length(snake)'Image);
exit;
end if;
Display_Board;
delay 0.7;
end loop;
end run;
-----------------------------------------------------------------------------
procedure Display_Board is
begin
for Row in 0 .. width+1 loop
for Column in 0 .. height+1 loop
Put(board(Row, Column));
end loop;
New_Line;
end loop;
end Display_Board;
-----------------------------------------------------------------------------
procedure ClearBoard is
begin
for Row in 1 .. width loop
for Column in 1 .. height loop
board(Row, Column) := ' ';
end loop;
end loop;
end ClearBoard;
-----------------------------------------------------------------------------
function moveSnake return Boolean is
colision : Boolean := False;
headCoord : coord := Snake.First_Element;
addSnakePart : Boolean := False;
begin
case snakeDirection is
when Up => headCoord.X := headCoord.X - 1;
when Down => headCoord.X := headCoord.X + 1;
when Right => headCoord.Y := headCoord.Y + 1;
when Left => headCoord.Y := headCoord.Y - 1;
when others => null;
end case;
if headCoord.Y = height+1 then
return False;
end if;
if headCoord.Y = 0 then
return False;
end if;
if headCoord.X = width+1 then
return False;
end if;
if headCoord.X = 0 then
return False;
end if;
for index in snake.Iterate loop
if headCoord = snake(To_Index(index)) then
return False;
end if;
end loop;
snake.Prepend(headCoord);
if headCoord /= food then
snake.Delete_Last;
else
food := (0,0);
generateFood;
end if;
addDataToBoard;
return True;
end moveSnake;
-----------------------------------------------------------------------------
procedure generateFood is
begin
if food.X = 0 or food.Y = 0 then
food := (getRandomInteger(width), getRandomInteger(height));
end if;
end generateFood;
-----------------------------------------------------------------------------
procedure addDataToBoard is
begin
ClearBoard;
board(food.X, food.Y) := '*';
for index in snake.Iterate loop
board(snake(To_Index(index)).X, snake(To_Index(index)).Y) := 'o';
end loop;
end addDataToBoard;
-----------------------------------------------------------------------------
function getRandomInteger(upperBound : Integer) return Integer is
subtype Random_Range is Integer range 1 .. upperBound;
package R is new
Ada.Numerics.Discrete_Random (Random_Range);
use R;
G : Generator;
begin
Reset (G);
return Random (G);
end getRandomInteger;
end Snake;
-- main.adb
with Snake;
procedure Main is
begin
Snake.run;
end;