Licence CC BY-NC-SA

[TP] Démineur (le retour)

Publié :

Le démineur est de retour, pour votre plus grand malheur ! :pirate: Mais cette fois, nous allons le peaufiner, le fignoler et surtout l'achever ! À la fin de ce TP, vous aurez créé un véritable jeu complet et présentable. Prêts ? Alors ne perdons pas de temps et voyons tout de suite le cahier des charges.

Cahier des charges

Objectifs

Vous aurez remarqué, la fois précédente, que notre démineur était encore limité. Nous ne pouvions faire qu'une seule partie, après quoi il fallait relancer le programme. Qui plus est, la taille de la grille et le nombre de bombes devaient être entrés à la main dans la console, ce qui gâchait quelque peu le plaisir d'avoir réalisé un jeu avec Gtk. Votre mission, si vous l'acceptez, sera donc de combler ces lacunes :

  1. Permettre au joueur de recommencer une partie après une victoire ou une défaite ou lorsqu'il en a assez de la partie en cours. Attention, il ne s'agit pas de supprimer la fenêtre pour en créer une nouvelle ! Il faudra seulement la réinitialiser.
  2. Fournir des grilles prédéfinies selon des niveaux de difficulté. Ainsi, le niveau facile proposera des grilles de $9 \times 9$ cases comprenant 10 bombes ; le niveau moyen proposera des grilles de $16 \times 16$ cases comprenant 40 bombes ; le niveau difficile proposera des grilles de $16 \times 30$ cases comprenant 99 bombes.
  3. Permettre au joueur de modifier l'apparence du jeu. Vous proposerez plusieurs types de drapeaux et plusieurs types de mines (un choix entre 2 images différentes suffira et pourra se limiter aux couleurs des drapeaux ou des mines). Ces options (niveau de difficulté et apparence) constitueront la principale difficulté.
  4. Fournir au joueur une information sur le concepteur du jeu, sa version, etc.
  5. Afficher proprement la grille de jeu. Avec les images fournies, les boutons ont besoin de 43 pixels pour s'afficher correctement. Dimensionnez la fenêtre en conséquence et pensez à inclure des barres de défilement si la grille est trop grande pour être affichée.
  6. Enfin, permettre au joueur de quitter «proprement» le jeu et plus seulement en supprimant la console.

