Le démineur est de retour, pour votre plus grand malheur ! 
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 :
- 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.
- 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.
- 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é.
- Fournir au joueur une information sur le concepteur du jeu, sa version, etc.
- 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.
- 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 :
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)