[TP] Le démineur

Nous voici rendu à notre premier TP en programmation évènementielle. Pour cette première, nous allons réaliser un jeu tout simple : un démineur ! Vous savez, ce bon vieux jeu livré avec la plupart des systèmes d'exploitation où vous devez placer des drapeaux sur des cases pour signaler la présence d'une mine et détruire les autres cases. Mais attention, si ce jeu est simple, il vous demandera toutefois un peu de temps et de concentration, ne le prenez pas à la légère.

Pour ceux qui trouve ce challenge trop ardu, pas d'inquiétude, je vais vous indiquer une démarche à suivre, comme toujours. De plus, nous ne terminerons pas notre programme : nous n'avons pas encore vu comment créer des menus par exemple. L'achèvement de ce programme constituera notre second TP de programmation événementielle. Prêt ?

Règles du jeu et cahier des charges

Quelques rappels

Pour ceux qui auraient oublié ou qui n'auraient pas connu cette antiquité (toujours vivante) de l'informatique que constitue le jeu du démineur voici un petite capture d'écran :

Le jeu de démineur

Le jeu est simple : au début, vous disposer d'une grille de $9 \times 9$ cases (pour le niveau facile). En faisant un clic gauche sur l'une d'entre elles, elle s'autodétruit. Mais attention ! S'il y a l'une des 10 mines en dessous, elle explose et vous perdez la partie. S'il n'y en a pas, un chiffre apparaît à la place de la case indiquant le nombre de mines présentes juste à côté de cette case (au-dessus, au-dessous, à gauche ou à droite, mais aussi en diagonale soit un maximum de 8 bombes).

Si vous êtes certains d'avoir deviné l'emplacement d'une bombe, il suffit de faire un clic droit sur la case pour y placer un drapeau qui signalera sa présence et évitera que vous ne cliquiez dessus. Vous gagnez lorsque toutes les cases non minées ont été détruites.

Je n'y ai jamais joué mais ça a l'air complexe. Comment peut-on gagner ?

C'est pourtant simple, prenons un exemple :

0

0

0

0

0

1

1

1

0

1

?

?

0

1

?

?

Le 1 à la deuxième ligne et deuxième colonne indique qu'il y a une seule mine dans son entourage, elle ne peut se situer qu'à la troisième ligne et troisième colonne. Par conséquent, les autres 1 nous indiquent qu'il ne peut pas y avoir d'autre mine parmi les points d'interrogation de la deuxième colonne ou de la deuxième ligne : nous pourrons cliquer dessus sans risque.

Règles retenues

Le démineur que je vous propose de réaliser conservera la plupart des règles :

  • Il présentera un compteur de drapeaux restants.
  • Les mines seront placées de façon aléatoire.
  • Un clic gauche détruira une case.
  • Un clic gauche sur une mine entraîne une défaite immédiate.
  • Un clic gauche sur un drapeau est neutralisé (aucune action).
  • Les cases ne jouxtant aucune mine n'afficheront rien (même pas de 0).
  • Un clic gauche sur une case 0 entraînera automatiquement la destruction des 8 cases alentours, évitant à l'utilisateur de cliquer de nombreuses fois pour découvrir des chiffres.
  • Un clic droit sur une case normale placera ou enlèvera un drapeau.
  • Un clic droit sur un drapeau ne placera pas de point d'interrogation. Cette possibilité pourra être implémentée si vous le souhaitez mais elle n'est pas exigée.
  • Les chiffres indiquant le nombre de mines auront chacun une couleur spécifique pour faciliter leur visualisation.
  • Le démineur classique propose des fonctionnalités comme le clic gauche-droite qui permet de visualiser les cases concernées par un chiffre. Cette fonctionnalité n'est pas exigée.

Ce premier démineur sera encore rudimentaire. Nous entrerons les dimensions de la grille et le nombre de mines via la console. Dans le prochain TP, nous ajouterons des menus à notre démineur ainsi que des niveaux de difficultés intégrant directement les dimensions et le nombre de bombes. Pour l'heure, nous allons créer les packages nécessaires à la constitution d'une grille de démineur réutilisable facilement par d'autres programmes.

Quelques ressources

Pour réaliser ce TP, vous aurez besoin de quelques ressources. Les images tout d'abord. Faites un clic droit puis «enregistrer sous» :

drapeau-bleu.png

mine-noire.png

mine-rouge.png

J'ai utilisé la mine noire comme icône du jeu et la rouge lorsque le joueur cliquera sur une mine. Il est bien entendu évident que la mine rouge n'apparaît qu'en cas d'échec. Je vous joint également une police d'écriture rappelant les affichages à 7 bâtons de nos réveils pour votre compteur :