Ces objectifs sont simples et pourront être complétés à votre convenance (des idées d'améliorations seront proposées en conclusion, comme toujours).

Widgets nécessaires

Je vous laisse libre de donner à votre jeu l'apparence que vous désirez. Toutefois, vous devrez utiliser au moins une barre de menu ou une barre d'icônes. Je vous impose également l'utilisation de boutons radio pour choisir vos options ainsi que d'une barre d'onglets. De plus, comme dit précédemment, il faudra prévoir une barre de défilement au cas où il serait impossible d'afficher toutes les cases. Voici l'apparence, assez classique, que j'ai choisie :

Apparence

Apparence du menu et de la boîte de dialogue

L'apparence choisie est simple : j'ai ajouté une barre de menu à la grille. Celle-ci comporte deux items : «Fichier» et «?». Le premier donne accès aux items «Nouvelle Partie», «Préférences» et «Quitter». Le second donne accès à l'item «À Propos». Par conséquent, il a fallu créer deux boites de dialogue supplémentaires : une boîte personnalisée pour paramétrer les options et une boîte de dialogue «À propos».

Mais vous pouvez tout à fait choisir une apparence distincte. Voici une idée : utiliser une barre d'icônes pour les fonctionnalités basiques («nouvelle partie», «quitter», «à propos») et une barre d'onglets pour afficher soit la grille soit les options.

Une solution possible

Les spécifications

Les packages P_Tile et P_Tile.Tile_Array n'ont subi que des changements mineurs :

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                           P_Tile                           --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 09/08/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.Image ;              USE Gtk.Image ;
WITH Gtk.Button ;             USE Gtk.Button ;
WITH Gtk.Label ;              USE Gtk.Label ;


PACKAGE P_Tile IS

      ---------------------
      --      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

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

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

      --------------------------
      --      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

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                     P_Tile.Tile_Array                      --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 09/08/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

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

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

   TYPE T_Tile_Array_Access IS ACCESS T_Tile_Array ;

      --------------------
      --   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

En revanche le package Main_Window a disparu. Il devait être le package principal, centralisant tous les autres, mais le type T_Game étant de plus en plus utilisé par les autres packages, il est devenu nécessaire de revoir l'architecture. Il est désormais scindé en deux : P_Game qui définit notamment le type T_Game et est utilisé par quasiment tous les autres packages ; et P_Game.Methods qui définit les méthodes nécessaires au fonctionnement du jeu et centralisent toutes les données.

Vous noterez également que le type T_Game_Record a été très largement complété pour intégrer les nouveaux widgets, voire même modifié pour permettre la réinitialisation de certains paramètres. Ainsi, le paramètre Tab qui était un tableau est devenu un pointeur sur tableau.

 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
-------------------------------------------------------------------
         --                         DEMINEUR                              --
         --                          P_Game                               --
         --                                                               --
         -- AUTEUR : KAJI9                                                --
         -- DATE   : 09/08/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 également les types T_Option, T_Option_Access et    --
         --T_Niveau ainsi que la variable globale Title.                  --
         --Les méthodes associées ont été reléguées dans un package fils  --
         --appelé T_Game.Methods ce qui évite tout redondance dans les    --
         --appels de packages.                                            --
         -------------------------------------------------------------------

WITH Gtk.Window ;             USE Gtk.Window ;
WITH Gtk.Table;               USE Gtk.Table;
WITH Gtk.Widget ;             USE Gtk.Widget ;
WITH Gtk.Box ;                USE Gtk.Box ;
WITH Gtk.Label ;              USE Gtk.Label ;
WITH Gtk.Menu_Bar ;           USE Gtk.Menu_Bar ;
WITH Gtk.Menu_Item ;          USE Gtk.Menu_Item ;
WITH Gtk.Image_Menu_Item ;    USE Gtk.Image_Menu_Item ;
WITH Gtk.Menu ;               USE Gtk.Menu ;
WITH Gtk.Scrolled_Window ;    USE Gtk.Scrolled_Window  ;
WITH P_Tile ;                 USE P_Tile ;
WITH P_Tile.Tile_Array ;      USE P_Tile.Tile_Array ;


PACKAGE P_Game IS

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

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

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

   TYPE T_Option IS ARRAY(1..3) OF Integer ;
      --Ce type permet d'enregistrer facilement les choix de l'utilisateur quant à
      --la difficulté ou aux graphismes lors de l'utilisation de boîte de dialogue.
      --case n°1 : niveau de difficulté
      --case n°2 : nom du fichier pour les drapeaux
      --case n°3 : nom du fichier pour les mines

   TYPE T_Option_Access IS ACCESS T_Option ;

   TYPE T_Niveau IS (Facile, Medium, Difficile) ;
      --Type utilisé pour définir le niveau de difficulté plus clairement qu'avec T_Option

   TYPE T_Game_Record IS RECORD
      Tab            : T_Tile_Array_Access ;
      X,Y            : Integer ;
      Win            : Gtk_Window;
      Grille         : Gtk_Table ;
      Compteur       : Gtk_Label ;
      Box            : Gtk_Vbox ;
      Barre          : Gtk_Menu_Bar ;
      Item_Fichier   : Gtk_Menu_Item ;
      Item_Question  : Gtk_Menu_Item ;
      Menu_Fichier   : Gtk_Menu ;
      Menu_Question  : Gtk_Menu ;
      Item_A_Propos  : Gtk_Menu_Item ;
      Item_Nouveau   : Gtk_Image_Menu_Item ;
      Item_Option    : Gtk_Image_Menu_Item ;
      Item_Quitter   : Gtk_Image_Menu_Item ;
      Ascenseur      : Gtk_Scrolled_Window ;
      Niveau         : T_Niveau := Facile ;
      Width          : Integer := 9 ;
      Height         : Integer := 9 ;
      Bombs          : Integer := 10 ;
      General_Option : T_Option := (1,1,1) ;
   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
      --   General_Option : Tableau résumant les choix d'options de l'utilisateur
      --   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
      --   Ascenseur: widget affichant les barres de défilement (seulement si nécessaire)
      --   Items et Menus de la barre de menus

END P_Game ;

P_Game.ads

 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
----------------------------------------------------------------
         --                         DEMINEUR                           --
         --                      P_Game.Methods                        --
         --                                                            --
         -- AUTEUR : KAJI9                                             --
         -- DATE   : 09/08/2013                                        --
         --                                                            --
         --Ce package définit les fonctions de callback Click_on,      --
         --Exit_window et les procédures d'initialisation ou de        --
         --réinitialisation des types T_Game_Record et T_Game.         --
         --La décomposition en deux packages évite la redondance des   --
         --appels de packages.                                         --
         ----------------------------------------------------------------

WITH Gtk.Button ;             USE Gtk.Button ;
WITH Gtk.Handlers ;           USE Gtk.Handlers ;
WITH Gdk.Event ;              USE Gdk.Event ;
WITH Gtk.Widget ;             USE Gtk.Widget ;
WITH P_Game ;                 USE P_Game ;


PACKAGE P_Game.Methods IS

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

   PACKAGE P_Simple_Callback IS NEW Gtk.Handlers.Callback(Gtk_widget_Record) ;
   USE P_Simple_Callback ;
      --Package pour la fermeture de la fenêtre
   PACKAGE P_Callback IS NEW Gtk.Handlers.User_Callback(Gtk_widget_Record, T_Game) ;
   USE P_Callback ;
      --Package pour les menus
   PACKAGE P_Return_Callback IS NEW Gtk.Handlers.User_Return_Callback(Gtk_Button_Record, boolean, T_Game_Record) ;
   USE P_Return_Callback ;
      --Package pour les callbacks liés aux boutons de la grille

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

   PROCEDURE Init_Game(Game : T_Game) ;
      --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
   PROCEDURE Exit_Window   (Emetteur : Access GTK_Widget_Record'Class) ;
      --Callback appelé pour fermer la fenêtre
   PROCEDURE Reinit_Game   (Game     : T_Game) ;
      --Réinitialise le jeu sans détruire la fenêtre et en tenant compte
      --des paramètres définis par l'utilisateur
PRIVATE

   PROCEDURE Init_Window   (Game : T_Game ; Width,Height : Integer) ;
      --initialise la fenêtre de jeu
   PROCEDURE Init_Compteur (Game : T_Game) ;
      --initialise le compteur
   PROCEDURE Init_Menu     (Game : T_Game) ;
      --initialise le menu
   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) ;
      --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
   PROCEDURE Reinit_Game   (Emetteur : ACCESS Gtk_Widget_Record'Class ;
                            Game     : T_Game) ;
      --Callback appelé pour réinitialié la fenêtre. Se contente d'appeler
      --la procédure publique du même nom

END P_Game.Methods ;

P_Game-Methods.ads

Le package P_Dialog a logiquement été complété, et même lourdement complété. La boîte de dialogue Option_Dialog apportant de nombreuses exigences avec elle, il a fallu ajouter un package P_Option pour gérer les options. Ainsi, les widgets modifient un tableau d'entiers appelé T_Option qui est ensuite réinterprété pour connaître le niveau de difficulté ou le nom des fichiers utilisés.

 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
-------------------------------------------------------------------
         --                         DEMINEUR                              --
         --                         P_Option                              --
         --                                                               --
         -- AUTEUR : KAJI9                                                --
         -- DATE   : 09/08/2013                                           --
         --                                                               --
         --Ce package définit les principales méthodes pour connaître ou  --
         --mettre à jour les options : niveau de difficulté, fichier      --
         --choisi pour les mines ou pour les drapeaux.                    --
         --Il est principalement utilisé par P_Dialog et la boîte de      --
         --dialogue Option_Dialog.                                        --
         -------------------------------------------------------------------

WITH Ada.Strings.Unbounded ;     USE Ada.Strings.Unbounded ;
WITH P_Game ;                    USE P_Game ;


PACKAGE P_Option IS

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

   Mine_Filename    : Unbounded_string := To_unbounded_string("mine-rouge.png") ;
   Drapeau_Filename : Unbounded_String := To_Unbounded_String("drapeau-bleu.png") ;
   Current_Option : T_Option := (1,1,1) ;

      --------------------
      --    METHODES    --
      --------------------

   PROCEDURE Set_Difficulty(game : T_Game) ;
   PROCEDURE Set_Drapeau_Filename(Option : T_Option) ;
   PROCEDURE Set_Mine_Filename(Option : T_Option) ;
      --Ces procédures ajustent les paramètres du jeu
      --(nombre de bombes, tailles de la grille, nom
      --des fichiers en fonction des options choisies)

PRIVATE

   FUNCTION Get_Difficulty(Option : T_Option) RETURN T_Niveau ;
   FUNCTION Get_Drapeau_Filename(Option : T_Option) RETURN String ;
   FUNCTION Get_Mine_Filename(Option : T_Option) RETURN String ;
      --Ces fonctions transforments un tableau d'entiers (T_Option)
      --en valeurs plus aisément lisibles et utilisables comme une
      --chaîne de caractères pour les noms des fichiers ou un type
      --T_Niveau dont les valeurs sont compréhensibles : Facile, Medium
      -- et Difficile.

END P_Option ;

P_Option.ads

 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
-------------------------------------------------------------------
         --                         DEMINEUR                              --
         --                         P_Dialog                              --
         --                                                               --
         -- AUTEUR : KAJI9                                                --
         -- DATE   : 09/08/2013                                           --
         --                                                               --
         --Ce package définit les quatre boîtes de dialogue du jeu :      --
         --Loose_Dialog qui s'ouvre si vous cliquez sur une mine ;        --
         --Win_Dialog qui s'ouvre si vous avez découvert toutes les       --
         --mines ;                                                        --
         --About_Dialog qui s'ouvre lorsque vous cliquez sur A propos     --
         --Option_Dialog qui s'ouvre lorsque vous cliquez sur Préférences --
         --Il fournit également les procédures nécessaires à leur         --
         --initialisation                                                 --
         -------------------------------------------------------------------

WITH Gtk.Widget ;                      USE Gtk.Widget ;
WITH Gtk.Dialog ;                      USE Gtk.Dialog ;
WITH Gtk.Message_Dialog ;              USE Gtk.Message_Dialog ;
WITH Gtk.About_Dialog ;                USE Gtk.About_Dialog ;
WITH Gtk.Window ;                      USE Gtk.Window ;
WITH Gtk.Enums ;                       USE Gtk.Enums ;
WITH P_Game ;                          USE P_Game ;
WITH Gtk.Handlers ;


PACKAGE P_Dialog IS

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

   Loose_Dialog  : Gtk_Message_Dialog ;
   Win_Dialog    : Gtk_Message_Dialog ;
   About_Dialog  : Gtk_About_Dialog ;
   Option_Dialog : Gtk_Dialog ;

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

   PROCEDURE Init_Loose_Dialog(Parent : Gtk_Window) ;
   PROCEDURE Init_Win_Dialog  (Parent : Gtk_Window) ;
   PROCEDURE Init_About_Dialog ;
   PROCEDURE Init_Option_Dialog(Game : T_Game) ;
      --Initialisent les boîtes dialogues ci-dessus
      --   Parent : indique la fenêtre mère (Game.Win)
   PROCEDURE Run_About_Dialog(Emetteur : ACCESS Gtk_Widget_Record'Class) ;
   PROCEDURE Run_Option_Dialog(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                               Game     : T_Game) ;
      --Callbacks appelés pour lancer les boîtes de dialogue About_Dialog et Option_Dialog

PRIVATE

   PACKAGE P_Callback IS NEW Gtk.Handlers.User_Callback(Gtk_Widget_Record, Integer) ;
   USE P_Callback ;

   PROCEDURE Change_Difficulty(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                               Valeur : Integer) ;
   PROCEDURE Change_Drapeau_Filename(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                                     Valeur : Integer) ;
   PROCEDURE Change_Mine_Filename(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                                  Valeur : Integer) ;
      --Callbacks utilisés par la boîte de dialogue Option_Dialog :
      --ils permettent de connaître le choix fait par l'utilisateur
      --en termes de difficulté ou d'image pour les drapeaux et les
      --mines.
END P_Dialog ;

P_Dialog.ads

Le corps des packages

Venons-en maintenant au corps de ces packages. Attention, il n'existe pas de fichier P_Game.adb, ce package ne faisant que définir des types et variables.

 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   : 09/08/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 P_Option  ;              USE P_Option ;
WITH Ada.Strings.Unbounded ;  USE Ada.Strings.Unbounded ;

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,"./" & to_string(Drapeau_Filename)) ;
                 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,"./" & to_string(mine_filename)) ;
                      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   : 09/08/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 ;
         --Renvoi 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
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
----------------------------------------------------------------
         --                         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 Gtk.Window ;                  USE Gtk.Window ;
