[TP] Le jeu du serpent

La troisième partie se termine («Enfin !» diront certains) et nous allons donc la conclure comme il se doit par un troisième TP ! Après avoir hésité entre la conception de divers programmes, tel un éditeur de carte ou un éditeur de texte, je me suis dit qu'après le difficile TP précédent et cette longue partie III, vous aviez bien mérité un TP moins décourageant et plus ludique. C'est pourquoi, après de longues réflexions, j'ai opté pour un jeu : le jeu du Serpent. Vous savez ce vieux jeu que l'on avait sur les vieux portables où un serpent devait manger sans cesse de gros pixels afin de grandir en prenant garde de ne jamais dévorer sa propre queue ou sortir de l'écran.

Comme d'habitude, je vais vous guider dans sa mise en œuvre, et comme d'habitude tout se fera en console mais… avec des couleurs ! Prêts ? Voici une image pour vous mettre en bouche :

Jeu du serpent

Cahier des charges

Fonctionnalités

Comme toujours, avant de nous lancer à l'aveuglette, nous devons définir les fonctionnalités de notre programme, les limites du projet. Il n'est pas question de créer un jeu en 3D ou avec des boutons, des images, une base de données… nous allons faire plus sobre.

Notre programme devra :

  • s'exécuter en console, je vous l'ai dit. Toutefois, nous ferons en sorte d'afficher quelques couleurs pour égayer tout ça et surtout rendre notre programme facilement jouable. Rassurez-vous, je vous fournirais un package pour cela;
  • se jouer en temps réel, pas au tour par tour ! Si le joueur ne touche pas au clavier alors son serpent ira droit dans le mur;
  • gérer et donc éviter les bogues : serpent faisant demi-tour sur lui-même, sortant de la carte ou dont le corps ne suivrait pas la tête dans certaines configurations (je ne rigole pas, vous commettrez sûrement ce genre d'erreur);
  • permettre au joueur de diriger le serpent au clavier à l'aide des touches fléchées.

Organisation des types et variables

Nous ne savons pas quand le joueur perdra, notre serpent devra donc pouvoir s'allonger indéfiniment (en théorie). Il serait donc judicieux d'utiliser les TAD vus précédemment pour enregitrer les différents anneaux de notre reptile : il sera plus aisé d'agrandir notre serpent à l'aide des primitives append ou prepend qu'en déclarant des tableaux ou je ne sais quoi d'autre. De même, déplacer le serpent reviendra simplement à retirer le dernier anneau de son corps pour le placer en premier dans une nouvelle position. Vous avez le choix entre tous les TAD que vous voulez, mais les Doubly_Linked_Lists ou les Vectors sont les mieux adaptés et comme j'ai une préférence pour le type Vector, la solution que je vous fournirai utilise donc… les Doubly_Linked_Lists (cherchez la cohérence :p ).

Mais que contiendra notre liste ? Elle contiendra toute une suite de coordonnées : les coordonnées des différentes parties du corps du serpent. Mais ce n'est pas tout ! Le serpent ne peut se limiter à une liste de coordonnées, il faudra également que notre type T_Serpent contienne la direction de la tête du serpent.

Enfin, la taille de l'aire de jeu, la vitesse de déplacement du serpent ou les couleurs utilisées devraient être enregistrées dans des variables (ou des constantes si besoin) toutes inventoriées dans un package. En faisant cela, ces variables deviendront des variables globales, ce qui est généralement risqué mais clarifiera notre code et simplifiera toute modification des paramètres du jeu. Nous reviendrons sur les variables globales dans la prochaine partie.

Un package bien utile

Le package NT_Console

Depuis le début je vous dis que notre programme sera en couleur, donc il est temps de vous fournir le package nécessaire pour utiliser des couleurs dans la console. Il ne s'agit ni d'un package officiel, ni d'un package de mon crû (mea maxima culpa :( ) mais d'un vieux package mis à notre disposition par Jerry van Dijk et libre de diffusion, appelé NT_Console : 

  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
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
-----------------------------------------------------------------------
--
--  File:        nt_console.adb
--  Description: Win95/NT console support
--  Rev:         0.3
--  Date:        08-june-1999
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1997, 1998, 1999
--  Billie Holidaystraat 28
--  2324 LK  LEIDEN
--  THE NETHERLANDS
--  tel int + 31 71 531 43 65
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

pragma C_Pass_By_Copy (128);

with Interfaces; use Interfaces;

package body NT_Console is

   pragma Linker_Options ("-luser32");

   ---------------------
   -- WIN32 INTERFACE --
   ---------------------

   Beep_Error            : exception;
   Fill_Char_Error       : exception;
   Cursor_Get_Error      : exception;
   Cursor_Set_Error      : exception;
   Cursor_Pos_Error      : exception;
   Buffer_Info_Error     : exception;
   Set_Attribute_Error   : exception;
   Invalid_Handle_Error  : exception;
   Fill_Attribute_Error  : exception;
   Cursor_Position_Error : exception;

   subtype DWORD  is  Unsigned_32;
   subtype HANDLE is  Unsigned_32;
   subtype WORD   is  Unsigned_16;
   subtype SHORT  is  Short_Integer;
   subtype WINBOOL is Integer;

   type LPDWORD is access all DWORD;
   pragma Convention (C, LPDWORD);

   type Nibble is mod 2 ** 4;
   for Nibble'Size use 4;

   type Attribute is
      record
         Foreground : Nibble;
         Background : Nibble;
         Reserved   : Unsigned_8 := 0;
      end record;

   for Attribute use
      record
         Foreground at 0 range 0 .. 3;
         Background at 0 range 4 .. 7;
         Reserved   at 1 range 0 .. 7;
      end record;

   for Attribute'Size use 16;
   pragma Convention (C, Attribute);

   type COORD is
      record
         X : SHORT;
         Y : SHORT;
      end record;
   pragma Convention (C, COORD);

   type SMALL_RECT is
      record
         Left   : SHORT;
         Top    : SHORT;
         Right  : SHORT;
         Bottom : SHORT;
      end record;
   pragma Convention (C, SMALL_RECT);

   type CONSOLE_SCREEN_BUFFER_INFO is
      record
         Size       : COORD;
         Cursor_Pos : COORD;
         Attrib     : Attribute;
         Window     : SMALL_RECT;
         Max_Size   : COORD;
      end record;
   pragma Convention (C, CONSOLE_SCREEN_BUFFER_INFO);

   type PCONSOLE_SCREEN_BUFFER_INFO is access all CONSOLE_SCREEN_BUFFER_INFO;
   pragma Convention (C, PCONSOLE_SCREEN_BUFFER_INFO);

   type CONSOLE_CURSOR_INFO is
      record
         Size    : DWORD;
         Visible : WINBOOL;
      end record;
   pragma Convention (C, CONSOLE_CURSOR_INFO);

   type PCONSOLE_CURSOR_INFO is access all CONSOLE_CURSOR_INFO;
   pragma Convention (C, PCONSOLE_CURSOR_INFO);

   function GetCh return Integer;
   pragma Import (C, GetCh, "_getch");

   function KbHit return Integer;
   pragma Import (C, KbHit, "_kbhit");

   function MessageBeep (Kind : DWORD) return DWORD;
   pragma Import (StdCall, MessageBeep, "MessageBeep");

   function GetStdHandle (Value : DWORD) return HANDLE;
   pragma Import (StdCall, GetStdHandle, "GetStdHandle");

   function GetConsoleCursorInfo (Buffer : HANDLE; Cursor : PCONSOLE_CURSOR_INFO) return WINBOOL;
   pragma Import (StdCall, GetConsoleCursorInfo, "GetConsoleCursorInfo");

   function SetConsoleCursorInfo (Buffer : HANDLE; Cursor : PCONSOLE_CURSOR_INFO) return WINBOOL;
   pragma Import (StdCall, SetConsoleCursorInfo, "SetConsoleCursorInfo");

   function SetConsoleCursorPosition (Buffer : HANDLE; Pos : COORD) return DWORD;
   pragma Import (StdCall, SetConsoleCursorPosition, "SetConsoleCursorPosition");

   function SetConsoleTextAttribute (Buffer : HANDLE; Attr : Attribute) return DWORD;
   pragma Import (StdCall, SetConsoleTextAttribute, "SetConsoleTextAttribute");

   function GetConsoleScreenBufferInfo (Buffer : HANDLE; Info : PCONSOLE_SCREEN_BUFFER_INFO) return DWORD;
   pragma Import (StdCall, GetConsoleScreenBufferInfo, "GetConsoleScreenBufferInfo");

   function FillConsoleOutputCharacter (Console : HANDLE; Char : Character; Length : DWORD; Start : COORD; Written : LPDWORD) return DWORD;
   pragma Import (Stdcall, FillConsoleOutputCharacter, "FillConsoleOutputCharacterA");

   function FillConsoleOutputAttribute (Console : Handle; Attr : Attribute; Length : DWORD; Start : COORD; Written : LPDWORD) return DWORD;
   pragma Import (Stdcall, FillConsoleOutputAttribute, "FillConsoleOutputAttribute");

   WIN32_ERROR          : constant DWORD  := 0;
   INVALID_HANDLE_VALUE : constant HANDLE := -1;
   STD_OUTPUT_HANDLE    : constant DWORD  := -11;

   Color_Value      : constant array (Color_Type) of Nibble := (0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15);
   Color_Type_Value : constant array (Nibble) of Color_Type :=
    (Black, Blue, Green, Cyan, Red, Magenta, Brown, Gray,
     Black, Light_Blue, Light_Green, Light_Cyan, Light_Red,
     Light_Magenta, Yellow, White);

   -----------------------
   -- PACKAGE VARIABLES --
   -----------------------

   Output_Buffer    : HANDLE;
   Num_Bytes        : aliased DWORD;
   Num_Bytes_Access : LPDWORD := Num_Bytes'Access;
   Buffer_Info_Rec  : aliased CONSOLE_SCREEN_BUFFER_INFO;
   Buffer_Info      : PCONSOLE_SCREEN_BUFFER_INFO := Buffer_Info_Rec'Access;

   -------------------------
   -- SUPPORTING SERVICES --
   -------------------------

   procedure Get_Buffer_Info is
   begin
      if GetConsoleScreenBufferInfo (Output_Buffer, Buffer_Info) = WIN32_ERROR then
         raise Buffer_Info_Error;
      end if;
   end Get_Buffer_Info;

   --------------------
   -- CURSOR CONTROL --
   --------------------

   function  Cursor_Visible return Boolean is
      Cursor : aliased CONSOLE_CURSOR_INFO;
   begin
      if GetConsoleCursorInfo (Output_Buffer, Cursor'Unchecked_Access) = 0 then
         raise Cursor_Get_Error;
      end if;
      return Cursor.Visible = 1;
   end Cursor_Visible;

   procedure Set_Cursor (Visible : in Boolean) is
      Cursor : aliased CONSOLE_CURSOR_INFO;
   begin
      if GetConsoleCursorInfo (Output_Buffer, Cursor'Unchecked_Access) = 0 then
         raise Cursor_Get_Error;
      end if;
      if Visible = True then
         Cursor.Visible := 1;
      else
         Cursor.Visible := 0;
      end if;
      if SetConsoleCursorInfo (Output_Buffer, Cursor'Unchecked_Access) = 0 then
         raise Cursor_Set_Error;
      end if;
   end Set_Cursor;

   function Where_X return X_Pos is
   begin
      Get_Buffer_Info;
      return X_Pos (Buffer_Info_Rec.Cursor_Pos.X);
   end Where_X;

   function Where_Y return Y_Pos is
   begin
      Get_Buffer_Info;
      return Y_Pos (Buffer_Info_Rec.Cursor_Pos.Y);
   end Where_Y;

   procedure Goto_XY
     (X : in X_Pos := X_Pos'First;
      Y : in Y_Pos := Y_Pos'First) is
      New_Pos : COORD := (SHORT (X), SHORT (Y));
   begin
      Get_Buffer_Info;
      if New_Pos.X > Buffer_Info_Rec.Size.X then
         New_Pos.X := Buffer_Info_Rec.Size.X;
      end if;
      if New_Pos.Y > Buffer_Info_Rec.Size.Y then
         New_Pos.Y := Buffer_Info_Rec.Size.Y;
      end if;
      if SetConsoleCursorPosition (Output_Buffer, New_Pos) = WIN32_ERROR then
         raise Cursor_Pos_Error;
      end if;
   end Goto_XY;

   -------------------
   -- COLOR CONTROL --
   -------------------

   function Get_Foreground return Color_Type is
   begin
      Get_Buffer_Info;
      return Color_Type_Value (Buffer_Info_Rec.Attrib.Foreground);
   end Get_Foreground;

   function Get_Background return Color_Type is
   begin
      Get_Buffer_Info;
      return Color_Type_Value (Buffer_Info_Rec.Attrib.Background);
   end Get_Background;

   procedure Set_Foreground (Color : in Color_Type := Gray) is
      Attr : Attribute;
   begin
      Get_Buffer_Info;
      Attr.Foreground := Color_Value (Color);
      Attr.Background := Buffer_Info_Rec.Attrib.Background;
      if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then
         raise Set_Attribute_Error;
      end if;
   end Set_Foreground;

   procedure Set_Background (Color : in Color_Type := Black) is
      Attr : Attribute;
   begin
      Get_Buffer_Info;
      Attr.Foreground := Buffer_Info_Rec.Attrib.Foreground;
      Attr.Background := Color_Value (Color);
      if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then
         raise Set_Attribute_Error;
      end if;
   end Set_Background;

   --------------------
   -- SCREEN CONTROL --
   --------------------

   procedure Clear_Screen (Color : in Color_Type := Black) is
      Length : DWORD;
      Attr   : Attribute;
      Home   : COORD := (0, 0);
   begin
      Get_Buffer_Info;
      Length := DWORD (Buffer_Info_Rec.Size.X) * DWORD (Buffer_Info_Rec.Size.Y);
      Attr.Background := Color_Value (Color);
      Attr.Foreground := Buffer_Info_Rec.Attrib.Foreground;
      if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then
         raise Set_Attribute_Error;
      end if;
      if FillConsoleOutputAttribute (Output_Buffer, Attr, Length, Home, Num_Bytes_Access) = WIN32_ERROR then
         raise Fill_Attribute_Error;
      end if;
      if FillConsoleOutputCharacter (Output_Buffer, ' ', Length, Home, Num_Bytes_Access) = WIN32_ERROR then
         raise Fill_Char_Error;
      end if;
      if SetConsoleCursorPosition (Output_Buffer, Home) = WIN32_ERROR then
         raise Cursor_Position_Error;
      end if;
   end Clear_Screen;

   -------------------
   -- SOUND CONTROL --
   -------------------
   procedure Bleep is
   begin
      if MessageBeep (16#FFFFFFFF#) = WIN32_ERROR then
         raise Beep_Error;
      end if;
   end Bleep;

   -------------------
   -- INPUT CONTROL --
   -------------------

   function Get_Key return Character is
      Temp : Integer;
   begin
      Temp := GetCh;
      if Temp = 16#00E0# then
         Temp := 0;
      end if;
      return Character'Val (Temp);
   end Get_Key;

   function Key_Available return Boolean is
   begin
      if KbHit = 0 then
         return False;
      else
         return True;
      end if;
   end Key_Available;

begin

   --------------------------
   -- WIN32 INITIALIZATION --
   --------------------------

   Output_Buffer := GetStdHandle (STD_OUTPUT_HANDLE);
   if Output_Buffer = INVALID_HANDLE_VALUE then
      raise Invalid_Handle_Error;
   end if;

end NT_Console;

NT_Console.adb

  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
-----------------------------------------------------------------------
--
--  File:        nt_console.ads
--  Description: Win95/NT console support
--  Rev:         0.2
--  Date:        08-june-1999
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1997, 1998, 1999
--  Billie Holidaystraat 28
--  2324 LK  LEIDEN
--  THE NETHERLANDS
--  tel int + 31 71 531 43 65
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

package NT_Console is

   ----------------------
   -- TYPE DEFINITIONS --
   ----------------------

   subtype X_Pos is Natural range 0 .. 79;
   subtype Y_Pos is Natural range 0 .. 24;

   type Color_Type is
     (Black, Blue, Green, Cyan, Red, Magenta, Brown, Gray,
      Light_Blue, Light_Green, Light_Cyan, Light_Red,
      Light_Magenta, Yellow, White);

   ----------------------
   -- EXTENDED PC KEYS --
   ----------------------

   Key_Alt_Escape       : constant Character := Character'Val (16#01#);
   Key_Control_At       : constant Character := Character'Val (16#03#);
   Key_Alt_Backspace    : constant Character := Character'Val (16#0E#);
   Key_BackTab          : constant Character := Character'Val (16#0F#);
   Key_Alt_Q            : constant Character := Character'Val (16#10#);
   Key_Alt_W            : constant Character := Character'Val (16#11#);
   Key_Alt_E            : constant Character := Character'Val (16#12#);
   Key_Alt_R            : constant Character := Character'Val (16#13#);
   Key_Alt_T            : constant Character := Character'Val (16#14#);
   Key_Alt_Y            : constant Character := Character'Val (16#15#);
   Key_Alt_U            : constant Character := Character'Val (16#16#);
   Key_Alt_I            : constant Character := Character'Val (16#17#);
   Key_Alt_O            : constant Character := Character'Val (16#18#);
   Key_Alt_P            : constant Character := Character'Val (16#19#);
   Key_Alt_LBracket     : constant Character := Character'Val (16#1A#);
   Key_Alt_RBracket     : constant Character := Character'Val (16#1B#);
   Key_Alt_Return       : constant Character := Character'Val (16#1C#);
   Key_Alt_A            : constant Character := Character'Val (16#1E#);
   Key_Alt_S            : constant Character := Character'Val (16#1F#);
   Key_Alt_D            : constant Character := Character'Val (16#20#);
   Key_Alt_F            : constant Character := Character'Val (16#21#);
   Key_Alt_G            : constant Character := Character'Val (16#22#);
   Key_Alt_H            : constant Character := Character'Val (16#23#);
   Key_Alt_J            : constant Character := Character'Val (16#24#);
   Key_Alt_K            : constant Character := Character'Val (16#25#);
   Key_Alt_L            : constant Character := Character'Val (16#26#);
   Key_Alt_Semicolon    : constant Character := Character'Val (16#27#);
   Key_Alt_Quote        : constant Character := Character'Val (16#28#);
   Key_Alt_Backquote    : constant Character := Character'Val (16#29#);
   Key_Alt_Backslash    : constant Character := Character'Val (16#2B#);
   Key_Alt_Z            : constant Character := Character'Val (16#2C#);
   Key_Alt_X            : constant Character := Character'Val (16#2D#);
   Key_Alt_C            : constant Character := Character'Val (16#2E#);
   Key_Alt_V            : constant Character := Character'Val (16#2F#);
   Key_Alt_B            : constant Character := Character'Val (16#30#);
   Key_Alt_N            : constant Character := Character'Val (16#31#);
   Key_Alt_M            : constant Character := Character'Val (16#32#);
   Key_Alt_Comma        : constant Character := Character'Val (16#33#);
   Key_Alt_Period       : constant Character := Character'Val (16#34#);
   Key_Alt_Slash        : constant Character := Character'Val (16#35#);
   Key_Alt_KPStar       : constant Character := Character'Val (16#37#);
   Key_F1               : constant Character := Character'Val (16#3B#);
   Key_F2               : constant Character := Character'Val (16#3C#);
   Key_F3               : constant Character := Character'Val (16#3D#);
   Key_F4               : constant Character := Character'Val (16#3E#);
   Key_F5               : constant Character := Character'Val (16#3F#);
   Key_F6               : constant Character := Character'Val (16#40#);
   Key_F7               : constant Character := Character'Val (16#41#);
   Key_F8               : constant Character := Character'Val (16#42#);
   Key_F9               : constant Character := Character'Val (16#43#);
   Key_F10              : constant Character := Character'Val (16#44#);
   Key_Home             : constant Character := Character'Val (16#47#);
   Key_Up               : constant Character := Character'Val (16#48#);
   Key_PageUp           : constant Character := Character'Val (16#49#);
   Key_Alt_KPMinus      : constant Character := Character'Val (16#4A#);
   Key_Left             : constant Character := Character'Val (16#4B#);
   Key_Center           : constant Character := Character'Val (16#4C#);
   Key_Right            : constant Character := Character'Val (16#4D#);
   Key_Alt_KPPlus       : constant Character := Character'Val (16#4E#);
   Key_End              : constant Character := Character'Val (16#4F#);
   Key_Down             : constant Character := Character'Val (16#50#);
   Key_PageDown         : constant Character := Character'Val (16#51#);
   Key_Insert           : constant Character := Character'Val (16#52#);
   Key_Delete           : constant Character := Character'Val (16#53#);
   Key_Shift_F1         : constant Character := Character'Val (16#54#);
   Key_Shift_F2         : constant Character := Character'Val (16#55#);
   Key_Shift_F3         : constant Character := Character'Val (16#56#);
   Key_Shift_F4         : constant Character := Character'Val (16#57#);
   Key_Shift_F5         : constant Character := Character'Val (16#58#);
   Key_Shift_F6         : constant Character := Character'Val (16#59#);
   Key_Shift_F7         : constant Character := Character'Val (16#5A#);
   Key_Shift_F8         : constant Character := Character'Val (16#5B#);
   Key_Shift_F9         : constant Character := Character'Val (16#5C#);
   Key_Shift_F10        : constant Character := Character'Val (16#5D#);
   Key_Control_F1       : constant Character := Character'Val (16#5E#);
   Key_Control_F2       : constant Character := Character'Val (16#5F#);
   Key_Control_F3       : constant Character := Character'Val (16#60#);
   Key_Control_F4       : constant Character := Character'Val (16#61#);
   Key_Control_F5       : constant Character := Character'Val (16#62#);
   Key_Control_F6       : constant Character := Character'Val (16#63#);
   Key_Control_F7       : constant Character := Character'Val (16#64#);
   Key_Control_F8       : constant Character := Character'Val (16#65#);
   Key_Control_F9       : constant Character := Character'Val (16#66#);
   Key_Control_F10      : constant Character := Character'Val (16#67#);
   Key_Alt_F1           : constant Character := Character'Val (16#68#);
   Key_Alt_F2           : constant Character := Character'Val (16#69#);
   Key_Alt_F3           : constant Character := Character'Val (16#6A#);
   Key_Alt_F4           : constant Character := Character'Val (16#6B#);
   Key_Alt_F5           : constant Character := Character'Val (16#6C#);
   Key_Alt_F6           : constant Character := Character'Val (16#6D#);
   Key_Alt_F7           : constant Character := Character'Val (16#6E#);
   Key_Alt_F8           : constant Character := Character'Val (16#6F#);
   Key_Alt_F9           : constant Character := Character'Val (16#70#);
   Key_Alt_F10          : constant Character := Character'Val (16#71#);
   Key_Control_Left     : constant Character := Character'Val (16#73#);
   Key_Control_Right    : constant Character := Character'Val (16#74#);
   Key_Control_End      : constant Character := Character'Val (16#75#);
   Key_Control_PageDown : constant Character := Character'Val (16#76#);
   Key_Control_Home     : constant Character := Character'Val (16#77#);
   Key_Alt_1            : constant Character := Character'Val (16#78#);
   Key_Alt_2            : constant Character := Character'Val (16#79#);
   Key_Alt_3            : constant Character := Character'Val (16#7A#);
   Key_Alt_4            : constant Character := Character'Val (16#7B#);
   Key_Alt_5            : constant Character := Character'Val (16#7C#);
   Key_Alt_6            : constant Character := Character'Val (16#7D#);
   Key_Alt_7            : constant Character := Character'Val (16#7E#);
   Key_Alt_8            : constant Character := Character'Val (16#7F#);
   Key_Alt_9            : constant Character := Character'Val (16#80#);
   Key_Alt_0            : constant Character := Character'Val (16#81#);
   Key_Alt_Dash         : constant Character := Character'Val (16#82#);
   Key_Alt_Equals       : constant Character := Character'Val (16#83#);
   Key_Control_PageUp   : constant Character := Character'Val (16#84#);
   Key_F11              : constant Character := Character'Val (16#85#);
   Key_F12              : constant Character := Character'Val (16#86#);
   Key_Shift_F11        : constant Character := Character'Val (16#87#);
   Key_Shift_F12        : constant Character := Character'Val (16#88#);
   Key_Control_F11      : constant Character := Character'Val (16#89#);
   Key_Control_F12      : constant Character := Character'Val (16#8A#);
   Key_Alt_F11          : constant Character := Character'Val (16#8B#);
   Key_Alt_F12          : constant Character := Character'Val (16#8C#);
   Key_Control_Up       : constant Character := Character'Val (16#8D#);
   Key_Control_KPDash   : constant Character := Character'Val (16#8E#);
   Key_Control_Center   : constant Character := Character'Val (16#8F#);
   Key_Control_KPPlus   : constant Character := Character'Val (16#90#);
   Key_Control_Down     : constant Character := Character'Val (16#91#);
   Key_Control_Insert   : constant Character := Character'Val (16#92#);
   Key_Control_Delete   : constant Character := Character'Val (16#93#);
   Key_Control_KPSlash  : constant Character := Character'Val (16#95#);
   Key_Control_KPStar   : constant Character := Character'Val (16#96#);
   Key_Alt_EHome        : constant Character := Character'Val (16#97#);
   Key_Alt_EUp          : constant Character := Character'Val (16#98#);
   Key_Alt_EPageUp      : constant Character := Character'Val (16#99#);
   Key_Alt_ELeft        : constant Character := Character'Val (16#9B#);
   Key_Alt_ERight       : constant Character := Character'Val (16#9D#);
   Key_Alt_EEnd         : constant Character := Character'Val (16#9F#);
   Key_Alt_EDown        : constant Character := Character'Val (16#A0#);
   Key_Alt_EPageDown    : constant Character := Character'Val (16#A1#);
   Key_Alt_EInsert      : constant Character := Character'Val (16#A2#);
   Key_Alt_EDelete      : constant Character := Character'Val (16#A3#);
   Key_Alt_KPSlash      : constant Character := Character'Val (16#A4#);
   Key_Alt_Tab          : constant Character := Character'Val (16#A5#);
   Key_Alt_Enter        : constant Character := Character'Val (16#A6#);

   --------------------
   -- CURSOR CONTROL --
   --------------------

   function  Cursor_Visible return Boolean;
   procedure Set_Cursor (Visible : in Boolean);

   function Where_X return X_Pos;
   function Where_Y return Y_Pos;

   procedure Goto_XY
     (X : in X_Pos := X_Pos'First;
      Y : in Y_Pos := Y_Pos'First);

   -------------------
   -- COLOR CONTROL --
   -------------------

   function Get_Foreground return Color_Type;
   function Get_Background return Color_Type;

   procedure Set_Foreground (Color : in Color_Type := Gray);
   procedure Set_Background (Color : in Color_Type := Black);

   --------------------
   -- SCREEN CONTROL --
   --------------------

   procedure Clear_Screen (Color : in Color_Type := Black);

   -------------------
   -- SOUND CONTROL --
   -------------------
   procedure Bleep;

   -------------------
   -- INPUT CONTROL --
   -------------------

   function Get_Key return Character;
   function Key_Available return Boolean;

end NT_Console;

NT_Console.ads

Vous savez désormais comment fonctionnent les packages : copiez chacun de ces textes dans un fichier séparé et enregistrez-les sous les noms NT_Console.adb et NT_Console.ads dans le répertoire de votre projet et n'oubliez pas d'écrire la ligne ci-dessous en en-tête de votre projet : 

1
With NT_Console ;            Use NT_Console ;

Le contenu en détail

Voyons maintenant le contenu de ce package. Pour cela, ouvrez le fichier NT_Console.ads (le code source ne nous intéresse pas, nous n'allons observer que les spécifications). Pour les plus craintifs, suivez le guide. Pour ceux qui peuvent s'en sortir seuls (et c'est faisable) lisez ce fichier par vous-mêmes.

C'est l'histoire de trois types…

Ce package est très bien ficelé, il commence par présenter le package : nom, nom de l'auteur, version, date de création, droits… Je vous conseille de vous en inspirer pour plus de lisibilité dans vos packages. Mais venons-en à ce qui nous intéresse. NT_Console commence par définir trois types et seulement trois :

  • X_Pos : c'est un Natural entre 0 et 79. Il correspond à la position de votre curseur sur une ligne de votre console : le premier emplacement est le numéro 0, le dernier est le numéro 79. Autrement dit, vous pouvez afficher 80 caractères par ligne.
  • Y_Pos : c'est un Natural entre 0 et 24. Il correspond au numéro de la ligne à laquelle se situe votre curseur. La première ligne est la numéro 0, la dernière la numéro 24 d'où un total de 25 lignes affichables dans la console. A elles deux, des variables de type X_Pos et Y_Pos vous indiquent où se situe votre curseur à l'écran. Attention, encore une fois, le premier emplacement est le numéro (0,0)
  • Color_Type : c'est un type énuméré comptant 15 noms de couleur. C'est ce type qui va nous servir à définir la couleur du texte ou de l'arrière plan. Pour ceux qui auraient du mal avec l'anglais, c'est comme si vous aviez ceci : 
1
2
3
4
type Color_Type is
     (Noir, Bleu, Vert, Cyan, Rouge, Magenta, Marron, Gris,
      Bleu_Clair, Vert_Clair, Cyan_clair, Rouge_Clair,
      Magenta_Clair, Jaune, Blanc);

Puis, vient une longue (très longue) liste de constantes correspondant aux valeurs de certaines touches ou combinaisons de touches du clavier.

Et pour quelques fonctions de plus

Nous en venons donc à l'essentiel : les procédures et fonctions. Elles sont très bien rangées en cinq catégories : contrôle du curseur, contrôle de la couleur, contrôle de l'écran, contrôle du son et contrôle des entrées (entrées-clavier bien sûr).

Contrôle du curseur

Pour savoir si le curseur est visible ou non, utilisez la fonction Cursor_Visible(). Pour définir si le curseur sera visible ou non utilisez la procédure Set_Cursor(). Pour connaître la position du curseur, c'est à dire connaître ses coordonnées X_Pos et Y_Pos, vous pourrez utiliser les fonctions Where_X et Where_Y (Where = où). Enfin, pour modifier cette position, vous utiliserez la procédure Goto_XY() qui prend en paramètre une variable de type X_Pos et une de type Y_Pos.

Contrôle de la couleur

Il y a deux éléments dont nous pouvons modifier la couleur à l'affichage : la couleur du texte (l'avant-plan ou premier plan) et la couleur du fond, du surlignage (l'arrière-plan). C'est à cela que correspondent Foreground (l'avant-plan) et Background (arrière-plan).

Comme toujours, deux actions sont possibles : lire et écrire. Si vous souhaitez connaître la couleur de l'arrière plan, vous devez la lire et vous utiliserez donc la fonction get_Background qui vous retournera la couleur de fond. Si vous souhaitez modifier cette couleur, alors vous utiliserez la procédure Set_Background(une_couleur). Même chose pour l'avant-plan bien entendu.

Retenez donc ceci :

  • Foreground = Avant-plan / Background = Arrière-plan
  • Get = Saisir / Set = Définir

Contrôle de l'écran

Cette section, comme la suivante, ne comporte qu'une seule procédure : Clear_Screen(). Cette procédure prend en paramètre une couleur (une variable de type Color_Type) et, comme son nom l'indique, nettoie l'écran. Plus rien n'est affiché et en plus vous pouvez changer en même temps la couleur de fond de la console. Attention, la couleur de fond de la console est différente de la couleur d'arrière-plan de votre texte !

Contrôle du son

Une seule procédure sans grand intérêt : Bleep. Cette procédure se contente d'émettre un bip, comme si Windows avait rencontré une erreur.

Contrôle des entées clavier

Lorsque l'utilisateur appuie sur les touches du clavier (même sans que votre programme ne l'y ai invité), celui-ci transmet une information à votre ordinateur qui la stocke en mémoire (on parle de mémoire tampon ou de Buffer, souvenez-vous, nous en avions parlé quand nous avions vu l'instruction Skip_line). Ainsi, la mémoire tampon peut contenir toute une série de caractères avant même que le programme n'en ait besoin ou bien être vide alors que le programme attend une réponse. La fonction key_available vous permet de savoir si une touche a été stockée en mémoire tampon. Les fonctions et procédures get, get_line, get_immediate… se contentent ainsi de piocher dans la mémoire tampon, au besoin en attendant qu'elle se remplisse.

La fonction get_key quant à elle agit un peu à la manière de la procédure get_immediate : elle pioche immédiatement dans la mémoire tampon sans attendre que l'utilisateur valide la saisie avec Entrée. Quel intérêt ? Eh bien il y a une petite différence, notamment dans la gestion des touches «spéciales». Par «touches spéciales», j'entends les touches flèches ou F10 par exemple. Essayez ce code : 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
with nt_console ;             use nt_console ;
with ada.text_io ;            use ada.Text_IO ;
with ada.Integer_Text_IO ;    use ada.Integer_Text_IO ; 


procedure test is
   c : character  ;
begin
   loop
      c := get_key ; 
      put("valeur correspondante :") ; 
      put(character'pos(c)) ; 
      new_line ; 
   end loop ; 
end test01 ;

Vous vous rendrez compte que toute touche spéciale envoie en fait deux caractères : le caractère n°0 suivi d'un second. Ainsi, la flèche gauche envoie le caractère n°0 suivi du caractère n°75. À l'aide de ce petit programme, vous pourrez récupérer les numéros des touches fléchées qui serviront au joueur à diriger le serpent.

La fonction key_available quant à elle indique si le buffer est vide ou pas. Si elle renvoie TRUE, c'est qu'il y a au moins un caractère en mémoire tampon et que l'on peut le saisir. Chose importante, elle n'attend pas que l'utilisateur appuie sur un touche ! Ainsi, à l'aide de cette fonction, nous pourrons faire en sorte que le serpent continue à avancer sans attendre que l'utilisateur appuie sur une touche ! Nous n'utiliserons get_key que dans le cas où key_available aura préalablement renvoyé TRUE.

… et encore un autre !

Pour mesurer le temps et définir ainsi la vitesse de jeu, nous aurons besoin d'un second package (officiel celui-là) : Ada.Calendar !

Le package Ada.calendar est fait pour nous permettre de manipuler l'horloge. Si vous cherchez le fichier correspondant, il porte le nom a-calend.ads. Deux types essentiels le composent : le type Duration et le type Time (même si Time est une copie de Duration). Duration mesure les durées, Time correspond aux dates. Ce sont tous deux des nombres décimaux, puisque le temps est mesuré en secondes. Attention toutefois aux problèmes de typage ! Nous allons définir deux variables : temps et duree. 

1
2
temps : time ; 
duree : Duration ;

Pour saisir la date actuelle (jour, mois, année, seconde), il faut utiliser la fonction clock : 

1
temps := clock ;

Il est ensuite possible d'effectuer des opérations, par exemple : 

1
duree := clock - temps ;

En soustrayant le temps enregistré dans la variable temps au temps actuel fourni par la fonction clock, on obtient une durée. Il est également possible de soustraire (ou d'ajouter) une durée à un temps, ce qui donne alors un temps. Il est également possible de comparer des variables de type Time ou Duration. Enfin, pour afficher une variable de type Time ou Duration, pensez à la convertir préalablement en Float. Pour en savoir plus sur le package Ada.Calendar, n'hésitez pas à éplucher les fichiers a-calend.adb et a-calend.ads, ils ne sont pas très longs.

Quelques indications

Jouer en temps réel

Comment je fais pour jouer en temps réel ? Mon serpent ne peut pas avancer tout seul et en même temps attendre que je lui indique la direction à prendre !

Nous allons devoir combiner les deux packages dont je viens de vous parler pour parvenir à ce petit exploit. Le serpent avance case par case, chaque avancée prend un certain temps (pour ma part, j'ai pris une durée de 0.2 secondes) durant lequel le joueur peut appuyer sur les touches de son clavier pour modifier la direction du serpent. Une fois ce temps écoulé, le serpent avance d'une case. Cela nous amène à l'algorithme suivant : 

1
2
3
4
TANT QUE duree<0.2 REPETER
|   attendre_une_réaction_du_joueur ;
FIN REPETER
Avancer_le_serpent ;

Le soucis, c'est que si le joueur n'appuie jamais sur le clavier, le programme reste bloqué sur l'instruction attendre_une_réaction_du_joueur et on ne sort jamais de la boucle, non?

C'est là qu'intervient le package NT_Console ! Nous ne devons pas attendre que le joueur ait saisi une touche mais simplement nous demander s'il a appuyé sur une touche. Si oui, on saisit effectivement cette touche, sinon on continue à parcourir notre boucle. Cela nous amène à l'algorithme suivant : 

1
2
3
if Key_available
   then c:=get_key ; 
end if ;

Ainsi, le programme ne reste pas bloqué sur get_key indéfiniment. Cependant, nous attendons que le joueur appuie sur une touche fléchée, pas sur une lettre ! Comme je vous l'ai dit, les touches spéciales envoient deux caractères consécutivement : le numéro 0 puis le véritable caractère. Donc nous devons reprendre le code précédent ainsi : 

1
2
3
4
5
6
if Key_available
   then if character'pos(get_key)=0
           then c:=get_key ; 
                traitement ;
        end if ; 
end if ;

Comment afficher un serpent et une zone de jeu en couleur ?

Pour cela, regardons la capture d'écran que je vous ai fournie, elle n'est pas parole d'évangile mais elle va nous guider :

Jeu du serpent

Que remarque-t-on ? Tout d'abord, le fond de la console est gris, contrairement à l'aire de jeu qui elle est blanche et au serpent qui est dessiné en bleu par-dessus l'aire de jeu. Nous avons donc trois niveau de couleur :

  • La couleur de fond de la console : elle sera obtenue lorsque vous utiliser la procédure clear_screen().
  • La couleur de la zone de jeu : elle est obtenue en fixant la couleur d'arrière-plan et en affichant de simples espaces. Attention à ne pas afficher de caractères avec un arrière-plan blanc en dehors de cette zone. Notamment si vous affichez du texte comme le score ou un message de défaite.
  • La couleur des items affichés sur la zone de jeu : ces items comme les morceaux du serpent ou l'objet qu'il doit manger, doivent avoir un arrière-plan blanc et un avant-plan bleu (ou n'importe quelle autre couleur de votre choix).

Pensez également que lorsque votre serpent avancera d'une case, il ne suffira pas d'afficher le nouveau serpent, il faudra également penser à effacer l'ancien de l'écran !

Mais d'où tu sors tes ronds, tes rectangles et tes triangles ?

C'est simple. Il suffit de réaliser un petit programme qui affiche tous les caractères du numéro 0 au numéro 255 (à l'aide des attributs 'pos et 'val). On découvre ainsi plein de caractères bizarroïdes comme le trèfle, le cœur, le pique et le carreau ou des flèches, des carrés… Pour les rectangles du corps du serpent, j'ai utilisé character'val(219) et character'val(178), pour les triangles j'ai utilisé character'val(16), character'val(17), character'val(30) ou character'val(31) et quant à l'espèce de soleil, il s'agit de character'val(15). Mais ne vous contentez pas de reprendre mot à mot mes propositions, faites des essais et trouvez les symboles qui vous paraissent les plus appropriés.

Par où commencer ?

Nous en sommes au troisième TP, il serait bon que vous commenciez à établir vous-même votre approche du problème. Je ne vais donc pas détailler énormément cette partie. Voici comment j'aborderais ce TP (en entrecoupant chaque étape de divers tests pour trouver d'éventuels bogues) :

  • Création des types nécessaires pour faire un serpent.
  • Réalisation des procédures d'affichage de l'aire de jeu et du serpent.
  • Réalisation des procédures de déplacement et d'agrandissement du serpent + actualisation éventuelle des procédures d'affichage.
  • Réalisation des procédures permettant au Joueur de piloter le Serpent au clavier.
  • Mise en place des règles : interdiction de sortir de l'espace de jeu, de mordre le corps du serpent, d'effectuer des demi-tours.
  • Réalisation des procédures générant l'item à avaler (appelé Anneau dans mon code) et actualisation des règles : «si le serpent mange l'anneau alors il grandit», «un anneau ne peut apparaître directement sur le serpent».
  • Éventuels débogages et ajouts de fonctionnalités.

Voilà pour le plan de bataille. Il est succinct mais devrait vous fournir des objectifs partiels facilement atteignables. Je me répète mais n'hésitez pas à effectuer des tests réguliers et approfondis pour être sûr de ne pas avoir créé de bogues. Par exemple, ce n'est pas parce que votre serpent avance correctement vers le haut, qu'il avancera correctement vers la droite ou après avoir effectué un ou deux virages. Et en cas de difficultés persistantes, n'hésitez pas à poser des questions.

Une solution possible

Le fichier principal : 

 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
with nt_console ;                            use nt_console ;
with Snake_Variables ;                       use Snake_Variables ;
with Snake_Programs ;                        use Snake_Programs ;
with Snake_Screen ;                          use Snake_Screen ;


procedure Snake is

   Serpent       : T_Serpent ;

begin
   Set_Cursor(false) ;

   print_ecran(snake) ;
   print_ecran(ready) ;
   print_ecran(start) ;

   Clear_screen(Couleur_Ecran) ;
   print_plateau ;
   Init_Serpent(Serpent) ;
   Print_Serpent(Serpent) ;

   Game(Serpent) ;

end Snake ;

Le package contenant quelques types et surtout les variables nécessaires au programme : 

 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
with nt_console ;                            use nt_console ;


package Snake_Variables is

   type T_Coord is record
      x,y : integer := 0 ;
   end record ;

   Longueur      : Natural                        := 30 ;
   Hauteur       : Natural                        := 15 ;

   subtype Intervalle_Alea is natural range 1..Longueur*Hauteur ;

   HDecalage     : Natural                        := (X_Pos'last-X_Pos'first+1-Longueur)/2 ;
   VDecalage     : Natural                        := (Y_Pos'last-Y_Pos'first+1-Hauteur)/2 ;

   Couleur_Ecran : Color_Type                     := gray ;
   Couleur_Fond  : Color_Type                     := white ;
   Couleur_Texte : Color_Type                     := light_blue ;
   Couleur_Anneau: Color_Type                     := red ;

   Duree         : Duration                       := 0.2 ;
   Score         : Natural                        := 0 ;

   touche        : Character ;

end Snake_Variables ;

Le package contenant la plupart des programmes servant au jeu : 

  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
with nt_console ;                            use nt_console ;
with ada.text_io ;                           use ada.Text_IO ;
with ada.Integer_Text_IO ;                   use ada.Integer_Text_IO ;
with ada.Calendar ;                          use ada.Calendar ;


package body Snake_Programs is

         ---------------------------------
         --      AFFICHAGE PLATEAU      --
         ---------------------------------

   procedure print_plateau is
   begin
      print_score ;
      new_line(Count(VDecalage)) ;
      for j in 1..Hauteur loop
         set_background(Couleur_Ecran) ;
         for i in 1..HDecalage loop
            put(' ') ;
         end loop ;
         set_background(Couleur_Fond) ;
         for i in 1..longueur loop
            put(' ') ;
         end loop ;
         new_line ;
      end loop ;
   end print_plateau ;

   procedure print_score is
   begin
      set_foreground(green) ;
      set_background(Couleur_Ecran) ;
      goto_XY(0,0) ;
      put("SCORE = ") ; put(Score,4) ;
      set_foreground(Couleur_Texte) ;
      set_background(Couleur_Fond) ;
   end print_score ;
         --------------------------------
         --      CREATION SERPENT      --
         --------------------------------

   procedure Init_Serpent(Serpent : in out T_Serpent) is
   begin
      Append(Serpent.corps,(15,7)) ;             --placement des anneaux du serpent
      Append(Serpent.corps,(15,8)) ;
         Append(Serpent.corps,(15,9)) ;
         Append(Serpent.corps,(14,9)) ;
         Append(Serpent.corps,(13,9)) ;
      Serpent.curseur := First(Serpent.corps) ;  --placement du curseur sur la tête du serpent
      Serpent.direction := (0,-1) ;              --direction vers le haut
   end Init_Serpent ;

   procedure move(Serpent : in out T_Serpent) is
      coord: T_coord ;
   begin
      efface_queue(Serpent) ;                             --on efface la queue
         coord.x := Element(Serpent.curseur ).x + Serpent.direction.x ;
         coord.y := Element(Serpent.curseur ).y + Serpent.direction.y ;
         Prepend(Serpent.corps,coord) ;                   --on ajoute une nouvelle tête
         Serpent.curseur := Last(Serpent.corps) ;
         Delete(serpent.corps,Serpent.curseur) ;          --on supprime la queue
         Serpent.curseur := First(Serpent.corps) ;
      print_serpent(serpent) ;                            --on affiche le nouveau corps
   end move ;

   procedure grow(Serpent : in out T_Serpent) is
      coord: T_coord ;
   begin
      coord.x := First_Element(Serpent.corps).x + Serpent.direction.x ;
      coord.y := First_Element(Serpent.corps).y + Serpent.direction.y ;
      Prepend(Serpent.corps,coord) ;                      --on ajoute une nouvelle tête
      Serpent.curseur := First(Serpent.corps) ;
      print_serpent(serpent) ;                            --on affiche le nouveau corps
   end grow ;

   function est_sorti(Serpent : T_Serpent) return boolean is
      tete : T_Coord ;
   begin
      tete := First_Element(Serpent.corps) ;
      if tete.x < 1 or tete.x > Longueur or tete.y < 1 or tete.y > hauteur
         then return true ;
         else return false ;
      end if ;
   end est_sorti ;

   function est_mordu(Serpent : T_Serpent) return boolean is
      tete : T_Coord ;
      Serpent2 : T_Serpent := Serpent ;
   begin
      tete := First_Element(Serpent2.corps) ;
      Delete_first(Serpent2.corps) ;
      if Find(Serpent2.corps,tete) /= No_Element               --Is_In(tete,Serpent2.corps)
         then return true ;
         else return false ;
      end if ;
   end est_mordu ;

   function a_mange(Serpent : T_Serpent ; Anneau : T_Coord) return boolean is
      tete : T_Coord ;
   begin
      tete := First_Element(Serpent.corps) ;
      if tete = Anneau
         then return true ;
         else return false ;
      end if ;
   end a_mange ;

         ---------------------------------
         --      AFFICHAGE SERPENT      --
         ---------------------------------

   procedure print_tete(Serpent : in T_Serpent) is
   begin
      if serpent.direction.x < 0
         then put(character'val(17)) ;    --regard vers la gauche
      elsif serpent.direction.x > 0
         then put(character'val(16)) ;    --regard vers la droite
      elsif serpent.direction.y <0
         then put(character'val(30)) ;    --regard vers le haut
         else put(character'val(31)) ;    --regard vers le bas
      end if ;
   end print_tete ;

   procedure print_corps(nb : natural) is
   begin
       if nb mod 2 =0
          then put(character'val(219)) ;
          else put(character'val(178)) ;
       end if ;
   end print_corps ;

   procedure print_serpent(Serpent : in out T_Serpent) is
   begin
      Set_Foreground(Couleur_Texte) ;
      for i in 1..length(Serpent.corps) loop
         Goto_XY(Element(serpent.curseur).x + HDecalage-1,
                 Element(serpent.curseur).y + VDecalage-1) ;
         if i = 1
            then print_tete(serpent) ;
            else print_corps(integer(i)) ;
         end if ;
         Next(Serpent.curseur) ;
      end loop ;
      Serpent.curseur := First(Serpent.corps) ;
   end print_serpent ;

   procedure efface_queue(Serpent : in out T_Serpent) is
   begin
      Serpent.curseur := Last(Serpent.corps) ;
      Goto_XY(Element(serpent.curseur).x + HDecalage-1,
              Element(serpent.curseur).y + VDecalage-1) ;
      put(' ') ;
      Serpent.curseur := First(Serpent.corps) ;
   end efface_queue ;

         ---------------------------------
         --     GESTION DES ANNEAUX     --
         ---------------------------------

   function generer(germe : generator ; Serpent : T_Serpent) return T_Coord IS
      temp1,temp2 : Natural ;
      anneau : T_Coord ;
   BEGIN
      loop
         temp1 := random(germe) ; temp2 := random(germe) ;
         Anneau := (temp1 mod longueur + 1, temp2 mod hauteur +1) ;
         if Find(Serpent.corps,Anneau) = No_Element
            then return Anneau ;
         end if ;
      end loop ;
   end generer ;

   procedure print_anneau(anneau : T_Coord) is
   begin
      set_foreground(Couleur_Anneau) ;
      Goto_XY(anneau.x+Hdecalage-1,anneau.y+Vdecalage-1) ;
      put(character'val(15)) ;
      set_foreground(Couleur_Texte) ;
   end print_anneau ;

         --------------------------------
         --      PROGRAMME DE JEU      --
         --------------------------------

   procedure Erreur(Message : in String) is
   begin
      Goto_XY(HDecalage+5,VDecalage+Hauteur+2) ;
      set_background(Couleur_Ecran) ;
      set_foreground(light_Red) ;
      Put(Message) ; delay 1.0 ;
   end Erreur ;

   procedure un_tour(Serpent : in out T_Serpent) is
      choix_effectue : boolean := false ;
      Temps   : constant Time := clock ;
      New_direction : T_Coord ;
   begin
      while clock-temps<duree loop
         if not choix_effectue and then key_available and then character'pos(get_key) = 0
            then touche := get_key ;
                 case character'pos(touche) is
                    when 72 => New_direction := (0,-1) ; --haut
                    when 75 => New_direction := (-1,0) ; --gauche
                    when 77 => New_direction := (1,0) ; --droite
                    when 80 => New_direction := (0,1) ; --bas
                    when others => null ;
                 end case ;
                 if New_direction.x /= Serpent.direction.x and New_direction.y /= Serpent.direction.y
                    then Serpent.direction := New_direction ;
                         choix_effectue := true ;
                 end if ;
         end if ;
      end loop ;
   end un_tour ;

   procedure game(Serpent : in out T_Serpent) is
      germe : generator ;
      Anneau : T_Coord ;
   begin
      reset(germe) ;
      Anneau := generer(germe,Serpent) ;
      Print_anneau(Anneau) ;
      loop
         un_tour(Serpent) ;
            --test pour savoir si le serpent grandit ou avance
         if a_mange(serpent,anneau)
            then grow(serpent) ;
                 Score := Score + 100 ;
                 Print_score ;
                 Anneau := generer(germe,serpent) ;
                 Print_anneau(Anneau) ;
            else move(serpent) ;
         end if ;
            --test pour savoir si le serpent meurt
         if est_sorti(serpent)
            then Erreur("Vous " & character'val(136) & "tes sortis !") ; exit ;
         elsif est_mordu(serpent)
            then Erreur("Vous vous " & character'val(136) & "tes mordu !") ; exit ;
         end if ;
      end loop ;
   end game ;

end Snake_Programs ;


 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
with Snake_Variables ;                       use Snake_Variables ;
with ada.Numerics.Discrete_Random ;
with ada.Containers.Doubly_Linked_Lists ;    use ada.Containers ;

package Snake_Programs is

   package P_Liste is new Ada.Containers.Doubly_Linked_Lists(T_coord) ;
   use P_Liste ;

   package P_Aleatoire is new ada.Numerics.Discrete_Random(Intervalle_Alea) ;
   use P_Aleatoire ;

   Type T_Serpent is record
      corps      : List ;
      Curseur    : Cursor ;
      direction  : T_Coord ;
   end record ;

   procedure print_plateau ;
   procedure print_score ;

   procedure Init_Serpent(Serpent : in out T_Serpent) ;
   procedure move(Serpent : in out T_Serpent) ;
   procedure grow(Serpent : in out T_Serpent) ;
   function est_sorti(Serpent : T_Serpent) return boolean ;
   function est_mordu(Serpent : T_Serpent) return boolean ;

   procedure print_tete(Serpent : in T_Serpent) ;
   procedure print_corps(nb : natural) ;
   procedure print_serpent(Serpent : in out T_Serpent) ;
   procedure efface_queue(Serpent : in out T_Serpent) ;

   function generer(germe : generator ; Serpent : T_Serpent) return T_Coord ;
   procedure print_anneau(anneau : T_Coord) ;

   procedure Erreur(Message : in String) ;
   procedure un_tour(Serpent : in out T_Serpent) ;
   procedure game(Serpent : in out T_Serpent) ;

end Snake_Programs ;

Enfin, le package servant à l'affichage de mes écrans de titre : 

 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
with ada.text_IO ;          use ada.Text_IO ;
with NT_Console ;           use NT_Console ;
With Snake_Variables ;      use Snake_Variables ;

package body Snake_screen is

   procedure print_line(line : string) is
   begin
      for i in line'range loop
         case line(i) is
            when 'R' => set_background(Red) ;
                        put(' ') ;
                        set_background(Couleur_Ecran) ;
            when 'G' => set_background(Green) ;
                        put(' ') ;
                        set_background(Couleur_Ecran) ;
            when 'Y' => set_background(Yellow) ;
                        put(' ') ;
                        set_background(Couleur_Ecran) ;
            when '#' => set_background(Black) ;
                        put(' ') ;
                        set_background(Couleur_Ecran) ;
            when others => put(' ') ;
         end case ;
      end loop ;
      new_line ;
   end print_line ;

   procedure print_fichier(name : string) is
      F : file_type ;
   begin
      open(F,In_File,name) ;
      clear_screen(couleur_ecran) ;
      set_background(Couleur_Ecran) ;
      while not end_of_file(f) and not end_of_page(f) loop
         print_line(get_line(f) ) ;
      end loop ;
      close(f) ;
   end print_fichier;

   procedure print_ecran(Ecran : T_Ecran) is
   begin
      case Ecran is
         when SNAKE => print_fichier("Snake.pic") ; delay 2.5 ;
         when START => print_fichier("Start.pic") ; delay 1.0 ;
         when READY => print_fichier("Ready.pic") ; delay 1.5 ;
      end case ;
   end print_ecran;

end Snake_Screen ;


1
2
3
4
5
6
7
8
package Snake_Screen is

   type T_Ecran is(START,READY,SNAKE) ;
   procedure print_line(line : string) ;
   procedure print_fichier(name : string) ;
   procedure print_ecran(Ecran : T_Ecran) ;

end Snake_Screen ;

Pour finir, je vous transmets également les fichiers .pic (en fait des fichiers textes) servant de support à ces fameux écrans titres (je suis preneur pour tout écran titre pouvant remplacer celui qui ressemble vaguement à un serpent ^^ ): 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.
                               
              GGGGGGGG         
             Y       YG        
            G         YG       
           Y           YG      
                        GY     
                        GG     
                        GY     
                      GGY      
            GGGGGGGGGGGY       
         YGGYGYGYGYGYG         
       GGGGY                   
      GGY                      
     GGY                       
     GG                        
     GG                        
     YGG                       
      GGGG                     
      YYGGGGGG                 
        YYGGGGGG               
          YYGGGGG              
            YYYG

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
.









                     ####  #####   #   ####  #     #  ###
                     #   # #       #   #   #  #   #  #   #
                     #   # #      # #  #   #   # #   #   #
                     ####  ###    # #  #   #    #       #
                     # #   #     ##### #   #   #       #
                     #  #  #     #   # #   #  #
                     #   # ##### #   # ####  #         #


 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
.









                      ###  #####   #   ####  #####  #  #  #
                     #   #   #     #   #   #   #    #  #  #
                     #       #    # #  #   #   #    #  #  #
                      ###    #    # #  ####    #    #  #  #
                         #   #   ##### # #     #    #  #  #
                     #   #   #   #   # #  #    #
                      ###    #   #   # #   #   #    #  #  #

Pistes d'amélioration :

  • Proposer différent niveaux de difficulté : en faisant varier la vitesse, la taille de l'aire de jeu…
  • Ajouter des adversaires ou des obstacles.
  • Proposant l'enregistrement des meilleurs scores.
  • Proposer des bonus comme des anneaux comptant le double de points ou permettant de réduire votre taille.