Police DS-Digital

Un petit coup de main

Premier objectif : détruire une case

Votre premier problème sera l'action principale du démineur : détruire des boutons et les remplacer (ou pas) par des étiquettes ou des images. Je vous conseille donc de commencer par là. Créez une simple fenêtre contenant un unique bouton et un unique callback. Pour atteindre votre objectif, vous aurez besoin d'une méthode commune à tous les widgets : destroy(). Comme son nom l'indique, cela vous permettra de détruire votre bouton : votre GTK_Button sera réinitialisé à NULL et le bouton disparaîtra de votre fenêtre.

Pour ce qui est de l'affichage de texte ou d'image, je vous conseille de créer un type TAGGED RECORD contenant la plupart des infos comme :

  • La case est-elle minée ?
  • Le nombre de bombes avoisinant cette case.
  • L'état de la case : normal, creusée ou signalée par un drapeau.
  • Les différents widgets correspondants : GTK_Button, GTK_Label et GTK_Image.

Vous serez sûrement amenés à élargir ces attributs au fur et à mesure mais cela devrait suffire pour l'instant. Revenons à l'affichage d'une image ou d'un texte. Celui-ci ne peut se faire qu'au moment de la destruction du bouton et donc au sein de votre callback. Ce dernier prendra un paramètre qui est votre case (que j'ai personnellement appelé TYPE T_Tile, vu que le mot CASE est un mot réservé) : il sera donc au moins issu du package Gtk.Handlers.User_Callback. Je dis «au moins» car nous verrons qu'il faudra modifier cela avec le prochain problème. C'est également à ce moment que vous pourrez initialiser le GTK_Label et la GTK_Image, il est en effet inutile qu'ils encombrent la mémoire plus tôt.

Second objectif : placer un drapeau

Vous devrez ensuite être capable d'ajouter ou de supprimer une image dans un bouton. Cela se fait assez simplement avec les méthodes Add() et Destroy(). Commencez par réaliser cette action avec un simple clic gauche et n'oubliez pas d'afficher les images ou textes avec la méthode Show()

Une fois cette étape franchie, vous devrez modifier votre callback précédent pour qu'il gère le clic gauche (destruction de case) et le clic droit (création/suppression d'un drapeau). Cela vous obligera à utiliser le package Gdk.Event comme nous l'avons vu dans le chapitre sur les signaux. Nous utiliserons notamment l'événement Signal_Button_Press_Event et la fonction Get_Button(). Pour rappel, cette fonction renvoie 1 si vous cliquez sur le bouton de gauche, 2 sur le bouton central et 3 sur le bouton de droite de votre souris.

Mais surtout, l'événement Signal_Button_Press_Event exigera que votre callback soit une fonction renvoyant un booléen et non une procédure. Vous devrez donc le modifier et faire appel au package Gtk.Handlers.User_Return_Callback plutôt qu'à Gtk.Handlers.User_Callback.

Troisième objectif : passer du bouton unique à la grille

Les choses restent simples tant que vous n'avez qu'un seul bouton à gérer. Mais elles vont se compliquer dès lors que vous devrez gérer de nombreux boutons. Je vous conseille de commencer par créer un type «tableau de cases». Cela n'est pas bien compliqué mais vous devez penser que votre callback devra à l'avenir être capable de modifier le compteur de drapeaux ou de découvrir les cases adjacentes. Il va très vite devenir nécessaire de créer un type spécifique pour englober toutes les informations et widget du jeu.

Ce nouveau type (appelons-le T_Game par exemple) sera le paramètre principal de votre callback. Je vous conseille de lui attribuer trois paramètres : la largeur, la longueur et le nombre de bombes. Cela vous permettra de l'initialiser à votre convenance et de le réutiliser facilement dans le prochain TP.

Quatrième objectif : destruction de cases en cascade

Pour l'heure vous ne devriez avoir la possibilité de détruire qu'une case à la fois. Or, si l'on clique sur une case nulle (pas de mine au-dessous ou aux alentours), on sait que les 8 cases alentours pourraient être détruites immédiatement.

Rien de bien compliqué ! :D Il suffit de deux boucles FOR imbriquées pour détruire ces cases. C'est de la rigolade.

Sauf que si l'une d'entre elles (ou plusieurs) sont également nulles, leurs entourages respectifs devraient également être détruits et ainsi de suite. Cela impliquera donc une sorte de destruction en chaîne des cases. Et cette destruction en chaîne peut se diriger dans n'importe qu'elle direction.