WITH Gtk.Table;                    USE Gtk.Table;
WITH Gtk.Box ;                     USE Gtk.Box ;
WITH Gtk.Label ;                   USE Gtk.Label ;
WITH Gtk.Menu_Bar ;                USE Gtk.Menu_Bar ;
WITH Gtk.Menu_Item ;               USE Gtk.Menu_Item ;
WITH Gtk.Image_Menu_Item ;         USE Gtk.Image_Menu_Item ;
WITH Gtk.Menu ;                    USE Gtk.Menu ;
WITH Gtk.Scrolled_Window ;         USE Gtk.Scrolled_Window  ;
WITH Gtk.Dialog ;                  USE Gtk.Dialog ;
WITH Gtk.Main ;                    USE Gtk.Main ;
WITH Gtk.Enums ;                   USE Gtk.Enums ;
WITH P_Tile ;                      USE P_Tile ;
WITH P_Tile.Tile_Array ;           USE P_Tile.Tile_Array ;
WITH P_Dialog ;                    USE P_Dialog ;
WITH Ada.Unchecked_Deallocation ;


PACKAGE BODY P_Game.Methods IS

   PROCEDURE Init_Window(Game : T_Game ; Width,Height : Integer) IS
   BEGIN
         --Création d'une fenêtre avec callbakc et dimensions correctes
      Gtk_New(Game.Win) ;
      Game.Win.Set_Default_Size(43*Gint(width),82 + 43*Gint(Height)) ;
      Game.Win.Set_Title(Locale_To_Utf8(Title)) ;
      IF Game.Win.Set_Icon_From_File("mine-noire.png")
            THEN NULL ;
      END IF ;
      connect(game.win, "destroy", exit_window'access) ;
   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_Menu     (Game : T_Game) IS
   BEGIN
         --Création des menus et des items
      Gtk_New(Game.Barre) ;
      Gtk_New(Game.Item_Fichier, "Fichier") ;
      Gtk_New(Game.Item_Question, "?") ;
      Gtk_New_From_Stock(Game.Item_Nouveau, "gtk-new") ;
      Game.Item_Nouveau.set_label("Nouvelle partie") ;
      Gtk_New_From_Stock(Game.Item_Option, "gtk-preferences") ;
      Gtk_New_From_Stock(Game.Item_Quitter, "gtk-close") ;
      Game.Item_Quitter.Set_Label("Quitter") ;
      Gtk_New(Game.Item_A_Propos, "A propos") ;
      Gtk_New(Game.Menu_Fichier) ;
      Gtk_New(Game.Menu_Question) ;
         --Organisation des menus
      Game.Barre.Append(Game.Item_Fichier) ;
      Game.Item_Fichier.Set_Submenu(Game.Menu_Fichier) ;
      Game.Barre.Append(Game.Item_Question) ;
      Game.Item_Question.Set_Submenu(Game.Menu_Question) ;
      Game.Menu_Fichier.Append(Game.Item_Nouveau) ;
      Game.Menu_Fichier.Append(Game.Item_Option) ;
      Game.Menu_Fichier.Append(Game.Item_Quitter) ;
      Game.Menu_Question.Append(Game.Item_A_Propos) ;
         --Connexions avec les callbacks appropriés
      Connect(Game.Item_Quitter, "activate", Exit_Window'ACCESS) ;
      Connect(Game.Item_A_Propos, "activate", Run_About_Dialog'ACCESS) ;
      Connect(Game.Item_Option, "activate", Run_Option_Dialog'ACCESS, Game) ;
      Connect(Game.Item_Nouveau, "activate", Reinit_Game'ACCESS, Game) ;
   END Init_Menu ;


   PROCEDURE Init_Box(Game : T_Game) IS
   BEGIN
         --Organisation de la fenêtre avec boîtes et ascenseurs
      Gtk_New_Vbox(Game.Box) ;
      Game.Box.Pack_Start(Game.Barre,      Expand => False, Fill=> True) ;
      Game.Box.Pack_Start(Game.Compteur,  Expand => False, Fill => False) ;
      Gtk_New(Game.Ascenseur) ;
      Game.Ascenseur.Set_Policy(Policy_Automatic, Policy_Automatic) ;
      Game.box.pack_start(Game.Ascenseur, Expand => true,  Fill => true) ;
      Game.Ascenseur.add_with_viewport(Game.Grille) ;
      Game.Win.Add(Game.Box) ;
   END Init_Box ;


   PROCEDURE Init_Grille(Game : T_Game) IS
   BEGIN
         --Création de la GTK_Table et du T_Tile_Array
      Gtk_New(Game.Grille,
              Guint(Game.Width),
              Guint(Game.Height),
              True) ;
      Init_Tile_Array(Game.Tab.all,
                      Game.Width,
                      Game.Height,
                      Game.Bombs) ;
         --Implantation des différents boutons et connexion de
         --chacun avec son callback
      FOR J IN 1..game.height LOOP
         FOR I IN 1..game.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 Reinit_Game(Game     :  T_Game) IS
      PROCEDURE Free IS NEW Ada.Unchecked_Deallocation(T_Tile_Array,T_Tile_Array_Access) ;
   BEGIN
         --Réinitialisation d'une fenêtre : destruction et recréation
         --de certains objets
      Free(Game.Tab) ;
      Game.tab := new T_Tile_Array(1..game.width, 1..game.height) ;
      Game.Win.Resize(43*Gint(game.Width), 82 + 43*Gint(game.Height)) ;
      Drapeaux_restants := game.Bombs ;
      Set_compteur(Game.all) ;
      Game.Grille.Destroy ;
      Init_Grille(Game) ;
      Game.Ascenseur.add_with_viewport(Game.Grille) ;
      Game.Win.Show_All ;
   END Reinit_Game ;


   PROCEDURE Reinit_Game(Emetteur : ACCESS Gtk_widget_Record'Class ;
                         Game     :  T_Game) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Reinit_Game(Game) ;
   END Reinit_Game ;


   PROCEDURE Init_Game(Game : T_Game) IS
   BEGIN
      Game.tab := new T_Tile_Array(1..game.width, 1..game.height) ;
      Init_Window(Game,game.width,game.height) ;
      Init_Compteur(Game) ;
      Init_menu(Game) ;
      Init_Grille(Game) ;
      Init_box(Game) ;
      Game.Win.Show_All ;
      Init_Loose_Dialog(Game.Win) ;
      Init_Win_Dialog  (Game.Win) ;
   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.all) AND THEN Win_Dialog.Run = Gtk_Response_Ok
         THEN Game.Item_Nouveau.Activate ;
              Win_Dialog.Destroy ;
              Init_Win_Dialog(Game.Win) ;
      END IF ;
      RETURN False ;
   END Click_On ;


   PROCEDURE Exit_Window   (Emetteur : ACCESS GTK_Widget_Record'Class) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Main_Quit ;
   END Exit_Window ;


   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 Game.Item_Nouveau.Activate ;
                 Loose_Dialog.Destroy ;
                 Init_Loose_Dialog(Game.Win) ;
      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 P_Game.Methods ;

P_Game.Methods.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
-------------------------------------------------------------------
         --                         DEMINEUR                              --
         --                         P_Option                              --
         --                                                               --
         -- AUTEUR : KAJI9                                                --
         -- DATE   : 09/08/2013                                           --
         --                                                               --
         --Ce package définit les principales méthodes pour connaître ou  --
         --mettre à jour les options : niveau de difficulté, fichier      --
         --choisi pour les mines ou pour les drapeaux.                    --
         --Il est principalement utilisé par P_Dialog et la boîte de      --
         --dialogue Option_Dialog.                                        --
         -------------------------------------------------------------------

PACKAGE BODY P_Option IS

   FUNCTION Get_Difficulty(Option : T_Option) RETURN T_Niveau IS
   BEGIN
      CASE Option(1) IS
         WHEN 1 => RETURN Facile ;
         WHEN 2 => RETURN Medium ;
         WHEN OTHERS => RETURN Difficile ;
      END CASE ;
   END Get_Difficulty ;


   FUNCTION Get_Drapeau_Filename(Option : T_Option) RETURN String IS
   BEGIN
      CASE Option(2) IS
         WHEN 1 => RETURN "./drapeau-bleu.png" ;
         WHEN OTHERS => RETURN "./drapeau-rouge.png" ;
      END CASE ;
   END Get_Drapeau_Filename ;


   FUNCTION Get_Mine_Filename(Option : T_Option) RETURN String IS
   BEGIN
      CASE Option(3) IS
         WHEN 1 => RETURN "./mine-rouge.png" ;
         WHEN OTHERS => RETURN "./mine-noire.png" ;
      END CASE ;
   END Get_Mine_Filename ;


   PROCEDURE Set_Difficulty(game : T_Game) IS
   BEGIN
      Game.Niveau := Get_Difficulty(Game.General_Option) ;
      CASE game.Niveau IS
         WHEN Facile    => game.Width  := 9 ;
                           game.Height := 9 ;
                           game.Bombs  := 10 ;
         WHEN Medium    => game.Width  := 16 ;
                           game.Height := 16 ;
                           game.Bombs  := 40 ;
         WHEN Difficile => game.Width  := 30 ;
                           game.Height := 16 ;
                           game.Bombs  := 99 ;
      END CASE ;
   END Set_Difficulty ;


   PROCEDURE Set_Drapeau_Filename(Option : T_Option) IS
   BEGIN
       Drapeau_Filename := To_unbounded_string(Get_Drapeau_Filename(Option)) ;
   END Set_Drapeau_Filename ;


   PROCEDURE Set_Mine_Filename(Option : T_Option) IS
   BEGIN
      Mine_Filename := To_unbounded_string(Get_Mine_Filename(Option)) ;
   END Set_Mine_Filename ;

END P_Option ;

P_Option.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
----------------------------------------------------------------
         --                         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 Gnat.Strings ;                USE Gnat.Strings ;
WITH Gtk.Image ;                   USE Gtk.Image ;
WITH Gtk.Button ;                  USE Gtk.Button ;
WITH Gtk.Radio_Button ;            USE Gtk.Radio_Button ;
WITH Gtk.Label ;                   USE Gtk.Label ;
WITH Gtk.Notebook ;                USE Gtk.Notebook ;
WITH Gtk.Box ;                     USE Gtk.Box ;
WITH P_Option ;                    USE P_Option ;
WITH P_Game.Methods ;              USE P_Game.Methods ;



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 ;


   PROCEDURE Init_About_Dialog IS
      Liste_Auteurs : Gnat.Strings.String_List(1..1) ;
      Logo          : GTK_Image ;
   BEGIN
      Gtk_New(Logo, "sea-mine.png") ;
      Gtk_New(About_Dialog) ;
      Liste_auteurs(1) := new string'("Kaji9") ;
      About_Dialog.Set_Authors(Liste_Auteurs) ;
      About_Dialog.Set_Logo(Logo.Get) ;
      About_Dialog.Set_Program_Name(Locale_To_Utf8("Démineur Ada")) ;
      About_Dialog.Set_Version("2.0") ;
      About_Dialog.Set_Comments(locale_to_utf8("Vous trouverez le code source "
         & "de ce programme sur le Site du Zéro "
         & "à l'adresse suivante : "
         & "http://www.v3.siteduzero.com/tutoriel-3-547729-1-apprendre-a-programmer-avec-ada.html")) ;
   END Init_About_Dialog ;


   PROCEDURE Init_Option_Dialog(Game : T_Game) IS
      Btn_Cancel     : GTK_Button ; PRAGMA Unreferenced(Btn_Cancel) ;
      Btn_OK         : GTK_Button ; PRAGMA Unreferenced(Btn_OK) ;
      Onglets        : GTK_Notebook ;
      Box1,box3,box4 : Gtk_VBox ;
      Box2           : Gtk_Hbox ;
      Page1          : Gtk_Label ;
      Page2          : Gtk_Label ;
      Btn_Facile     : GTK_Radio_Button ;
      Btn_Difficile  : GTK_Radio_Button ;
      Btn_Moyen      : GTK_Radio_Button ;
      Btn_Drapeau1   : GTK_Radio_Button ;
      Btn_Drapeau2   : GTK_Radio_Button ;
      Btn_Mine1      : GTK_Radio_Button ;
      Btn_Mine2      : GTK_Radio_Button ;
   BEGIN
         --Création de la boîte de dialogue
      Gtk_New(Option_Dialog) ;
      Option_Dialog.Set_Title(Locale_To_Utf8("Préférences")) ;
         --Création et ajout de deux boutons d'action
      Btn_Cancel := Gtk_Button(Option_Dialog.Add_Button("Annuler", GTK_Response_Cancel)) ;
      Btn_Ok     := Gtk_Button(Option_Dialog.Add_Button("Valider", GTK_Response_OK)) ;
         --Création et organisation des diverses boîtes nécessaires
      Gtk_New_Vbox(Box1) ;
      Gtk_New_Hbox(Box2) ;
      Gtk_New_Vbox(Box3) ;
      Gtk_New_Vbox(Box4) ;
      Box2.Pack_Start(Box3) ;
      Box2.Pack_Start(Box4) ;
         --Création, organisation et connexion des boutons radio de difficulté
         --Puis sélection de la difficulté en cours
      Gtk_New(Btn_Facile,   NULL,      Locale_To_Utf8("Débutant")) ;
      Gtk_New(Btn_Moyen,    Btn_Facile,Locale_To_Utf8("Confirmé")) ;
      Gtk_New(Btn_Difficile,Btn_Moyen, Locale_To_Utf8("Expert")) ;
      Box1.Pack_Start(Btn_Facile) ;
      Box1.Pack_Start(Btn_Moyen) ;
      Box1.Pack_Start(Btn_Difficile) ;
      Connect(Btn_Facile,   "clicked",Change_Difficulty'ACCESS,1) ;
      Connect(Btn_Moyen,    "clicked",Change_Difficulty'ACCESS,2) ;
      Connect(Btn_Difficile,"clicked",Change_Difficulty'ACCESS,3) ;
      CASE Game.General_Option(1) IS
         WHEN 1 => Btn_Facile.Set_Active(True) ;
         WHEN 2 => Btn_Moyen.Set_Active(True) ;
         WHEN OTHERS => Btn_Difficile.Set_Active(True) ;
      END CASE ;
         --Création, organisation et connexion des boutons radio de drapeau
      Gtk_New(Btn_Drapeau1, NULL,         "Drapeaux bleus") ;
      Gtk_New(Btn_Drapeau2, Btn_Drapeau1, "Drapeaux rouges") ;
      Box3.Pack_Start(Btn_Drapeau1) ;
      Box3.Pack_Start(Btn_Drapeau2) ;
      Connect(Btn_Drapeau1, "toggled",Change_Drapeau_Filename'ACCESS,1) ;
      Connect(Btn_Drapeau2, "toggled",Change_Drapeau_Filename'ACCESS,2) ;
      CASE Game.General_Option(2) IS
         WHEN 1 => Btn_Drapeau1.Set_Active(True) ;
         WHEN OTHERS => Btn_Drapeau2.Set_Active(True) ;
      END CASE ;
         --Création, organisation et connexion des boutons radio de mine
      Gtk_New(Btn_Mine1, NULL,      "Mines rouges") ;
      Gtk_New(Btn_Mine2, Btn_Mine1, "Mines grises") ;
      Box4.Pack_Start(Btn_Mine1) ;
      Box4.Pack_Start(Btn_Mine2) ;
      Connect(Btn_Mine1, "toggled",Change_Mine_Filename'ACCESS,1) ;
      Connect(Btn_Mine2, "toggled",Change_Mine_Filename'ACCESS,2) ;
      CASE Game.General_Option(3) IS
         WHEN 1 => Btn_Mine1.Set_Active(True) ;
         WHEN OTHERS => Btn_Mine2.Set_Active(True) ;
      END CASE ;
         --Création de la barre d'onglets et des étiquettes
      Gtk_New(Page1,Locale_To_Utf8("Difficulté")) ;
      Gtk_New(Page2,"Apparence") ;
      Gtk_New(Onglets) ;
      Onglets.Append_Page(Box1,Page1) ;
      Onglets.Append_Page(Box2,Page2) ;
         --Finalisation
      Pack_Start(Option_Dialog.Get_Content_Area, Onglets) ;
      Option_Dialog.Show_All ;
   END Init_Option_Dialog ;


   PROCEDURE Run_About_Dialog(Emetteur : ACCESS Gtk_Widget_Record'Class) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Init_About_Dialog ;
      IF About_Dialog.Run = Gtk_Response_close
            THEN NULL ;
      END IF ;
      About_Dialog.Destroy ;
      Gtk_New(About_Dialog) ;
   END Run_About_Dialog ;


   PROCEDURE Run_Option_Dialog(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                               Game     : T_Game) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Init_Option_Dialog(Game) ;
      IF Option_Dialog.Run = Gtk_Response_ok
            THEN Game.General_Option := Current_Option ;
                 Set_Difficulty(Game) ;
                 Set_Drapeau_Filename(Game.General_Option) ;
                 Set_Mine_Filename(Game.General_Option) ;
                 Reinit_Game(Game) ;
      END IF ;
      Option_Dialog.Destroy ;
      Gtk_New(Option_Dialog) ;
   END Run_Option_Dialog ;


   PROCEDURE Change_Difficulty(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                               Valeur : Integer) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Current_Option(1) := Valeur ;
   END Change_Difficulty ;


   PROCEDURE Change_Drapeau_Filename(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                               Valeur : Integer) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Current_Option(2) := Valeur ;
   END Change_Drapeau_Filename ;


   PROCEDURE Change_Mine_Filename(Emetteur : ACCESS Gtk_Widget_Record'Class ;
                               Valeur : Integer) IS
      PRAGMA Unreferenced(Emetteur) ;
   BEGIN
      Current_Option(3) := Valeur ;
   END Change_Mine_Filename ;

END P_Dialog ;

P_Dialog.adb

La procédure principale

Nous voilà enfin rendus à la procédure principale. Vous remarquerez que celle-ci c'est très nettement simplifiée : la partie console a été supprimée, les paramètres concernant la taille de la grille ou le nombre de bombes sont définis automatiquement au démarrage du jeu de même que les boîtes de dialogue sont générées automatiquement par la méthode Init_Game().

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
WITH Gtk.Main ;               USE Gtk.Main ;
WITH P_Tile ;                 USE P_Tile ;
WITH P_Game ;                 USE P_Game ;
WITH P_Game.Methods ;         USE P_Game.Methods ;


PROCEDURE Demineur IS
   Game : CONSTANT T_Game := NEW T_Game_Record ;
BEGIN

   Drapeaux_restants := game.Bombs ;

   Init ;
   Init_Game(Game) ;
   Main ;

END Demineur ;

Demineur.adb


Pistes d'amélioration :

  • permettre d'avantage de personnalisation des graphismes;
  • chronométrer les parties et proposer un menu Scores affichant les meilleurs résultats;
  • permettre de personnaliser la taille des grilles (par exemple $50 \times 50$ cases avec 2 bombes)