Ah oui… :( C'est plus compliqué que prévu. Mais peut-être qu'avec une troisième boucle…

Une troisième boucle pourrait être une idée seulement vous devrez très certainement faire de très nombreux testes inutiles et créer un algorithme compliqué. Non, le plus judicieux serait d'utiliser la récursivité. Votre double boucle FOR détruira les 8 cases entourant une case nulle et si une ou plusieurs d'entre elles sont également des cases nulles, le processus sera relancé pour ces cases (et celles-ci seulement).

Une solution possible

Les spécifications

Nous voici à l'heure fatidique de la solution. Un petit commentaire avant de commencer : pour garder une certaine uniformité avec GTKAda, vous constaterez que mon code-solution utilise régulièrement deux types :

  • Un type TAGGED RECORD contenant les informations nécessaires. Celui-ci est toujours accompagné du suffixe _Record, par exemple T_Game_Record
  • Un type ACCESS pointant sur mon type structuré. Celui-ci n'a pas de suffixe et est le type généralement utilisé par les fonctions et procédures.

Commençons à découvrir le code source de la solution par les spécifications. Tout d'abord voici le fichier définissant ce qu'est une case : 

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                           P_Tile                           --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package gère les cases de la grille. Il définit les types--
         --T_Tile_Record et T_Tile ainsi que les programmes nécessaires--
         --pour initialiser, modifier ou détruire une case.            --
         --La variable globale Drapeaux_restants y est déclarée ainsi  --
         --que le type T_Status indiquant l'état d'une case.           --
         ----------------------------------------------------------------

WITH Gtk.Button ;       USE Gtk.Button ;
WITH Gtk.Image ;        USE Gtk.Image ;
WITH Gtk.Label ;        USE Gtk.Label ;



PACKAGE P_Tile IS

      --------------------------
      --   VARIABLE GLOBALE   --
      --------------------------

   Drapeaux_Restants    : Integer ;
      --Permet le décompte des drapeaux utilisés et donc des bombes découvertes

      ---------------------
      --      TYPES      --
      ---------------------

   TYPE T_Status IS (Normal, Flag, Dug) ;
      --Indique l'état d'une case :
      --   Normal : la case existe encore et ne porte pas de drapeau
      --   Flag   : la case porte un drapeau
      --   Dug    : la case a été creusée, le bouton n'existe plus

   TYPE T_Tile_Record IS TAGGED RECORD
      Btn     : GTK_Button ;
      Img     : Gtk_Image  ;
      txt     : Gtk_label  ;
      Mine    : Boolean  := false  ;
      Nb      : Integer  := 0      ;
      Status  : T_Status := Normal ;
   END RECORD ;

   TYPE T_Tile IS ACCESS ALL T_Tile_Record ;
      --Les types permettant de manipuler les cases de la grille
      --   Btn, Img, txt sont les widgets correspondants
      --   Mine indique si la case est minée
      --   Nb indique le nombre de bombes alentours
      --   Status indique l'état de la case

      --------------------------
      --      PROGRAMMES      --
      --------------------------

   PROCEDURE Init_Tile   (T : IN OUT T_Tile) ;
      --Initialise la case

   PROCEDURE Change_State(T : ACCESS T_Tile_Record'Class) ;
      --Change l'état d'une case de Normal à Flag ou inversement

   PROCEDURE Destroy     (T : ACCESS T_Tile_Record'Class) ;
      --Détruit le bouton de la case, change son statut et charge l'image ou le texte à afficher

PRIVATE

   FUNCTION  Set_Text    (N : Integer) RETURN String ;
      --Définit le texte à afficher sur une case ainsi que sa couleur,
      --N est le nombre à afficher

END P_Tile ;

P_Tile.ads

Voici maintenant le fichier définissant un tableau de cases : 

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                     P_Tile.Tile_Array                      --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package gère les tableaux de T_Tile (cf package P_Tile)  --
         --Il définit le type T_Tile_Array ainsi que les programmes    --
         --pour initialiser le tableau et pour tester si  le joueur a  --
         --gagné.                                                      --
         ----------------------------------------------------------------

PACKAGE P_Tile.Tile_Array IS

      --------------------
      --      TYPE      --
      --------------------

   TYPE T_Tile_Array IS ARRAY(integer range <>, integer range <>) OF T_Tile ;

      --------------------
      --   PROGRAMMES   --
      --------------------

   PROCEDURE Init_Tile_Array(T : IN OUT T_Tile_Array ; Width,Height,Bombs : Integer) ;
         --Init_Tile_Array() permet de créer un tableau complet ainsi que de placer aléatoirement
         --des mines et d'affecter à chaque case le nombre de mines alentour.
         --   Width  : largeur de la grille
         --   Height : hauteur de la grille
         --   Bombs  : nombre de bombes

   FUNCTION  Victory(T : IN T_Tile_Array) RETURN Boolean ;
         --Victory() Renvoie TRUE si toutes les cases non minées ont été découvertes, et
         --FALSE s'il reste des cases à creuser

PRIVATE

   PROCEDURE Increase(T : IN OUT T_Tile_Array ; X,Y : Integer) ;
         --Increase() permet d'augmenter le nombre de bombes connues d'une case
         --de 1 point. X et Y sont les coordonnées de la bombe.

END P_Tile.Tile_Array ;

P_Tile-Tile_Array.ads

Voici maintenant le fichier définissant le type T_Game. Il s'agit du package 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
 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                       Main_Window                          --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package définit les types T_Game_Record et T_Game qui    --
         --contiennent les informations liées à la partie, notamment la--
         --grille de cases ou les principaux widgets. Il définit aussi --
         --la fonction de callback (Click_on) et la procédure          --
         --d'initialisation.
         ----------------------------------------------------------------


WITH Gtk.Window ;          USE Gtk.Window ;
WITH Gtk.Button ;          USE Gtk.Button ;
WITH Gtk.Table;            USE Gtk.Table;
WITH Gtk.Handlers ;        USE Gtk.Handlers ;
WITH Gdk.Event ;           USE Gdk.Event ;
WITH Gtk.Widget ;          USE Gtk.Widget ;
WITH Gtk.Box ;             USE Gtk.Box ;
WITH Gtk.Label ;           USE Gtk.Label ;
WITH P_Tile ;              USE P_Tile ;
WITH P_Tile.Tile_Array ;   USE P_Tile.Tile_Array ;


PACKAGE Main_Window IS

      --------------------------
      --   VARIABLE GLOBALE   --
      --------------------------

   Title : CONSTANT String := "Démineur" ;
      --Titre du jeu

      ---------------------
      --      TYPES      --
      ---------------------

   TYPE T_Game_Record(width,Height,bombs : integer) IS RECORD
      Tab      : T_Tile_Array(1..width, 1..height) ;
      X,Y      : Integer ;
      Win      : Gtk_Window;
      Grille   : Gtk_Table ;
      Compteur : Gtk_Label ;
      Box      : Gtk_Vbox ;
   END RECORD ;

   TYPE T_Game IS ACCESS ALL T_Game_Record ;
      --Contiennent la plupart des informations sur la partie :
      --   Width    : largeur de la grille de cases
      --   Height   : hauteur de la grille de cases
      --   Bombs    : Nombre de bombes
      --   Tab      : grille de cases
      --   X, Y     : variables permettant de transmettre les coordonnées de la case cliquée
      --   Win      : widget fenêtre du jeu
      --   Grille   : widget GTK_Table contenant tous les boutons
      --   Compteur : widget affichant la variable globale Drapeaux_restants
      --   Box      : widget contenant Compteur et Box

      --------------------------
      --       PACKAGES       --
      --------------------------

   PACKAGE P_Callback IS NEW Gtk.Handlers.User_Return_Callback(Gtk_Button_Record, boolean, T_Game_record) ;
   USE P_Callback ;
      --Package des callback

      --------------------------
      --      PROGRAMMES      --
      --------------------------

   PROCEDURE Init_Game(Game : IN OUT T_Game ; Width,Height,Bombs : Integer) ;
      --Procédure d'initialisation du jeu
      --Les paramètres correspondent à ceux du type T_Game_Record

   FUNCTION click_on(Emetteur  : ACCESS Gtk_Button_Record'Class ;
                     Evenement : Gdk_Event ;
                     Game      : T_Game_Record) RETURN Boolean ;
      --Callback appelé lorsque le joueur clique sur un bouton
      --Celui-ci permet de placer ou d'enlever un drapeau
      --mais aussi de creuser une case

PRIVATE

   PROCEDURE Init_Window   (Game : T_Game) ;
      --initialise la fenêtre de jeu
   PROCEDURE Init_Compteur (Game : T_Game) ;
      --initialise le compteur
   PROCEDURE Init_Box      (Game : T_Game) ;
      --initialise le paramètre Box et y ajoute les widgets Compteur et Grille
   PROCEDURE Init_Grille   (Game : T_Game ; Width,Height,Bombs : Integer) ;
      --initialise la grille de boutons et connecte à chacun son callback
   PROCEDURE Set_Compteur  (Game : T_Game_Record ) ;
      --met à jour le compteur de drapeaux
   PROCEDURE Explosion     (Game : T_Game_Record ; X,Y : Integer) ;
      --affiche la bombe et lance la boîte de dialogue de défaite
   PROCEDURE Creuser_Autour(Game : T_Game_Record ; X,Y : Integer) ;
      --détruit les 8 cases entourant la case de coordonnées (X,Y)
      --rappelle la procédure Creuser si l'une des 8 cases est nulle
   PROCEDURE Creuser       (Game : T_Game_Record ; X,Y : Integer) ;
      --détruit la case de coordonnées (X,Y). Lance explosion si la case
      --est minée ; lance Creuser_autour si la case est nulle

END Main_Window ;

Main_Window.ads

Enfin, un package annexe permettant l'ouverture de boîte de dialogue pour la victoire ou la défaite : 

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                         P_Dialog                           --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package définit les deux boîtes de dialogue du jeu :     --
         --Loose_Dialog qui s'ouvre si vous cliquez sur une mine et    --
         --Win_Dialog qui s'ouvre si vous avez découvert toutes les    --
         --mines. Il fournit également les procédures nécessaires à    --
         --initialisation                                              --
         ----------------------------------------------------------------


WITH Gtk.Message_Dialog ;              USE Gtk.Message_Dialog ;
WITH Gtk.Window ;                      USE Gtk.Window ;


PACKAGE P_Dialog IS

      ----------------------------
      --   VARIABLES GLOBALES   --
      ----------------------------

   Loose_Dialog : Gtk_Message_Dialog ;
   Win_Dialog   : Gtk_Message_Dialog ;

      --------------------------
      --      PROGRAMMES      --
      --------------------------

   PROCEDURE Init_Loose_Dialog(Parent : Gtk_Window) ;
   PROCEDURE Init_Win_Dialog  (Parent : Gtk_Window) ;
      --Initialisent les boîtes dialogues ci-dessus
      --   Parent : indique la fenêtre mère (Game.Win)

END P_Dialog ;

P_Dialog.ads

Le corps des packages

Si vous souhaitez comprendre le fonctionnement des programmes décrits plus haut, en voici le détail :

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                           P_Tile                           --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package gère les cases de la grille. Il définit les types--
         --T_Tile_Record et T_Tile ainsi que les programmes nécessaires--
         --pour initialiser, modifier ou détruire une case.            --
         --La variable globale Drapeaux_restants y est déclarée ainsi  --
         --que le type T_Status indiquant l'état d'une case.           --
         ----------------------------------------------------------------

PACKAGE BODY P_Tile IS

   PROCEDURE Init_Tile(T : in out T_Tile) IS
   BEGIN
      T := new T_Tile_record ;
      GTK_new(T.Btn) ;
      T.Mine := False ;
      T.Nb := 0 ;
      T.Status := normal ;
   END Init_Tile ;


   PROCEDURE Change_State(T : ACCESS T_Tile_Record'Class) IS
   BEGIN
      IF T.status = Normal
            THEN T.Status := Flag ;
                 GTK_New(T.Img,"./drapeau-bleu.png") ;
                 T.Btn.Add(T.Img) ;
                 T.Img.Show ;
                 Drapeaux_restants := Drapeaux_restants - 1 ;
            ELSE T.Status := Normal ;
                 T.Img.Destroy ;
                 Drapeaux_restants := Drapeaux_restants + 1 ;
      END IF ;
   END Change_State ;


   FUNCTION  Set_Text(N : Integer) RETURN String IS
   BEGIN
      CASE N IS
         WHEN 1 => RETURN "<span font_desc='comic sans ms 12' foreground='blue'>1</span>" ;
         WHEN 2 => RETURN "<span font_desc='comic sans ms 12' foreground='#096A09'>2</span>" ;
         WHEN 3 => RETURN "<span font_desc='comic sans ms 12' foreground='red'>3</span>" ;
         WHEN 4 => RETURN "<span font_desc='comic sans ms 12' foreground='#003399'>4</span>" ;
         WHEN 5 => RETURN "<span font_desc='comic sans ms 12' foreground='#6C0277'>5</span>" ;
         WHEN 6 => RETURN "<span font_desc='comic sans ms 12' foreground='#87591A'>6</span>" ;
         WHEN 7 => RETURN "<span font_desc='comic sans ms 12' foreground='#DF6D14'>7</span>" ;
         WHEN 8 => RETURN "<span font_desc='comic sans ms 12' foreground='#606060'>8</span>" ;
         WHEN OTHERS => RETURN "" ;
      END CASE ;
   END Set_Text ;


   PROCEDURE Destroy(T : ACCESS T_Tile_Record'Class) IS
   BEGIN
      IF T.Status = Normal
         THEN Destroy(T.Btn) ;
              IF T.Mine
                 THEN GTK_New(T.Img,"./mine-rouge.png") ;
                      T.Img.show ;
                 ELSE Gtk_New(T.Txt,set_text(T.nb)) ;
                      T.Txt.set_use_markup(true) ;
                      T.Txt.Show ;
              END IF ;
      END IF ;
   END Destroy ;

END P_Tile ;

P_Tile.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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                     P_Tile.Tile_Array                      --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package gère les tableaux de T_Tile (cf package P_Tile)  --
         --Il définit le type T_Tile_Array ainsi que les programmes    --
         --pour initialiser le tableau et pour tester si  le joueur a  --
         --gagné.                                                      --
         ----------------------------------------------------------------

WITH Ada.Numerics.Discrete_Random ;


PACKAGE BODY P_Tile.Tile_Array IS

   PROCEDURE Init_Tile_Array(T : IN OUT T_Tile_Array ; width,height,bombs : integer) IS
      subtype random_range is integer range 1..width*height ;
      PACKAGE P_Random IS NEW Ada.Numerics.Discrete_Random(Random_Range) ;
      USE P_Random ;
      G : Generator ;
      X,Y : Integer ;
      Reste : Integer := Bombs ;
   BEGIN
      Reset(G) ;
         --Création des cases
      FOR J IN 1..height LOOP
         FOR I IN 1..width LOOP
            Init_Tile(T(I,J)) ;
         END LOOP ;
      END LOOP ;
         --Placement aléatoire des bombes et calcul des nombres associés à chaque case
      WHILE Reste > 0 LOOP
         X := Random(G) mod Width + 1 ;
         Y := Random(G) mod Height + 1 ;
         IF T(X,Y).Mine = false
            THEN T(X,Y).Mine:=True ;
                 Increase(T,X,Y) ;
                 Reste := Reste - 1 ;
         END IF ;
      END LOOP ;
   END Init_Tile_Array ;


   PROCEDURE Increase(T : IN OUT T_Tile_Array ; X,Y : Integer) IS
      xmin,xmax,ymin,ymax : integer ;
   BEGIN
      Xmin := integer'max(1  , x-1) ;
      Xmax := integer'min(x+1, T'last(1)) ;
      Ymin := integer'max(1  , Y-1) ;
      Ymax := Integer'Min(Y+1, T'Last(2)) ;
      FOR J IN Ymin..Ymax LOOP
         FOR I IN Xmin..Xmax LOOP
            T(I,J).Nb := T(I,J).Nb + 1 ;
         END LOOP ;
      END LOOP ;
   END Increase ;


   FUNCTION Victory(T : IN T_Tile_Array) RETURN Boolean IS
      Nb_mines,Nb_cases : integer := 0 ;
   BEGIN
         --Décompte du nombre de mines et de cases non détruites
      FOR J IN T'RANGE(2) LOOP
         FOR I IN T'RANGE(1) LOOP
            IF T(I,J).Status = normal or t(i,j).status = flag
                  THEN nb_cases := nb_cases + 1 ;
            END IF ;
            IF T(I,J).Mine
                  THEN Nb_Mines := Nb_Mines + 1 ;
            END IF ;
         END LOOP ;
      END LOOP ;
         --Renvoie du résultat
      RETURN Nb_Mines = Nb_Cases ;
   END Victory ;

END P_Tile.Tile_Array ;

p_tile-tile_array.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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                       Main_Window                          --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package définit les types T_Game_Record et T_Game qui    --
         --contiennent les informations liées à la partie, notamment la--
         --grille de cases ou les principaux widgets. Il définit aussi --
         --la fonction de callback (Click_on) et la procédure          --
         --d'initialisation.
         ----------------------------------------------------------------


WITH Glib ;                        USE Glib ;
WITH Glib.Convert ;                USE Glib.Convert ;
WITH P_Dialog ;                    USE P_Dialog ;
WITH Gtk.Dialog ;                  USE Gtk.Dialog ;
WITH Gtk.Main ;                    USE Gtk.Main ;


PACKAGE BODY Main_Window IS

   PROCEDURE Init_Window(Game : T_Game) IS
   BEGIN
      Gtk_New(Game.Win) ;
      Game.Win.Set_Default_Size(400,400) ;
      Game.Win.Set_Title(Locale_To_Utf8(Title)) ;
      IF Game.Win.Set_Icon_From_File("mine-noire.png")
            THEN NULL ;
      END IF ;
   END Init_Window ;


   PROCEDURE Init_Compteur(Game : T_Game) IS
   BEGIN
      Gtk_New(Game.Compteur,"<span font_desc='DS-Digital 45'>" & Integer'Image(drapeaux_restants) & "</span>") ;
      Game.Compteur.Set_Use_Markup(True) ;
   END Init_Compteur ;


   PROCEDURE Init_Box(Game : T_Game) IS
   BEGIN
      Gtk_New_Vbox(Game.Box) ;
      Game.Box.Pack_Start(Game.Compteur, expand => false, fill => false) ;
      Game.box.pack_start(Game.Grille,   expand => true,  fill => true) ;
      Game.Win.Add(Game.Box) ;
   END Init_Box ;


   PROCEDURE Init_Grille(Game : T_Game ; width,height,bombs : integer) IS
   BEGIN
         --Création de la GTK_Table et du T_Tile_Array
      Gtk_New(Game.Grille,
              Guint(Width),
              Guint(Height),
              True) ;
      Init_Tile_Array(Game.Tab,
                      Width,
                      Height,
                      Bombs) ;
         --Implantation des différents boutons et connexion de
         --chacun avec son callback
      FOR J IN 1..height LOOP
         FOR I IN 1..width LOOP
            Game.Grille.Attach(Game.Tab(I,J).Btn,
                               Guint(I)-1,Guint(I),
                               Guint(J)-1,Guint(J)) ;
            Game.X := I ;
            Game.Y := J ;
            Connect(Game.Tab(I,J).Btn,
                    Signal_Button_Press_Event,
                    To_Marshaller(click_on'ACCESS),
                    Game.all) ;
         END LOOP ;
      END LOOP ;
   END Init_Grille ;


   PROCEDURE Init_Game(Game : in out T_Game ; width,height,bombs : integer) IS
   BEGIN
      Game := NEW T_Game_Record(width,height,bombs) ;
      Init_Window(Game) ;
      Init_Compteur(Game) ;
      Init_Grille(Game,Width,Height,Bombs) ;
      Init_box(Game) ;
      Game.Win.show_all ;
   end Init_Game ;


   PROCEDURE Set_Compteur(Game : T_Game_Record) IS
   BEGIN
      IF Drapeaux_Restants < 0
            THEN Game.Compteur.Set_Label("<span foreground = 'red' font_desc='DS-Digital 45'>" &
                                         Integer'Image(Drapeaux_Restants) &
                                         "</span>") ;
            ELSE Game.Compteur.Set_Label("<span foreground = 'black' font_desc='DS-Digital 45'>" &
                                         Integer'Image(Drapeaux_Restants) &
                                         "</span>") ;
      END IF ;
   END Set_Compteur ;


   FUNCTION click_on(Emetteur  : ACCESS Gtk_Button_Record'Class ;
                     Evenement : Gdk_Event ;
                     Game      : T_Game_record) RETURN Boolean IS
      X : CONSTANT Integer := Game.X ;
      Y : CONSTANT Integer := Game.Y ;
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
         --Choix des procédures à lancer selon le bouton cliqué
      CASE Get_Button(Evenement)IS
         WHEN 1 => Creuser(Game,X,Y) ;
         WHEN 3 => Game.Tab(X,Y).Change_State ;
                   Set_Compteur(Game) ;
         WHEN OTHERS => NULL ;
      END CASE ;
         --Teste de victoire et lancement éventuels de la boîte de dialogue
         --de victoire. Notez bien le "AND THEN"
      IF Victory(Game.Tab) AND THEN Win_Dialog.Run = Gtk_Response_Ok
         THEN Main_Quit ;
      END IF ;
      RETURN False ;
   END Click_On ;


   PROCEDURE Explosion(Game : T_Game_Record ; X,Y : Integer) IS
   BEGIN
         --Affichage de l'image de la bombe cliquée
      Game.Grille.Attach(Game.tab(x,y).Img,
                         Guint(X)-1,
                         Guint(X),
                         Guint(Y)-1,
                         Guint(Y)) ;
         --Ouverture de la boîte de dialogue de défaite
      IF Loose_Dialog.Run = Gtk_Response_Ok
         THEN Main_Quit ;
      END IF ;
   END Explosion ;


   PROCEDURE Creuser_Autour(Game : T_Game_Record ; X,Y : Integer) IS
      Xmin,Xmax,Ymin,Ymax : Integer ;
      tile : T_Tile ;
   BEGIN
      Xmin := integer'max(1  , x-1) ;
      Xmax := integer'min(x+1, Game.Tab'last(1)) ;
      Ymin := integer'max(1  , Y-1) ;
      Ymax := Integer'Min(Y+1, Game.Tab'Last(2)) ;
         --parcourt des 9 cases autour de (X,Y)
      FOR J IN Ymin..Ymax LOOP
         FOR I IN Xmin..Xmax LOOP
            Tile := Game.Tab(I,J) ;
               --si la case porte un chiffre, elle est simplement détruite,
               --sinon, on lance un appel récursif via la procédure Creuser()
            IF Tile.status = Normal and Tile.nb > 0
               THEN Tile.Destroy ;
                    Tile.Status := Dug ;
                    Game.Grille.Attach(Tile.txt,
                                       Guint(I)-1,Guint(I),
                                       Guint(J)-1,Guint(J)) ;
            ELSIF Tile.Status = normal
               THEN Creuser(Game,I,J) ;
            END IF ;
         END LOOP ;
      END LOOP ;
   END Creuser_Autour ;


   PROCEDURE Creuser(Game : T_Game_Record ; X,Y : Integer) IS
      tile : CONSTANT T_Tile := Game.tab(x,y) ;
   BEGIN
      Tile.Destroy ;
         --Si la case est minée
      IF Tile.Status = Normal AND Tile.Mine
         THEN Explosion(Game,X,Y) ;
         --Si la case n'est ni minée ni creusée
      ELSIF Tile.Status = Normal
         THEN Tile.Status := Dug ;
              Game.Grille.Attach(Tile.txt,
                                 Guint(X)-1,Guint(X),
                                 Guint(Y)-1,Guint(Y)) ;
                 --Si la case est nulle, on lance Creuser_autour()
              IF Tile.Nb = 0
                 THEN Creuser_autour(Game,x,y) ;
              END IF ;
      END IF ;
   END Creuser ;

END Main_Window ;

main_window.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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                         P_Dialog                           --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 17/06/2013                                        --
         --                                                            --
         --Ce package définit les deux boîtes de dialogue du jeu :     --
         --Loose_Dialog qui s'ouvre si vous cliquez sur une mine et    --
         --Win_Dialog qui s'ouvre si vous avez découvert toutes les    --
         --mines. Il fournit également les procédures nécessaires à    --
         --initialisation                                              --
         ----------------------------------------------------------------


WITH Glib.Convert ;                USE Glib.Convert ;
WITH Gtk.Dialog ;                      USE Gtk.Dialog ;


PACKAGE BODY P_Dialog IS

   PROCEDURE Init_Loose_Dialog(Parent : Gtk_Window)  IS
   BEGIN
      Gtk_New(Loose_Dialog,
         parent,
         Modal,
         Message_Warning,
         Buttons_Ok,
         Locale_To_Utf8("Vous avez sauté sur une mine !"));
      Loose_dialog.set_title("Perdu") ;
   END Init_Loose_Dialog ;

   PROCEDURE Init_Win_Dialog(Parent : Gtk_Window)  IS
   BEGIN
      Gtk_New(Win_Dialog,
         parent,
         Modal,
         Message_Warning,
         Buttons_Ok,
         Locale_To_Utf8("Vous avez trouvé toutes les mines !"));
      Win_dialog.set_title("Victoire") ;
   END Init_Win_Dialog ;

END P_Dialog ;

P_Dialog.adb

La procédure principale

Voici enfin le coeur du jeu. Vous constaterez qu'il est très sommaire. 

 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
WITH Ada.Text_Io ;            USE Ada.Text_Io ;
WITH Ada.Integer_Text_IO ;    USE Ada.Integer_Text_IO ;

WITH Gtk.Main ;               USE Gtk.Main ;
WITH Main_Window ;            USE Main_Window ;
WITH P_Dialog ;               USE P_Dialog ;
WITH P_Tile ;                 USE P_Tile ;


PROCEDURE Demineur IS
   Width  : Integer ;
   Height : Integer ;
   Bombs  : Integer ;
BEGIN

   Put_Line("Indiquez la largeur de la grille : ") ; get(width) ;
   Put_Line("Indiquez la hauteur de la grille : ") ; get(height) ;
   Put_Line("Indiquez le nombre de bombes : ")     ; Get(Bombs) ;
   Drapeaux_restants := Bombs ;

   DECLARE
      Game : T_Game ;
   BEGIN
      Init ;
      Init_Game        (Game,width,height,bombs) ;
      Init_Loose_Dialog(Game.Win) ;
      Init_Win_Dialog  (Game.win) ;
      Main ;
   END ;

END Demineur ;

Demnieur.adb

Ce TP s'achève mais comme vous l'aurez compris, nous le reprendrons bientôt pour le compléter, notamment par un menu et quelques options.

Pistes d'amélioration :

  • Ajouter d'une fonctionnalité pour le clic gauche et droit simultané.
  • Ajouter de la balise point d'interrogation.
  • Ajouter d'un bouton smiley pour commencer une nouvelle partie.
  • Ajouter d'un chronomètre.
  • Ajouter de modes spéciaux : le démineur Windows propose par exemple un mode caché "passe-muraille".