[TP] Bataille navale - Apprenez à programmer avec Ada • Bibliothèque • Zeste de Savoir

Après tous ces chapitres sur la POO, nous allons prendre un peu de bon temps pour mettre toutes les notions apprises en pratique. Je vous propose de nouveau de créer un jeu. Il ne s'agira pas d'un jeu de plateau mais d'un jeu de bataille navale. Mais attention ! Pas le bon vieux jeu où on visait au hasard les cases B7 puis E4 en espérant toucher ou couler un porte-avion ! Non. Je pensais plutôt à une sorte de jeu de rôle au tour par tour. Vous disposerez d'un navire (une frégate, un galion…) et devrez affronter un navire adverse, le couler ou l'arraisonner. Le but étant de gagner de l'or, de perfectionner votre navire, d'augmenter votre équipage…

L'objectif est bien sûr de mettre en œuvre la conception orientée objet dont je vous parle et reparle depuis plusieurs chapitres. Comme à chaque fois, je commencerai par vous décrire le projet, ses objectifs, ses contraintes… puis je vous fournirai quelques conseils ou pistes avant de vous livrer une solution possible. Prêt ? Alors à l'abordage ! :pirate:

Ce TP est long à réaliser. S'il exige que vous maîtrisiez la POO, il n'exige pas que vous soyez devenus un maître en la matière. Toutefois, il vous faudra sûrement quelques jours pour en venir à bout. Bon courage.

Règles du jeu
Cahier des charges
Une solution possible

Règles du jeu

Le déroulement

Comme indiqué en introduction, il s'agira d'un jeu de rôle au tour par tour. Votre navire enchaînera les combats. Entre deux combats, trois actions seront possibles :

Retourner au port pour effectuer des réparations, recruter des matelots, améliorer votre navire ou sauvegarder.
Rester en mer pour de nouveaux combats.
Partir au large pour affronter des adversaires plus puissants.

À chaque combat, le jeu proposera plusieurs choix au joueur :

Bombarder : le navire attaquera son adversaire à coups de canon.
Aborder : le navire attaquera son adversaire en lançant un abordage.
Défendre : l'équipage du navire se préparera à subir un abordage et renforcera temporairement sa défense.
Manœuvrer : le navire tentera d'esquiver les boulets de canon de l'adversaire.
Fuir : le joueur met fin à l'assaut et fuit.

Les navires

Il existera différents types de navires : les navires de guerre, les navires de commerce, les navires pirates et les navires corsaires. Ceux-ci pourront être classés en deux catégories :

Navires légaux : cette catégorie comprendra les navires de guerre, les navires de commerce et les navires corsaires. Ils auront la capacité de bombarder les navires adverses afin de les couler.
Navires illégaux : cette catégorie comprendra les navires pirates et les navires corsaires. Ils auront la capacité de se lancer à l'abordage des navires adverses afin de les capturer.

Vous aurez remarqué que les corsaires feront partie des deux catégories ce qui devrait vous rappeler l'héritage multiple. Chaque type de navire aura bien sûr ses spécificités :

Navires de guerre : ils disposeront d'une force de frappe supérieure aux autres navires.
Navires de commerce : les plus faibles, ils auront la capacité de vendre des marchandises dans les ports, leur permettant de gagner davantage d'or.
Navires pirates : navires rapides, ils gagneront davantage d'or à l'issue d'un combat.
Navires corsaires : sans capacité particulière supplémentaire.

Les statistiques

Tout navire disposera des statistiques suivantes, ainsi que des bonus associés :

Coque : mesure l'état de la coque. Une fois à 0, le navire coule et est perdu.
Équipage : mesure le nombre d'hommes sur le navire. Une fois à 0, un navire ne peut plus être dirigé et est donc perdu.
Puissance : mesure la puissance de feu des canons des navires légaux.
Attaque : mesure la force d'attaque de l'équipage des navires illégaux.
Cuirasse : mesure la résistance du navire aux boulets de canon.
Défense : mesure la résistance de l'équipage aux abordages.
Vitesse : mesure la vitesse du navire, ce qui lui permet plus facilement d'esquiver.

À noter que les deux premières statistiques nécessiteront une valeur maximale et une valeur courante. Les navires de commerce disposeront d'un stock de marchandises échangeable contre de l'or au port.

Cahier des charges

Gameplay

Venons-en désormais aux détails techniques. Encore une fois, le jeu se déroulera en mode console (oui je sais, vous avez hâte de pouvoir faire des fenêtres avec des boutons et tout, mais encore un tout petit peu de patience :ange: ). Pour égayer tout cela, il serait bon que vous fassiez appel au package NT_Console en apportant un peu de couleur à notre vieille console ainsi que quelques bip. Le jeu devra pouvoir se jouer au clavier à l'aide des touches ←, ↑, →, ↓, Entrée ou Escape. Pensez à faire appel à la fonction get_key pour cela. Pour vous donner un ordre d'idée de ce que j'ai obtenu, voici quelques captures d'écran. À vrai dire, j'aurais voulus insérer quelques ASCII arts mais ça ne rendait pas très bien.

Comme vous pouvez le voir sur les captures, le joueur devra avoir accès aux statistiques de son navire à tout moment et, lors des combats, à celles de son adversaire. Il est évident que les choix proposés au joueur devront être clairs (plus de «tapez sur une touche pour voir ce qui va se passer») et que le jeu devra retourner un message à la suite de chaque action, afin par exemple de savoir si le tir de canon a échoué ou non, combien de points ont été perdus, pourquoi votre navire a perdu (coque déchiquetée ou équipage massacré ?)… Bref, cette fois, j'exige que votre programme soit présentable.

Je vais également vous imposer de proposer la sauvegarde-chargement de vos parties. Puisque vous pourrez améliorer vos navires pour vous confronter à des adversaires toujours plus puissants, il serait dommage de ne pas proposer la possibilité de sauvegarder votre jeu.

Les calculs

Pour le calcul des dégâts liés à vos coups de cannons ou de sabre, je vous laisse libre (mon programme n'est d'ailleurs pas toujours très équilibré en la matière). Voici toutefois les formules que j'ai utilisées pour ma part :

$D_{bombardement} = {{(P_{att} + P^{bonus}_{att})^2}\over {P_{att} + P^{bonus}_{att} + P_{def} + P^{bonus}_{def}}}$

$D_{abordage} = {{(A_{att} + A^{bonus}_{att})^2}\over {A_{att} + A^{bonus}_{att} + A_{def} + A^{bonus}_{def}}} \times {{E^{actuel}_{att}} \over {E^{max}_{att}}}$

Ici, $D$ correspond aux dégâts occasionnés, $P$ à la puissance, $A$ à l'attaque, $E$ à l'équipage, $att$ à l'attaquant et $def$ au défenseur. Pour savoir si un navire esquivera ou non vos tirs, j'ai tiré un nombre entre 0 et 100 et regardé s'il était ou non supérieur à :

${{(V_{att} + V^{bonus}_{att})}\over {V_{att} + V^{bonus}_{att} + V_{def} + V^{bonus}_{def}}} \times 120$

Où $V$ est bien entendu la vitesse du navire, 120 étant un coefficient permettant de compliquer encore davantage l'esquive des boulets. Ces formules valent ce qu'elles valent, elles ne sont pas paroles d'évangile : si vous disposez de formules plus pertinentes, n'hésitez pas à les utiliser.

POO

Enfin, pour ceux qui ne l'auraient pas encore compris, je vais vous imposer l'emploi de «tactiques orientées objet» :

utiliser des types TAGGED pour vos navires;
utiliser au moins une INTERFACE et un type ABSTRACT;
disposer de méthodes polymorphes (je n'ai pas dit que toutes devaient l'être);
utiliser des méthodes PRIVATE;
créer au moins un couple de packages père-fils.

Attention, je ne vous impose pas que tout votre code soit conçu façon objet : tout n'a pas besoin d'être encapsulé, toutes les méthodes n'ont pas besoin d'être polymorphes… J'exige simplement que ces cinq points (au moins) soient intégrés à votre projet. Rien ne vous empêche d'employer la généricité ou des types contrôlés si le cœur vous en dit, bien entendu.

Voici le diagramme de classe que j'ai utilisé (encore une fois, rien ne vous oblige à employer le même). Libre à vous de faire hériter les méthodes de bombardement et d'abordage de vos interfaces ou de votre classe mère.

Une solution possible

L'organisation

Comme à chaque TP, je compte bien vous fournir une solution. Mais cette solution est bien entendu perfectible. Elle est également complexe et nécessitera quelques explications. Tout d'abord, évoquons l'organisation de mes packages :

Game : la procédure principale. Elle ne contient que très peu de chose, l'essentiel se trouvant dans les packages.
P_Point : propose le type T_Point et les méthodes associées. Ce type permet pour chaque statistique (par exemple la vitesse), de disposer d'une valeur maximale, d'une valeur courante et d'une valeur bonus.
P_Navire : gère les classes, méthodes et interfaces liées aux différents types navires. Ce package aurait du être scindé en plusieurs sous-package pour respecter les règles d'encapsulation. Mais pour que le code gagne en lisibilité et surtout en compacité, j'ai préféré tout réunir en un seul package. Cela vous permettra d'analyser plus facilement le code, les méthodes…
P_Navire.list : le package fils. Celui-ci est fait pour proposer différents navires (frégates, galions, corvette…) au joueur et à l'ordinateur.
P_Variables : gère les variables globales du projet (coût d'une amélioration, temps d'affichage des messages… ) ainsi que les fonctionnalités aléatoires.
P_Data : gère l'enregistrement et la sauvegarde des navires dans des fichiers texte.
P_Screen : gère tous les affichages : affichage de texte accentué, affichage des messages de combat (tir manqué, abordage réussi, fuite…), affichage des différents menus (menu de combat, menu du marché, menus pour choisir entre une nouvelle partie et une ancienne, menu pour choisir le type de bateau sur lequel vous souhaitez naviguer…)
P_Modes : package le plus important, c'est lui qui gère tout ce que vous faites au clavier, que ce soit durant les phases de combat, lors de l'affichage du menu du marché… Bref, c'est le cœur du jeu puisqu'il gère les différents modes de jeu. Attention, les menus sont affichés grâce à P_Screen, mais seulement affichés, leur utilisation se fait grâce à P_Modes.

Le code

Game.adb

Venons-en au code à proprement parler. Voici à quoi se limite la procédure principale :

WITH Nt_Console ;           USE Nt_Console ;
WITH P_Navire ;             USE P_Navire ;
WITH P_Modes ;              USE P_Modes ;

PROCEDURE Game IS
BEGIN
   set_cursor(visible => false) ;
   DECLARE
      Joueur : T_Navire'Class := first_mode ;
   BEGIN
      market_mode(joueur) ;
   END ;
END Game ;

game.adb

On déclare un objet joueur de la classe T_Navire que l'on initialise en lançant First_mode(). Celui-ci proposera de choisir entre créer une nouvelle partie et en charger une ancienne. Dans chacun des cas, un Navire est renvoyé.

Ensuite, on lance le mode marché (Market_mode()) lequel se chargera de lancer les autres modes si besoin est.

P_Point

Ce package présente peu d'intérêt et de difficultés :

PACKAGE P_Point IS

   TYPE T_Point IS TAGGED RECORD
      Max, Current, Bonus : Integer ;
   END RECORD ;

   Function "-" (left : T_Point ; right : integer) return integer ;
   FUNCTION Total (P : T_Point) RETURN Integer ;
   FUNCTION Ecart(P : T_Point) RETURN Integer ;
   PROCEDURE Raz(P : OUT T_Point) ;
   PROCEDURE Init(P : IN OUT T_Point) ;
   PROCEDURE Init(P : IN OUT T_Point ; N : Natural) ;

end P_Point ;

P_Point.ads

PACKAGE BODY P_Point IS

   FUNCTION "-" (Left : T_Point ; Right : Integer) RETURN Integer IS
   BEGIN
      RETURN Integer'Max(0,Left.Current - Right) ;
   END "-" ;

   FUNCTION Total(P : T_Point) RETURN Integer IS
   BEGIN
      RETURN P.Current + P.Bonus ;
   END Total ;

   FUNCTION Ecart(P : T_Point) RETURN Integer IS
   BEGIN
      RETURN P.Max - P.Current ;
   END Ecart ;

   PROCEDURE Raz(P : OUT T_Point) IS
   BEGIN
      P.Bonus := 0 ;
   END Raz ;

   PROCEDURE Init(P : IN OUT T_Point) IS
   BEGIN
      P.Current := P.Max ;
      P.Bonus := 0 ;
   END Init ;

   PROCEDURE Init(P : IN OUT T_Point ; N : Natural) IS
   BEGIN
      P.Max     := N ;
      P.Current := P.Max ;
      P.Bonus := 0 ;
   END Init ;

end P_Point ;

P_Point.adb

P_Navire

L'un des principaux packages du jeu. Il définit mon type T_Navire comme ABSTRACT, mes interface T_Legal et T_Illegal. Trois méthodes abstraites sont proposées : Bombarde(), Aborde() et Init(). Des trois, seule Init() est réellement polymorphe. Les deux autres emploient chacune une méthode privée afin de limiter le code. J'aurais pu choisir de modifier le code de bombardement pour les navires de guerre, mais j'ai préféré modifier les statistiques pour accroître les points de Puissance initiaux afin de fournir un avantage initial aux navires de guerre qui peut toutefois être comblé pour les autres navires. Autrement dit, le bonus se fait grâce à Init() mais pas grâce à Bombarde(). Il en est de même pour Aborde(). Cela évite également que le code devienne gigantesque, ce qui ne vous faciliterait pas non plus son analyse.

WITH P_Point ;                  USE P_Point ;
WITH Ada.Strings.Unbounded ;    USE Ada.Strings.Unbounded ;


PACKAGE P_Navire IS

      -------------------------------
      --TYPES ET METHODES ABSTRAITS--
      -------------------------------

   TYPE T_Navire IS ABSTRACT TAGGED RECORD
      Nom         : Unbounded_string := Null_unbounded_string ;
      Coque       : T_Point ;
      Equipage    : T_Point ;
      Puissance   : T_Point ;
      Attaque     : T_Point ;
      Cuirasse    : T_Point ;
      Defense     : T_Point ;
      Vitesse     : T_Point ;
      Playable    : Boolean := False ;
      Gold        : Natural   := 0 ;
   END RECORD ;

   TYPE T_Stat_Name IS (Coque, Equipage, Puissance, Attaque, Cuirasse, Defense, Vitesse, Gold);
   TYPE T_Stat IS ARRAY(T_Stat_Name RANGE coque..Gold) OF Natural ;

   PROCEDURE Bombarde(Att : IN T_Navire ; Def : in out T_Navire'Class) IS ABSTRACT ;
   PROCEDURE Aborde  (Att : IN T_Navire ; Def : IN OUT T_Navire'Class) IS ABSTRACT ;
   FUNCTION Init     (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Navire IS ABSTRACT ;

   TYPE T_Legal IS INTERFACE ;
   TYPE T_Illegal IS INTERFACE ;

      -------------------
      --TYPES CONCRETS --
      -------------------

   TYPE T_Warship IS NEW T_Navire AND T_Legal WITH NULL RECORD ;
   TYPE T_Tradeship IS NEW T_Navire AND T_Legal WITH RECORD
      Stock : Integer ;
   END RECORD ;
   TYPE T_Corsair IS NEW T_Navire AND T_Legal AND T_Illegal WITH NULL RECORD ;
   TYPE T_Pirate IS NEW T_Navire AND T_Illegal WITH NULL RECORD ;

      ----------------------
      --METHODES CONCRETES--
      ----------------------

   OVERRIDING PROCEDURE Bombarde(Att : IN T_Warship   ; Def : in out T_Navire'Class) ;
   OVERRIDING PROCEDURE Bombarde(Att : IN T_Tradeship ; Def : in out T_Navire'Class) ;
   OVERRIDING PROCEDURE Bombarde(Att : IN T_Corsair   ; Def : in out T_Navire'Class) ;
   OVERRIDING PROCEDURE Bombarde(Att : IN T_Pirate    ; Def : IN OUT T_Navire'Class) IS NULL ;

   OVERRIDING PROCEDURE Aborde(Att : IN T_Warship   ; Def : in out T_Navire'Class) is null ;
   OVERRIDING PROCEDURE Aborde(Att : IN T_Tradeship ; Def : in out T_Navire'Class) is null ;
   OVERRIDING PROCEDURE Aborde(Att : IN T_Corsair   ; Def : in out T_Navire'Class) ;
   OVERRIDING PROCEDURE Aborde(Att : IN T_Pirate    ; Def : in out T_Navire'Class) ;

   OVERRIDING FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Warship ;
   OVERRIDING FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Tradeship ;
   OVERRIDING FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Corsair ;
   OVERRIDING FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Pirate ;


   PROCEDURE Defend(Bateau : IN OUT T_Navire'Class) ;
   PROCEDURE Manoeuvre(Bateau : IN OUT T_Navire'Class) ;
   FUNCTION Est_Mort(Bateau : T_Navire'Class) return boolean ;

   PROCEDURE Raz_Bonus(Bateau : OUT T_Navire'Class) ;
   PROCEDURE Reparer  (Navire : in out T_Navire'Class) ;
   PROCEDURE Recruter (Navire : in out T_Navire'Class) ;
   PROCEDURE Vendre   (Navire : IN OUT T_Tradeship) ;
   PROCEDURE Ameliorer_Coque    (Navire : IN OUT T_Navire'Class) ;
   PROCEDURE Ameliorer_Equipage (Navire : IN OUT T_Navire'Class) ;
   PROCEDURE Ameliorer_Puissance(Navire : IN OUT T_Navire'Class) ;
   PROCEDURE Ameliorer_Attaque  (Navire : IN OUT T_Navire'Class) ;
   PROCEDURE Ameliorer_Cuirasse (Navire : IN OUT T_Navire'Class) ;
   PROCEDURE Ameliorer_Defense  (Navire : IN OUT T_Navire'Class) ;
   PROCEDURE Ameliorer_Vitesse  (Navire : IN OUT T_Navire'Class) ;

   PROCEDURE Bat(Vainqueur : IN OUT T_Navire'Class ; Perdant : IN T_Navire'Class) ;
   PROCEDURE Perd(Navire : IN T_Navire'Class) ;

PRIVATE
   PROCEDURE Private_Bombarde(Att : IN T_Navire'Class ; Def : IN OUT T_Navire'Class) ;
   PROCEDURE Private_Aborde  (Att : IN T_Navire'Class ; Def : IN OUT T_Navire'Class) ;
   FUNCTION Esquive(Def : IN T_Navire'Class ; Att : IN T_Navire'Class) RETURN Boolean ;

END P_Navire ;

P_Navire.ads

WITH P_Variables ;             USE P_Variables ;
WITH Ada.Text_Io ;             USE Ada.Text_Io ;
WITH P_Screen ;                USE P_Screen ;
WITH Nt_Console ;              USE NT_Console ;


PACKAGE BODY P_Navire IS

      -------------------------------------------
      --CAPACITE D'ESQUIVE AU COURS D'UN ASSAUT--
      -------------------------------------------

   FUNCTION Esquive(Def : IN T_Navire'Class ; Att : IN T_Navire'Class) RETURN Boolean IS
   BEGIN
      RETURN Random > (Att.Vitesse.total*120 /(Att.Vitesse.total + Def.Vitesse.Total));
   END Esquive ;

      -------------------------
      --CAPACITE DE BOMBARDER--
      -------------------------

   PROCEDURE Private_Bombarde(Att : IN T_Navire'class ; Def : in out T_Navire'Class) IS --FORMULE GENERALE
      degats : integer := 0 ;
   BEGIN
      IF Def.Esquive(Att)
            THEN IF att.Playable
               THEN Put_Esquive_Message(Light_Red) ;
               else Put_Esquive_Message(Green) ;
            end if ;
      ELSE
         Degats := Integer(
            float(Att.Puissance.total**2) /
            float(Att.Puissance.Total + Def.Cuirasse.Total)) ;
         Def.Coque.Current := Def.Coque - Degats ;
         IF Att.Playable
               THEN Put_Bombard_Message(Degats,Green) ;
               ELSE Put_Bombard_Message(Degats,Light_Red) ;
         END IF ;
      END IF ;
   END Private_Bombarde ;

   OVERRIDING PROCEDURE Bombarde(Att : IN T_Warship   ; Def : in out T_Navire'Class) IS --POUR BATEAUX DE GUERRE
   BEGIN
      Private_Bombarde(Att,Def) ;
   END Bombarde ;
   OVERRIDING PROCEDURE Bombarde(Att : IN T_Tradeship ; Def : in out T_Navire'Class) IS --POUR BATEAUX COMMERCIAUX
   BEGIN
      Private_Bombarde(Att,Def) ;
   END Bombarde ;
   OVERRIDING PROCEDURE Bombarde(Att : IN T_Corsair   ; Def : in out T_Navire'Class) IS --POUR CORSAIRES
   BEGIN
      Private_Bombarde(Att,Def) ;
   END Bombarde ;


      -------------------------
      --CAPACITE D'ABORDER--
      -------------------------

   PROCEDURE Private_aborde(Att : IN T_Navire'class ; Def : in out T_Navire'Class) IS --FORMULE GENERALE
      degats : integer := 0 ;
   BEGIN
      IF Def.Esquive(Att)
            THEN IF att.Playable
                    THEN Put_Esquive_Message(Light_Red) ;
                    ELSE Put_Esquive_Message(Green) ;
                 END IF ;
            ELSE Degats := Integer(
                    Float(Att.Attaque.Total)**2 /
                    Float(Att.Attaque.Total + Def.Defense.Total) *
                    Float(Att.Equipage.Current)/Float(Att.Equipage.Max)) ;
                 Def.Equipage.Current := Def.Equipage - Degats ;
                 IF Att.Playable
                    THEN Put_Abordage_Message(Degats,Green) ;
                    ELSE Put_Abordage_Message(Degats,Light_Red) ;
                 END IF ;
      END IF ;
   END Private_aborde ;

   OVERRIDING PROCEDURE aborde(Att : IN T_Corsair   ; Def : in out T_Navire'Class) IS --POUR CORSAIRES
   BEGIN
      Private_aborde(Att,Def) ;
   END aborde ;
   OVERRIDING PROCEDURE aborde(Att : IN T_Pirate ; Def : in out T_Navire'Class) IS --POUR PIRATES
   BEGIN
      Private_aborde(Att,Def) ;
   END aborde ;

      ------------------
      --INITIALISATION--
      ------------------

   FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_warship IS
      Navire : T_Warship ;
   BEGIN
      Navire.Nom := Nom ;
      Navire.Coque.init(Stat(Coque)) ;
      Navire.Equipage.init (Stat(Equipage)) ;
      Navire.Puissance.init(Stat(Puissance)*120/100) ;
      Navire.Attaque.init  (Stat(Attaque)) ;
      Navire.Cuirasse.init (Stat(Cuirasse)) ;
      Navire.Defense.init  (Stat(Defense)) ;
      Navire.Vitesse.init  (Stat(Vitesse)*70/100) ;
      Navire.Playable  := False ;
      Navire.Gold      := Stat(Gold) ;
      RETURN Navire ;
   END Init ;

   FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Tradeship IS
      Navire : T_Tradeship ;
   BEGIN
      Navire.Nom := Nom ;
      Navire.Coque.init(Stat(Coque)) ;
      Navire.Equipage.init (Stat(Equipage)) ;
      Navire.Puissance.init(Stat(Puissance)*70/100) ;
      Navire.Attaque.init  (Stat(Attaque)) ;
      Navire.Cuirasse.init (Stat(Cuirasse)*110/100) ;
      Navire.Defense.init  (Stat(Defense)*110/100) ;
      Navire.Vitesse.init  (Stat(Vitesse)*90/100) ;
      Navire.Playable  := False ;
      Navire.Gold      := Stat(Gold) ;
      Navire.stock     := 15 ;
      RETURN Navire ;
   END Init ;

   FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Corsair IS
      Navire : T_Corsair ;
   BEGIN
      Navire.Nom := Nom ;
      Navire.Coque.init(Stat(Coque)) ;
      Navire.Equipage.init (Stat(Equipage)) ;
      Navire.Puissance.init(Stat(Puissance)) ;
      Navire.Attaque.init  (Stat(Attaque)) ;
      Navire.Cuirasse.init (Stat(Cuirasse)) ;
      Navire.Defense.init  (Stat(Defense)) ;
      Navire.Vitesse.init  (Stat(Vitesse)) ;
      Navire.Playable  := False ;
      Navire.Gold      := Stat(Gold) ;
      RETURN Navire ;
   END Init ;

   FUNCTION Init    (Nom : unbounded_string ; Stat : T_Stat) RETURN T_Pirate IS
      Navire : T_Pirate ;
   BEGIN
      Navire.Nom       := Nom ;
      Navire.Coque.init(Stat(Coque)) ;
      Navire.Equipage.init (Stat(Equipage)) ;
      Navire.Puissance.init(Stat(Puissance)) ;
      Navire.Attaque.init  (Stat(Attaque)*120/100) ;
      Navire.Cuirasse.init (Stat(Cuirasse)*70/100) ;
      Navire.Defense.init  (Stat(Defense)) ;
      Navire.Vitesse.init  (Stat(Vitesse)*130/100) ;
      Navire.Playable  := False ;
      Navire.Gold      := Stat(Gold) ;
      RETURN Navire ;
   END Init ;

      ------------------------
      --CAPACITÉ DE DEFENSE --
      ------------------------

   PROCEDURE Defend(Bateau : IN OUT T_Navire'Class) IS
   BEGIN
      Bateau.Defense.Bonus := Bateau.Defense.Current * 25 /100 ;
      IF Bateau.Playable
            THEN Put_Defense_Message(Green) ;
      ELSE Put_Defense_Message(Light_Red) ;
      END IF ;
   END Defend ;

      -------------------------
      --CAPACITÉ DE MANOEUVRE--
      -------------------------

   PROCEDURE Manoeuvre(Bateau : IN OUT T_Navire'Class) IS
   BEGIN
      Bateau.Vitesse.Bonus := Bateau.Vitesse.Current * 25 /100 ;
      IF Bateau.Playable
            THEN Put_Manoeuvre_Message(Green) ;
      ELSE Put_Manoeuvre_Message(Light_Red) ;
      END IF ;
   END Manoeuvre ;

      ------------------------------------------------
      --FONCTION POUR SAVOIR SI UN BATEAU EST COULE --
      ------------------------------------------------

   FUNCTION Est_Mort(Bateau : T_Navire'Class) RETURN Boolean IS
   BEGIN
      RETURN Bateau.Coque.current = 0 OR Bateau.Equipage.current = 0 ;
   END Est_Mort ;

      -----------------------------------
      --REMISE À ZÉRO POUR DBT DE TOUR --
      -----------------------------------

   PROCEDURE Raz_Bonus(Bateau : OUT T_Navire'Class) IS
   BEGIN
      Bateau.Coque.raz ;
      Bateau.Equipage.raz ;
      Bateau.Puissance.raz ;
      Bateau.Attaque.raz ;
      Bateau.Cuirasse.raz ;
      Bateau.Defense.raz ;
      Bateau.Vitesse.raz ;
   END Raz_Bonus ;

      ----------------------------
      --MÉTHODES POUR LE MARCHÉ --
      ----------------------------

   PROCEDURE Reparer  (Navire : IN OUT T_Navire'Class) IS
      Cout : constant Natural := (Navire.Coque.Max - Navire.Coque.Current) * Repair_Cost ;
   BEGIN
      IF Cout <= Navire.Gold
            THEN Navire.Coque.Init ;
                 Navire.Gold := Navire.Gold - Cout ;
            ELSE Navire.Coque.Current := Navire.Coque.Current + (Navire.Gold / Repair_Cost) ;
                 Navire.Gold := Navire.Gold mod Repair_Cost ;
      END IF ;
      Bleep ;
   END Reparer ;

   PROCEDURE Recruter  (Navire : IN OUT T_Navire'Class) IS
      Cout : constant Natural := (Navire.Equipage.max - Navire.Equipage.current) * Recrute_cost ;
   BEGIN
      IF Cout <= Navire.Gold
            THEN Navire.Equipage.Init ;
                 Navire.Gold := Navire.Gold - Cout ;
            ELSE Navire.Equipage.Current := Navire.Equipage.Current + (Navire.Gold / Recrute_Cost) ;
                 Navire.Gold := Navire.Gold mod Recrute_Cost ;
      END IF ;
      Bleep ;
   END Recruter ;

   PROCEDURE Vendre   (Navire : IN OUT T_Tradeship) IS
   BEGIN
      Navire.Gold := Navire.Gold + Navire.Stock * Goods_Cost ;
      Navire.Stock := 0 ;
      Bleep ;
   END Vendre ;

   PROCEDURE Ameliorer_Coque    (Navire : IN OUT T_Navire'Class) IS
   BEGIN
      IF Coque_Cost <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - Coque_Cost ;
                 Navire.Coque.Max := Navire.Coque.Max + 2 ;
                 Navire.Coque.Current := Navire.Coque.Current + 2 ;
                 Coque_Cost := Coque_cost * 2 ;
      END IF ;
      Bleep ;
   END Ameliorer_Coque ;

   PROCEDURE Ameliorer_Equipage (Navire : IN OUT T_Navire'Class) IS
   BEGIN
      IF Equipage_Cost <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - Equipage_Cost ;
                 Navire.Equipage.Max := Navire.Equipage.Max + 2 ;
                 Navire.Equipage.Current := Navire.Equipage.Current + 2 ;
                 Equipage_Cost := Equipage_cost * 2 ;
      END IF ;
      Bleep ;
   END Ameliorer_Equipage ;

   PROCEDURE Ameliorer_Puissance(Navire : IN OUT T_Navire'Class) IS
   BEGIN
      IF Puissance_Cost <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - Puissance_Cost ;
                 Navire.Puissance.Max := Navire.Puissance.Max + 1 ;
                 Navire.Puissance.Current := Navire.Puissance.Current + 1 ;
                 Puissance_Cost := Puissance_cost * 2 ;
      END IF ;
      Bleep ;
   END Ameliorer_Puissance ;

   PROCEDURE Ameliorer_Attaque  (Navire : IN OUT T_Navire'Class) IS
      cout : constant natural := Attaque_Cost * Navire.Equipage.max ;
   BEGIN
      IF cout <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - cout ;
                 Navire.Attaque.Max := Navire.Attaque.Max + 1 ;
                 Navire.Attaque.Current := Navire.Attaque.Current + 1 ;
                 Attaque_Cost := Attaque_cost + 1 ;
      END IF ;
      Bleep ;
   END Ameliorer_Attaque ;

   PROCEDURE Ameliorer_Cuirasse (Navire : IN OUT T_Navire'Class) IS
   BEGIN
      IF Cuirasse_Cost <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - Cuirasse_Cost ;
                 Navire.Cuirasse.Max := Navire.Cuirasse.Max + 1 ;
                 Navire.Cuirasse.Current := Navire.Cuirasse.Current + 1 ;
                 Cuirasse_Cost := Cuirasse_cost * 2 ;
      END IF ;
      Bleep ;
   END Ameliorer_Cuirasse ;

   PROCEDURE Ameliorer_Defense  (Navire : IN OUT T_Navire'Class) IS
      cout : constant natural := Defense_Cost * Navire.Equipage.max ;
   BEGIN
      IF cout <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - cout ;
                 Navire.Defense.Max := Navire.Defense.Max + 1 ;
                 Navire.Defense.Current := Navire.Defense.Current + 1 ;
                 Defense_Cost := Defense_cost + 1 ;
      END IF ;
      Bleep ;
   END Ameliorer_Defense ;

   PROCEDURE Ameliorer_Vitesse  (Navire : IN OUT T_Navire'Class) IS
   BEGIN
      IF Vitesse_Cost <= Navire.Gold
            THEN Navire.Gold := Navire.Gold - Vitesse_Cost ;
                 Navire.Vitesse.Max := Navire.Vitesse.Max + 1 ;
                 Navire.Vitesse.Current := Navire.Vitesse.Current + 1 ;
                 Vitesse_Cost := Vitesse_cost * 2 ;
      END IF ;
      Bleep ;
   END Ameliorer_Vitesse ;

      -------------------------
      --GAIN DE FIN DE COMBAT--
      -------------------------

   PROCEDURE Bat(Vainqueur : IN OUT T_Navire'Class ; Perdant : IN T_Navire'Class) IS
      Gain_or, Gain_Stock : Natural := 0 ;
   BEGIN
      goto_xy(2,10) ;
      set_foreground(green) ;
      Put("VOUS AVEZ VAINCU VOTRE ADVERSAIRE !") ;
      IF Vainqueur IN T_Pirate'Class
            THEN Gain_Or := Perdant.Gold / 4 ;
            ELSE Gain_Or := Perdant.Gold / 5 ;
      END IF ;
      Vainqueur.Gold := Vainqueur.Gold + Gain_Or ;
      goto_xy(0,11) ;
      set_foreground(green) ;
      Put("Vous remportez " & integer'image(Gain_or) & " or") ;
      IF Vainqueur IN T_Tradeship'Class
            THEN Gain_stock := (Niveau-1) * 3 + 1 ;
         T_Tradeship(Vainqueur).Stock := T_Tradeship(Vainqueur).Stock + Gain_Stock ;
         Put(" et " & integer'image(Gain_Stock) & " stocks") ;
      END IF ;
      put(" !") ;
      Set_Foreground(Black) ;
      delay Message_time * 2.0 ;
   END Bat ;

   PROCEDURE Perd(Navire : IN T_Navire'Class) IS
   BEGIN
      goto_xy(2,10) ;
      set_foreground(light_red) ;
      Put("VOUS AVEZ PERDU CONTRE VOTRE ADVERSAIRE !") ;
      goto_xy(0,11) ;
      IF Navire.Coque.Current = 0
            THEN Put("La coque de votre navire est d" & Character'Val(130) & "truite.") ;
      ELSIF Navire.Equipage.Current = 0
         then Put("Votre " & Character'Val(130) & "quipage est massacr" & Character'Val(130) & ".") ;
      END IF ;
      Set_Foreground(Black) ;
      delay Message_time * 2.0 ;
   END Perd ;

END P_Navire ;

P_Navire.adb

P_Navire.list

Peu d'intérêt, c'est ici que sont écrits les statistiques des différents navires (frégate, trois-mâts, galion et corvette). Vous pouvez en ajouter autant que bon vous semble. Le seul inconvénient, c'est qu'il faudra recompiler le code source (les données sont hard-coded).

package P_Navire.List is

   TYPE T_Navire_Id IS RECORD
      Nom  : Unbounded_String ;
      Stat : T_Stat ;
   END RECORD ;

   type T_Liste_Navire is array(positive range <>) of T_Navire_Id ;

      -------------
      -- NAVIRES --
      -------------

               --EXEMPLE STATS Coque  Equpg Puiss  Att   Cuir Defse Vits   Gold
   Stat_Fregate     : T_Stat := (15,   10,   14,    8,    8,    6,    8,   200) ;
   Stat_Gallion     : T_Stat := (20,   14,   10,   10,   12,    8,    4,   500) ;
   Stat_Corvette    : T_Stat := (12,    7,    8,    8,   10,    4,   16,   150) ;
   Stat_Trois_Mats  : T_Stat := (16,    8,   12,    7,   10,    8,   10,   300) ;

   Liste_Navire : T_Liste_Navire :=(
      (To_Unbounded_String("Frégate"),  Stat_Fregate),
      (To_Unbounded_String("Gallion"),  Stat_Gallion),
      (To_Unbounded_String("Corvette"), Stat_Corvette),
      (To_Unbounded_String("Trois-Mâts"), Stat_Trois_Mats)
         );

      ------------------------------
      -- GÉNÉRATION D'ADVERSAIRES --
      ------------------------------

   PROCEDURE Mettre_Niveau(Navire : IN OUT T_Navire'Class ; Niveau : Positive) ;
   FUNCTION Generer_Ennemi(Niveau : Natural := 1) RETURN T_Navire'Class ;

End P_Navire.List ;

p_navire-list.ads

WITH P_Variables ;             USE P_Variables ;
package body P_Navire.List is

   PROCEDURE Mettre_Niveau(Navire : IN OUT T_Navire'Class ; Niveau : Positive) IS
      coef : float ;
   BEGIN
      Coef := 1.5**(Niveau-1) ;
      Navire.Coque.Init(Integer(Float(Navire.Coque.Max) * Coef)) ;
      Navire.Equipage.Init(Integer(Float(Navire.Equipage.Max) * Coef)) ;
      Navire.Puissance.Init(Integer(Float(Navire.Puissance.Max) * Coef)) ;
      Navire.Attaque.Init(Integer(Float(Navire.Attaque.Max) * Coef)) ;
      Navire.Cuirasse.Init(Integer(Float(Navire.Cuirasse.Max) * Coef)) ;
      Navire.Defense.Init(Integer(Float(Navire.Defense.Max) * Coef)) ;
      Navire.Vitesse.Init(Integer(Float(Navire.Vitesse.Max) * Coef)) ;
      Coef := 2.0**(Niveau-1) ;
      Navire.Gold := integer(float(Navire.Gold) * coef) ;
   END Mettre_Niveau ;


   FUNCTION Generer_Ennemi(Niveau : Natural := 1) RETURN T_Navire'Class IS
      Navire : ACCESS T_Navire'Class ;
      N : Natural ;
   BEGIN
      N:= Random mod Liste_Navire'Length + 1 ;
      CASE Random mod 4 IS
         WHEN 0 =>       Navire := new T_Warship'(init(Liste_Navire(N).nom, Liste_Navire(N).stat)) ;
         WHEN 1 =>       Navire := new T_Tradeship'(init(Liste_Navire(N).nom, Liste_Navire(N).stat)) ;
         WHEN 2 =>       Navire := new T_Pirate'(init(Liste_Navire(N).nom, Liste_Navire(N).stat)) ;
         WHEN others =>  Navire := new T_Corsair'(init(Liste_Navire(N).nom, Liste_Navire(N).stat)) ;
      END CASE ;
      Mettre_Niveau(Navire.All,Niveau) ;
      RETURN Navire.all ;
   END Generer_Ennemi ;

End P_Navire.List ;

p_navire-list.adb

P_Variables

Là encore peu d'intérêt, hormis si vous souhaitez modifier le temps d'affichage des message, le coût de base d'une amélioration ou des réparations.

WITH Ada.Strings.Unbounded ;          USE Ada.Strings.Unbounded ;
WITH Ada.Numerics.Discrete_Random ;

PACKAGE P_Variables IS
   subtype T_Pourcentage is integer range 0..100 ;
   PACKAGE P_Random IS NEW Ada.Numerics.Discrete_Random(T_Pourcentage) ;
   Germe : P_Random.Generator ;

   PROCEDURE Reset ;
   FUNCTION Random RETURN T_Pourcentage ;

   Message_Time   : CONSTANT Duration := 2.0 ;
   Repair_Cost    : CONSTANT Natural  := 5 ;
   Recrute_Cost   : CONSTANT Natural  := 5 ;
   Goods_cost     : CONSTANT Natural  := 5 ;
   Coque_Cost     : Natural := 25 ;
   Equipage_Cost  : Natural := 25 ;
   Puissance_Cost : Natural := 25 ;
   Attaque_Cost   : Natural := 2 ;
   Cuirasse_Cost  : Natural := 25 ;
   Defense_Cost   : Natural := 2 ;
   Vitesse_Cost   : Natural := 25 ;
   Niveau         : Natural := 1 ;
   Save_File_Name : unbounded_string := Null_unbounded_string ;


PRIVATE

   PROCEDURE Reset(G : P_Random.Generator) RENAMES P_Random.Reset ;
   FUNCTION Random(G : P_Random.Generator) RETURN T_Pourcentage RENAMES P_Random.Random ;

end P_Variables ;

P_Variables.ads

PACKAGE body  P_Variables IS

   PROCEDURE Reset IS
   BEGIN
      Reset(Germe) ;
   END Reset ;

   FUNCTION Random RETURN T_Pourcentage IS
   BEGIN
      RETURN Random(Germe) ;
   END Random ;

end P_Variables ;

P_Variables.adb

P_Data

Comme dit précédemment, ce package sert à l'enregistrement et au chargement de parties enregistrées dans des fichiers texte. Bref, c'est du déjà-vu pour vous :

WITH P_Navire ;          USE P_Navire ;

PACKAGE P_Data IS
   FUNCTION Load_Navire(File_Name : String) RETURN T_Navire'Class ;
   PROCEDURE Save_Navire(Navire : in T_Navire'class) ;

end P_Data ;

P_Data.ads

WITH Ada.Text_IO ;              USE Ada.Text_IO ;
WITH Ada.Strings.Unbounded ;    USE Ada.Strings.Unbounded ;
WITH P_Variables ;              USE P_Variables ;
WITH P_Point ;                  USE P_Point ;


PACKAGE BODY P_Data IS

   FUNCTION Load_Navire(File_Name : String) RETURN T_Navire'Class IS
      FUNCTION Value(F : File_type) RETURN Integer IS
      BEGIN
         RETURN Integer'Value(Get_Line(F)) ;
      END Value ;
      Navire : ACCESS T_Navire'Class ;
      F : File_Type ;
   BEGIN
      Open(F, In_File,"./data/" & File_Name & ".txt") ;
      CASE Value(F) IS
         WHEN 1 => Navire := NEW T_Warship ;
         WHEN 2 => Navire := NEW T_Tradeship ;
         WHEN 3 => Navire := NEW T_Pirate ;
         WHEN others => Navire := NEW T_Corsair ;
      END CASE ;
      Navire.nom       := to_unbounded_string(get_line(F)) ;
      Navire.Coque     := (Value(F),Value(F),0) ;
      Navire.Equipage  := (Value(F),Value(F),0) ;
      Navire.Puissance := (Value(F),Value(F),0) ;
      Navire.Attaque   := (Value(F),Value(F),0) ;
      Navire.Cuirasse  := (Value(F),Value(F),0) ;
      Navire.Defense   := (Value(F),Value(F),0) ;
      Navire.Vitesse   := (Value(F),Value(F),0) ;
      Navire.Gold      := Value(F) ;
      IF Navire.All IN T_Tradeship'Class
            THEN T_Tradeship(Navire.All).Stock := Value(F) ;
      END IF ;
      Coque_Cost     := value(F) ;
      Equipage_Cost  := value(F) ;
      Puissance_Cost := value(F) ;
      Attaque_Cost   := value(F) ;
      Cuirasse_Cost  := value(F) ;
      Defense_Cost   := value(F) ;
      Vitesse_Cost   := value(F) ;
      Close(F) ;
      RETURN Navire.All ;
   END Load_Navire ;


   PROCEDURE Save_Navire(Navire : in T_Navire'class) IS
      F : File_Type ;
      PROCEDURE Save_Stat(F : File_Type ; P : T_Point) IS
      BEGIN
         Put_Line(F,Integer'Image(P.Max)) ;
         Put_Line(F,Integer'Image(P.Current)) ;
      END Save_Stat ;

   BEGIN
      Create(F,Out_File,"./data/" & to_string(Save_File_Name) & ".txt") ;
      IF Navire IN T_Warship'Class
            THEN Put_Line(F,"1") ;
      ELSIF Navire IN T_Tradeship'Class
            THEN Put_Line(F,"2") ;
      ELSIF Navire IN T_Pirate'Class
            THEN Put_Line(F,"3") ;
      ELSIF Navire IN T_Corsair'Class
            THEN Put_Line(F,"4") ;
      END IF ;
      Put_Line (F, To_String(Navire.Nom)) ;
      Save_Stat(F, Navire.Coque) ;
      Save_Stat(F, Navire.Equipage) ;
      Save_Stat(F, Navire.Puissance) ;
      Save_Stat(F, Navire.Attaque) ;
      Save_Stat(F, Navire.Cuirasse) ;
      Save_Stat(F, Navire.Defense) ;
      Save_Stat(F, Navire.Vitesse) ;
      Put_Line (F, Integer'Image(Navire.Gold)) ;
      IF Navire IN T_Tradeship'Class
            THEN Put_Line(F, Integer'Image(T_Tradeship(Navire).Stock)) ;
      END IF ;
      Put_Line (F, Integer'Image(Coque_Cost)) ;
      Put_Line (F, Integer'Image(Equipage_Cost)) ;
      Put_Line (F, Integer'Image(Puissance_Cost)) ;
      Put_Line (F, Integer'Image(Attaque_Cost)) ;
      Put_Line (F, Integer'Image(Cuirasse_Cost)) ;
      Put_Line (F, Integer'Image(Defense_Cost)) ;
      Put_Line (F, Integer'Image(Vitesse_Cost)) ;
      Close(F) ;
   END Save_Navire ;

END P_Data ;

P_Data.adb

P_Screen

Package important : c'est là que se font tous les affichages.

WITH Nt_Console ;           USE Nt_Console ;
WITH P_Navire ;             USE P_Navire ;
WITH P_Point ;              USE P_Point ;

PACKAGE P_Screen IS

   TYPE T_Position IS (Gauche, Droite) ;

   PROCEDURE Put(N : Integer ; Color : Color_Type := Black ; X,Y : Integer := -1) ;
   PROCEDURE Print(Text : String ; Color : Color_Type := Black ; X,Y : Integer := -1) ;
   PROCEDURE Put_Title ;
   PROCEDURE Put_First_Menu(Indice : Natural := 1) ;
   PROCEDURE Put_Fight_Menu(Navire : T_Navire'Class ; Indice : Natural := 1) ;
   PROCEDURE Put_NextFight_Menu(Indice : Natural := 1) ;
   PROCEDURE Put_Status(Navire : T_Navire'class ; Pos : T_Position := Gauche) ;
   PROCEDURE Put_Point(Point : T_Point) ;
   PROCEDURE Put_Esquive_Message(Color : Color_Type := Green) ;
   PROCEDURE Put_Bombard_Message(Degats : Integer ; Color : Color_Type := Green) ;
   PROCEDURE Put_Abordage_Message(Degats : Integer ; Color : Color_Type := Green) ;
   PROCEDURE Put_Defense_Message(Color : Color_Type := Green) ;
   PROCEDURE Put_Manoeuvre_Message(color : color_type := green) ;
   PROCEDURE Put_Fuite_Message ;

   PROCEDURE Put_Gold(Navire : T_Navire'class ; X : X_Pos := 40 ; Y : Y_Pos := 16) ;
   PROCEDURE Put_Market_Menu1(Navire : T_Navire'Class ; Indice : Natural := 1) ;
   PROCEDURE Put_Market_Menu2(Indice : Natural := 1) ;

   PROCEDURE Put_Select_Menu1(Indice : Natural := 1) ;
   PROCEDURE Put_Select_Menu2(Indice : Natural := 1) ;

end P_Screen ;

P_Screen.ads

WITH Ada.Text_IO ;             USE Ada.Text_IO ;
WITH P_Variables ;             USE P_Variables ;
with P_Navire.list ;           use P_Navire.list ;
WITH Ada.Strings.Unbounded ;   USE Ada.Strings.Unbounded ;
WITH Ada.Integer_Text_IO ;

PACKAGE BODY P_Screen IS

      -----------------------------------------------------------
      --AFFICHER UN ENTIER AVEC UNE COULEUR ET UN LIEU SPÉCIFIÉ--
      -----------------------------------------------------------

   PROCEDURE Put(N : Integer ; Color : Color_Type := black ; X,Y : Integer := -1) IS
   BEGIN
      IF X >= 0 AND Y >= 0
            THEN Goto_Xy(X,Y) ;
      END IF ;
      Set_Foreground(Color) ; Set_BackGround(White) ;
      Ada.Integer_Text_IO.put(n,0) ;
      Set_Foreground(Black) ;
   end put ;

      ----------------------------------------------------------
      --AFFICHER UN TEXTE AVEC UNE COULEUR ET UN LIEU SPÉCIFIÉ--
      ----------------------------------------------------------

   PROCEDURE Print(Text : String ; Color : Color_Type := Black ; X,Y : Integer := -1) IS
   BEGIN
      IF X >= 0 AND Y >= 0
            THEN Goto_Xy(X,Y) ;
      END IF ;
      Set_Foreground(Color) ; Set_BackGround(White) ;
      FOR I IN Text'RANGE LOOP
         CASE Text(I) IS
            WHEN 'é' => Put(Character'Val(130)) ;
            WHEN 'â' => Put(Character'Val(131)) ;
            WHEN 'è' => Put(Character'Val(138)) ;
            WHEN OTHERS => Put(Text(I)) ;
         END CASE ;
      END LOOP ;
      Set_Foreground(Black) ;
   END Print ;

      ----------------------
      --AFFICHAGE DU TITRE--
      ----------------------

   PROCEDURE Put_Title IS
   BEGIN
      goto_xy(0,0) ;
      set_background(white) ;
      Set_Foreground(light_red) ;
      Put_Line("                               BATAILLE NAVALE") ; new_line ;
      Set_Foreground(black) ;
   END Put_Title;

      -----------------------------
      --AFFICHAGE DU PREMIER MENU--
      -----------------------------

   PROCEDURE Put_First_Menu(Indice : Natural := 1) IS
      X : constant Natural := 9 ;
      Y : CONSTANT Natural := 4 ;
      color : color_type := blue ;
   BEGIN
      Print("Que souhaitez-vous faire ?",color,0,Y-1) ;
      FOR I IN 1..2 LOOP
         IF Indice=I
               THEN Color := Light_Red ;
               ELSE Color := Blue ;
         END IF ;
         CASE I IS
            WHEN 1 => Print("NOUVELLE PARTIE",Color,X,Y) ;
            WHEN 2 => Print("CHARGER UNE ANCIENNE PARTIE",Color,X+20,Y);
         END CASE ;
      END LOOP ;
      Goto_Xy(X+20*(Indice-1) + 10,Y+1) ;
      Set_Foreground(Light_Red) ;
      Put(Character'Val(30)) ;
      Set_Foreground(Black) ;
   END Put_First_Menu ;


      --------------------
      --MENU DE BATAILLE--
      --------------------

   PROCEDURE Put_Fight_Menu(Navire : T_Navire'Class ; Indice : Natural:=1) IS
      X : constant Natural := 9 ;
      Y : constant Natural := 13 ;
      blank_line : constant string(1..80) := (others => ' ') ;
   BEGIN
      Goto_Xy(0,Y) ;
      put(blank_line) ;
      Goto_Xy(X,Y) ;
      IF Indice = 1 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      IF Navire IN T_Illegal'Class THEN Put("ABORDER     ") ; END IF ;
      Goto_Xy(X+12,Y) ;
      IF Indice = 2 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      IF Navire IN T_Legal'Class THEN Put("BOMBARDER   ") ; END IF ;
      Goto_Xy(X+24,Y) ;
      IF Indice = 3 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Put("DEFENDRE    ") ;
      IF Indice = 4 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Put("MANOEUVRER  ") ;
      IF Indice = 5 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Put("FUIR") ;
      Goto_Xy(0,Y+1) ;
      put(blank_line) ;
      Goto_Xy(X+4+12*(Indice-1),Y+1) ;
      Set_Foreground(Light_Red) ;
      put(character'val(30)) ;
      Set_Foreground(Black) ;
   END Put_Fight_Menu ;

      -------------------------
      --MENU D'APRÈS BATAILLE--
      -------------------------

   PROCEDURE Put_NextFight_Menu(Indice : Natural := 1) IS
      X : constant Natural := 9 ;
      Y : CONSTANT Natural := 12 ;
      color : color_type := blue ;
      blank_line : constant string(1..80) := (others => ' ') ;
   BEGIN
      FOR I IN -2..+2 LOOP
         Goto_Xy(0,Y+I) ; Put(Blank_Line) ;
      END LOOP ;
      Print("Que souhaitez-vous faire désormais ?",color,0,Y) ;
      FOR I IN 1..3 LOOP
         IF Indice=I
               THEN Color := Light_Red ;
               ELSE Color := Blue ;
         END IF ;
         CASE I IS
            WHEN 1 => Print("DEBARQUER",Color,X,Y+1) ;
            WHEN 2 => Print("FAIRE VOILE",Color,X+20,Y+1);
            WHEN 3 => Print("PRENDRE LE LARGE",Color,X+40,Y+1) ;
         END CASE ;
      END LOOP ;
      Goto_Xy(X+20*(Indice-1) + 3,Y+2) ;
      Set_Foreground(Light_Red) ;
      Put(Character'Val(30)) ;
      set_foreground(black) ;
   END Put_Nextfight_Menu ;

      -----------------------------------
      --AFFICHAGE DU STATUS D'UN BATEAU--
      -----------------------------------

   PROCEDURE Put_Status(Navire : T_Navire'class ; Pos : T_Position := Gauche) is
      X : Natural ;
      y : constant natural := 15 ;
   BEGIN

      IF Pos = Gauche
            THEN X:= 0 ;
      ELSE X:= 39 ;
      END IF ;

      set_background(white) ;
      print("      " & to_string(Navire.nom), black, x, y) ;
      Set_Foreground(Light_Red) ; Goto_Xy(X,Y+1) ;
      Put("   " & Character'Val(2) & " ") ; put_point(Navire.coque) ;
      Set_Foreground(Green)     ; Goto_Xy(X,Y+2) ;
      Put("   " & Character'Val(3) & " ") ; Put_Point(Navire.Equipage) ;
      Goto_Xy(X,Y+3) ; Put("Psce:") ; Put_Point(Navire.Puissance) ;
      Goto_Xy(X,Y+4) ; Put("Attq:") ; Put_Point(Navire.Attaque) ;
      Goto_Xy(X,Y+5) ; Put("Cuir:") ; Put_Point(Navire.Cuirasse) ;
      Goto_Xy(X,Y+6) ; Put("Dfns:") ; Put_Point(Navire.Defense) ;
      Goto_Xy(X,Y+7) ; Put("Vits:") ; Put_Point(Navire.Vitesse) ;
   END Put_Status ;

      -------------------------
      --AFFICHAGE DU TYPE X/Y--
      -------------------------

   PROCEDURE Put_Point(Point : T_Point) IS
   BEGIN
      IF Point.Current <= Point.Max / 4
            THEN Put(Point.Current,Light_Red) ;
            ELSE Put(Point.Current) ;
      END IF ;
      Put('/') ; Put(Point.Max) ;
      IF Point.Bonus > 0
            THEN Put('+') ; Put(Point.Bonus) ;
      END IF ;
   END Put_Point ;

      ---------------------------------
      --AFFICHAGE DES MESSAGES DU JEU--
      ---------------------------------

   PROCEDURE Put_Esquive_Message(color : color_type := green) IS
   BEGIN
      goto_xy(0,11) ;
      IF Color = Green
            THEN set_foreground(green) ;
         Put("Vous avez esquiv"& character'val(130) &" l'attaque adverse !") ;
         Set_Foreground(Black) ;
      ELSE Set_Foreground(light_Red) ;
         Put("L'adversaire a esquiv"& character'val(130) &" votre attaque !") ;
         Set_Foreground(Black) ;
      END IF ;
      delay message_time ;
   END Put_Esquive_Message ;


   PROCEDURE Put_Bombard_Message(Degats : Integer ; Color : Color_Type := Green) IS
   BEGIN
      Goto_Xy(0,11) ;
      set_foreground(black) ;
      IF Color = Green
            THEN Put("Votre bombardement a caus"& Character'Val(130) & " ") ;
         Put(degats,green) ;
         put(" points de d"& Character'Val(130) &"g"& Character'Val(131) &"ts") ;
      ELSE Put("Le bombardement ennemi a caus"& Character'Val(130) & " ") ;
         Put(degats,light_red) ;
         put(" points de d"& Character'Val(130) &"g"& Character'Val(131) &"ts") ;
      END IF ;
      DELAY message_time ;
   END Put_Bombard_Message ;

   PROCEDURE Put_Abordage_Message(Degats : Integer ; Color : Color_Type := Green) IS
   BEGIN
      Goto_Xy(0,11) ;
      set_foreground(black) ;
      IF Color = Green
            THEN Put("Votre abordage a tu"& Character'Val(130) & " ") ;
         Put(degats,green) ;
         put(" marins ennemis") ;
      ELSE Put("L'abordage ennemi a tu"& Character'Val(130) & " ") ;
         Put(degats,light_red) ;
         put(" de vos marins") ;
      END IF ;
      DELAY message_time ;
   END Put_Abordage_Message ;

   PROCEDURE Put_Defense_Message(color : color_type := green) IS
   BEGIN
      goto_xy(0,11) ;
      IF Color = Green
            THEN set_foreground(green) ;
         Put("Vos hommes se pr"& character'val(130) &"parent "& character'val(133) &" l'abordage !") ;
         Set_Foreground(Black) ;
      ELSE Set_Foreground(light_Red) ;
         Put("L'ennemi se pr"& character'val(130) &"pare "& character'val(133) &" l'abordage !") ;
         Set_Foreground(Black) ;
      END IF ;
      delay Message_time ;
   END Put_Defense_Message ;

   PROCEDURE Put_Manoeuvre_Message(color : color_type := green) IS
   BEGIN
      goto_xy(0,11) ;
      IF Color = Green
            THEN set_foreground(green) ;
         Put("Votre navire se place sous le vent !") ;
         Set_Foreground(Black) ;
      ELSE Set_Foreground(light_Red) ;
         Put("Le navire ennemi se place sous le vent !") ;
         Set_Foreground(Black) ;
      END IF ;
      delay Message_time ;
   END Put_Manoeuvre_Message ;

   PROCEDURE Put_Fuite_Message IS
   BEGIN
      goto_xy(0,11) ;
      Set_Foreground(light_Red) ;
      Put("Vous fuyez devant l'adversit" & character'val(130) & " !") ;
      Set_Foreground(Black) ;
      delay Message_time ;
   END Put_Fuite_Message ;

      --------------------------------
      --AFFICHAGE DES MENUS DU MARCHÉ--
      --------------------------------

   PROCEDURE Put_Gold(Navire : T_Navire'class ; X : X_Pos := 40 ; Y : Y_Pos := 16) IS
      blank_line : constant string(1..80 - X) := (others => ' ') ;
   BEGIN
      Goto_Xy(X,Y) ;
      Put(Blank_Line) ;
      Goto_Xy(X,Y) ;
      set_foreground(black) ;
      Put("Or : ") ;
      IF Navire.Gold = 0
            THEN Set_Foreground(Light_Red) ;
      END IF ;
      Put(Integer'Image(Navire.Gold)) ;
      Set_Foreground(Black) ;
   END Put_Gold ;

   PROCEDURE Put_Market_Menu1(Navire : T_Navire'Class ; Indice : Natural := 1) IS
      X : constant Natural := 9 ;
      Y : constant Natural := 13 ;
      blank_line : constant string(1..80) := (others => ' ') ;
   BEGIN
      Goto_Xy(0,Y-1) ;
      Put(Blank_Line) ;
      Goto_Xy(0,Y) ;
      put(blank_line) ;

      IF Indice = 1 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Goto_Xy(X,Y-1) ; Put("PRENDRE") ;
      Goto_xy(X,Y)   ; Put("LA MER") ;

      IF Indice = 2 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Goto_Xy(X+12,Y-1) ; Put("REPARER") ;
      Goto_xy(x+12,Y) ;   Put("(" & integer'image((Navire.coque.max - Navire.coque.current) * Repair_cost) &")") ;

      IF Indice = 3 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Goto_Xy(X+24,Y-1) ; Put("RECRUTER") ;
      Goto_xy(x+24,Y) ;   Put("(" & integer'image((Navire.Equipage.max - Navire.Equipage.current) * Recrute_cost) &")") ;

      IF Indice = 4 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      Goto_Xy(X+36,Y-1) ; Put("ACHETER     ") ;

      IF Indice = 5 THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
      IF Navire IN T_Tradeship'Class
            THEN Goto_Xy(X+48,Y-1) ; Put("  VENDRE") ;
                 Goto_xy(X+50,Y) ;   Put("(" & integer'image(T_Tradeship(Navire).stock * Goods_cost) &")") ;

      END IF ;

      Goto_Xy(0,Y+1) ;
      put(blank_line) ;
      Goto_Xy(X+4+12*(Indice-1),Y+1) ;
      Set_Foreground(Light_Red) ;
      put(character'val(30)) ;
      Set_Foreground(Black) ;
   END Put_Market_Menu1 ;


   PROCEDURE Put_Market_Menu2(Indice : Natural := 1) IS
      X : constant Natural := 35 ;
      Y : constant Natural := 12 ;
      blank_line : constant string(1..80) := (others => ' ') ;
   BEGIN

      FOR I IN 1..7 LOOP
         IF Indice = I THEN Set_Foreground(Light_Red) ; ELSE Set_Foreground(Blue) ; END IF ;
         Goto_Xy(0,Y-I) ;
         Put(Blank_Line) ;
         Goto_Xy(X,Y-I) ;
         CASE I IS
            WHEN 1 => Put("Gouvernail (" & integer'image(Vitesse_cost) &   ")       + 1 Vitesse") ;
            WHEN 2 => Put("Boucliers  (" & integer'image(Defense_cost) &   "/marin) + 1 Defense") ;
            WHEN 3 => Put("Blindage   (" & integer'image(Cuirasse_cost) &  ")       + 1 Cuirasse") ;
            WHEN 4 => Put("Sabres     (" & integer'image(Attaque_cost) &   "/marin) + 1 Attaque") ;
            WHEN 5 => Put("Cannons    (" & integer'image(Puissance_cost) & ")       + 1 Puissance") ;
            WHEN 6 => Put("Couchettes (" & integer'image(Equipage_cost) &  ")       + 2 Equipage");
            WHEN 7 => Put("Planches   (" & integer'image(Coque_cost) &     ")       + 2 Coque") ;
         END CASE ;
      END LOOP ;

      Goto_Xy(X-2,Y-Indice) ;
      Set_Foreground(Light_Red) ;
      put(character'val(26)) ;
      Set_Foreground(Black) ;

   END Put_Market_Menu2 ;



   PROCEDURE Put_Select_Menu1(Indice : Natural := 1) IS
   BEGIN
      FOR I IN 1..4 LOOP
         IF Indice = I
               THEN set_foreground(Light_Red) ;
                    Goto_Xy(0,I+3) ;
                    put(character'val(26)) ;
               ELSE set_foreground(Blue) ;
         END IF ;
         goto_xy(2,I+3) ;
         CASE I IS
            WHEN 1 => put("Navire de guerre") ;
            WHEN 2 => put("Navire marchand") ;
            WHEN 3 => put("Pirate") ;
            WHEN 4 => Put("Corsaire") ;
         END CASE ;
      END LOOP ;
      set_foreground(black) ;
   END Put_Select_Menu1 ;

   PROCEDURE Put_Select_Menu2(Indice : Natural := 1) IS
      color : color_type ;
   BEGIN
       FOR I IN Liste_Navire'range LOOP
         IF Indice = I
               THEN color := Light_Red ;
                    print("" & character'val(26),color,20,I+3) ;
               ELSE Color := Blue ;
                    print(" ",color,20,I+3) ;
         END IF ;
         print(to_string(Liste_navire(i).nom),color,22,i+3) ;
      END LOOP ;
      set_foreground(black) ;
   END Put_Select_Menu2 ;

end P_Screen ;

P_Screen.adb

P_Modes

Et enfin, le cœur du jeu : P_Mode. C'est dans ce dernier package que sont gérés les touches du clavier et la réaction à adopter.

WITH P_Navire ;             USE P_Navire ;

PACKAGE P_Modes IS

   FUNCTION  First_Mode RETURN T_Navire'Class ;
   PROCEDURE Fight_Mode (Joueur : IN OUT T_Navire'Class) ;
   FUNCTION  NextFight_Mode RETURN natural ;
   PROCEDURE Market_Mode(Joueur : IN OUT T_Navire'Class) ;
   PROCEDURE Buy_Mode(Joueur : IN OUT T_Navire'Class) ;
   FUNCTION  Select_Mode RETURN T_Navire'class ;

END P_Modes ;

P_Modes.ads

Le nombre de procédures et fonctions est restreint : First_Mode() gère le tout premier menu pour choisir entre une nouvelle ou une ancienne partie ; en cas de nouvelle partie, il lancera Select_Mode() qui permet au joueur de choisir son navire et sa classe (marchand, pirate…) ; puis il accède au menu du marché, Market_Mode() qui est le principal menu (c'est de là que se font les sauvegardes en appuyant sur Echap, les achats avec Buy_Mode(), les ventes, les réparations ou le départ en mer avec Fight_Mode()) ; enfin, NextFight_Mode() gère un menu proposant au joueur de rentrer au port ou de continuer son aventure à la fin de chaque combat.

WITH Ada.Text_IO ;             USE Ada.Text_IO ;
WITH Ada.Strings.Unbounded ;   USE Ada.Strings.Unbounded ;
WITH Nt_Console ;              USE Nt_Console ;
WITH P_Screen ;                USE P_Screen ;
WITH P_Variables ;             USE P_Variables ;
WITH P_Navire.List ;           USE P_Navire.List ;
WITH P_Data ;                  USE P_Data ;


PACKAGE BODY P_Modes IS

   FUNCTION  First_Mode RETURN T_Navire'Class IS
      Position : Natural := 1 ;
      touche : character ;
   BEGIN
      Main_Loop : LOOP
         Clear_Screen(White) ;
         Put_Title ;
         Put_First_Menu(Position) ;
         Touche := Get_Key ;

         IF Character'Pos(Touche) = 75 AND Position = 2      --TOUCHE GAUCHE
               THEN Position := 1 ;
         ELSIF Character'Pos(Touche) = 77 AND Position = 1   --TOUCHE DROITE
               THEN Position := 2 ;
         END IF ;

         IF Character'Pos(Touche) = 13
               THEN Print("Entrez le nom du fichier :",Blue,0,6) ;
                    Save_File_Name := To_Unbounded_String(Get_Line) ;
                    IF Position = 1
                       THEN RETURN Select_Mode ;
                    ELSIF Position = 2
                       THEN RETURN Load_Navire(To_string(save_file_name)) ;
                    END IF ;
         END IF ;


      END LOOP Main_loop ;
   END First_Mode ;


   PROCEDURE Fight_Mode(Joueur : IN OUT T_Navire'Class) IS
      Touche : Character ;
      Position : Natural := 4 ;
      N : T_Pourcentage ;
      Ordi : T_Navire'Class := generer_ennemi(Niveau) ;
   BEGIN
      Main_loop : LOOP
         Raz_bonus(Joueur) ;
         Clear_Screen(White) ;
         Put_Title ;
         Put_Status(Joueur,Gauche) ;
         Put_Status(Ordi,Droite) ;
         IF Joueur.Est_Mort
               THEN Joueur.Perd ;
            EXIT ;
         END IF ;

               ------------------------
               -- TOUR JOUEUR HUMAIN --
               ------------------------

         LOOP
            Put_Fight_Menu(Joueur,Position) ;
            Touche := Get_Key ;
               --touche gauche
            IF Character'Pos(Touche) = 75
                  THEN IF Position = 1
                     OR (Position = 2 AND Joueur NOT IN T_Illegal'Class)
                          THEN NULL ;
                       ELSIF Position = 3 AND Joueur NOT IN T_Legal'Class
                          THEN Position := Position - 2 ;
                          ELSE Position := Position - 1 ;
                       END IF ;
            END IF ;
               --touche droite
            IF Character'Pos(Touche) = 77 and position < 5
                  THEN IF Position = 1 AND Joueur NOT IN T_Legal'Class
                          THEN Position := Position + 2 ;
                          ELSE Position := Position + 1 ;
                       END IF ;
            END IF ;
               --touche entrée
            IF Character'Pos(Touche) = 13
                  THEN CASE Position IS
                          WHEN 1 => Joueur.Aborde(Ordi) ;
                          WHEN 2 => joueur.bombarde(ordi) ;
                          WHEN 3 => joueur.defend ;
                          WHEN 4 => joueur.manoeuvre ;
                          WHEN OTHERS => put_fuite_message ; exit Main_loop ;
                       END CASE ;
                       EXIT ;
            END IF ;
         END LOOP ;

               ---------------------
               -- TOUR ORDINATEUR --
               ---------------------

         Raz_bonus(Ordi) ;
         Clear_Screen(White) ;
         Put_Title ;
         Put_Status(Joueur,Gauche) ;
         Put_Status(Ordi,Droite) ;
         IF Ordi.Est_Mort
               THEN Joueur.Bat(Ordi) ;
            EXIT ;
         END IF ;

         N := Random ;
         IF N >= 90
               THEN Ordi.Manoeuvre ;
         ELSIF N>=80
               THEN Ordi.Defend ;
         ELSIF Ordi IN T_Legal'Class AND Ordi IN T_Illegal'Class
               THEN IF N mod 2 = 0
                  THEN Ordi.Bombarde(Joueur) ;
            ELSE Ordi.Aborde(Joueur) ;
            END IF ;
         ELSIF Ordi IN T_Legal'Class
               THEN Ordi.Bombarde(Joueur) ;
               else ordi.aborde(joueur) ;
         END IF ;

      END LOOP Main_loop ;
   END Fight_Mode ;


   FUNCTION NextFight_Mode RETURN natural IS
      Position : Natural := 1 ;
      touche : character ;
   BEGIN
      LOOP
         Put_NextFight_Menu(position) ;
         Touche := Get_Key ;
            --TOUCHE GAUCHE
         IF Character'Pos(Touche) = 75 AND Position > 1
               THEN Position := Position - 1 ;
         END IF ;
            --TOUCHE DROITE
         IF Character'Pos(Touche) = 77 AND Position < 3
               THEN Position := Position + 1 ;
         END IF ;
         IF Character'Pos(Touche) = 13 OR Character'Pos(Touche) = 72
               THEN CASE Position IS
                       WHEN 1 => Niveau := 1 ;
                       WHEN 3 => Niveau := Niveau + 1 ;
                       WHEN OTHERS => null ;
                    END CASE ;
                    RETURN Position ;
         END IF ;
      END LOOP ;
   END NextFight_Mode ;




   PROCEDURE Market_Mode(Joueur : IN OUT T_Navire'Class)  IS
      Position : Natural := 1 ;
      Touche   : character ;
   BEGIN
      Main_Loop : LOOP
         Raz_bonus(Joueur) ;
         Clear_Screen(White) ;
         Put_Title ;
         Put_Status(Joueur,Gauche) ;
         Put_Gold(joueur) ;

         LOOP
            Put_Market_Menu1(Joueur,Position) ;
            Touche := Get_Key ;
               --touche gauche
            IF Character'Pos(Touche) = 75 and position > 1
                  THEN Position := Position - 1 ;
            END IF ;
               --touche droite
            IF Character'Pos(Touche) = 77 and ((Joueur in T_Tradeship'class and position = 4) or position < 4)
                  THEN Position := Position + 1 ;
            END IF ;
               --touche echap
            IF Character'Pos(Touche) = 27
                  THEN Save_Navire(Joueur) ;
                       Print("Fichier sauvegardé sous " & To_String(Save_File_Name) & ".txt",Red,0,24) ;
                       bleep ;
                       EXIT Main_Loop ;
            END IF;
               --touche entrée
            IF Character'Pos(Touche) = 13 or Character'Pos(Touche) = 72
                  THEN CASE Position IS
                         WHEN 1 => Fight_loop : loop
                                       Fight_Mode(Joueur) ;
                                       IF Joueur.Est_Mort
                                          THEN touche := get_key ;
                                               EXIT Main_Loop ;
                                          ELSE EXIT Fight_loop WHEN NextFight_Mode = 1 ;
                                       END IF ;
                                    END LOOP Fight_Loop ;
                          WHEN 2 => Joueur.reparer ;
                          WHEN 3 => Joueur.recruter ;
                          WHEN 4 => Buy_Mode(joueur) ;
                          WHEN OTHERS => T_Tradeship(Joueur).vendre ;
                       END CASE ;
                       EXIT ;
            END IF ;
         END LOOP ;
      END LOOP Main_loop ;
   END Market_Mode ;


   PROCEDURE Buy_Mode(Joueur : IN OUT T_Navire'Class)  IS
      Position : Natural := 1 ;
      Touche   : character ;
   BEGIN
      while position > 0 LOOP

         Put_Market_Menu2(Position) ;
         Touche := Get_Key ;
            --touche haut
         IF Character'Pos(Touche) = 72 and position < 7
               THEN Position := Position + 1 ;
         END IF ;
            --touche bas
         IF Character'Pos(Touche) = 80 and position > 0
               THEN Position := Position - 1 ;
         END IF ;
         --touche gauche ou droite
         IF Character'Pos(Touche) = 75 or Character'Pos(Touche) = 77
               THEN Position := 0 ;
         END IF ;
         --touche entrée
         IF Character'Pos(Touche) = 13
               THEN CASE Position IS
                       WHEN 1 => Joueur.Ameliorer_vitesse ;
                       WHEN 2 => Joueur.Ameliorer_defense ;
                       WHEN 3 => Joueur.Ameliorer_cuirasse ;
                       WHEN 4 => Joueur.Ameliorer_attaque ;
                       WHEN 5 => Joueur.Ameliorer_puissance ;
                       WHEN 6 => Joueur.Ameliorer_equipage ;
                       when 7 => Joueur.Ameliorer_coque ;
                       WHEN OTHERS => null ;
                    END CASE ;
                    Put_Gold(joueur) ;
                    Put_Status(Joueur,Gauche) ;
         END IF ;
      END LOOP ;
   END Buy_Mode ;

   FUNCTION  Select_Mode RETURN T_Navire'Class IS
      Navire    : ACCESS T_Navire'Class ;
      Pos1,Pos2 : Natural := 1 ;
      touche    : character ;
   BEGIN
      Main_Loop : LOOP
         Menu1 : LOOP
            Clear_Screen(White) ;
            Put_Title ;
            Put_Select_Menu1(Pos1) ;
            Touche := Get_Key ;
               --touche haut
            IF Character'Pos(Touche) = 72 and pos1 > 1
                  THEN pos1 := pos1 - 1 ;
            END IF ;
               --touche bas
            IF Character'Pos(Touche) = 80 and pos1 < 4
                  THEN pos1 := pos1 + 1 ;
            END IF ;
            --touche entrée ou droite
            IF Character'Pos(Touche) = 13 or Character'Pos(Touche) = 77
                  THEN bleep ; EXIT Menu1 ;
            END IF;
         END LOOP Menu1 ;

         Menu2 : LOOP
            Put_Select_Menu2(Pos2) ;
            Touche := Get_Key ;
               --touche haut
            IF Character'Pos(Touche) = 72 and pos2 > 1
                  THEN pos2 := pos2 - 1 ;
            END IF ;
               --touche bas
            IF Character'Pos(Touche) = 80 and pos2 < Liste_Navire'length
                  THEN pos2 := pos2 + 1 ;
            END IF ;
            --touche entrée ou droite
            IF Character'Pos(Touche) = 13 or Character'Pos(Touche) = 77
                  THEN bleep ; EXIT Main_Loop ;
            END IF;
            IF Character'Pos(Touche) = 75
                  THEN EXIT Menu2 ;
            END IF;
         END LOOP Menu2 ;
      END LOOP Main_loop ;

      CASE Pos1 IS
         WHEN 1 => Navire := NEW T_Warship'(Init(Liste_Navire(Pos2).nom, Liste_Navire(Pos2).stat)) ;
         WHEN 2 => Navire := NEW T_Tradeship'(Init(Liste_Navire(Pos2).nom, Liste_Navire(Pos2).stat)) ;
         WHEN 3 => Navire := NEW T_Pirate'(Init(Liste_Navire(Pos2).nom, Liste_Navire(Pos2).stat)) ;
         WHEN others => Navire := NEW T_Corsair'(Init(Liste_Navire(Pos2).nom, Liste_Navire(Pos2).stat)) ;
      END CASE ;
      Navire.Playable := True ;
      Navire.Gold := 100 ;
      return Navire.all ;
   END Select_Mode ;

END P_Modes ;

P_Modes.adb

Pistes d'amélioration :

Ajouter un écran affichant les meilleurs scores obtenus, les navires les plus puissants, les plus riches, les plus peuplés…
Ajouter une nationalité à votre navire (français, anglais, portugais, hollandais, espagnol, pirate…) ajoutant de nouveaux bonus/malus ou proposant des navires spécifiques.
Vous pouvez également approfondir le système de jeu en proposant de personnaliser les armes (grappins, filets, sabres, lances, petits ou gros cannons…) ou les manœuvres, ou encore de changer pour un navire plus performant.
Pourquoi ne pas proposer un jeu en deux temps : des phases de bataille navale (ce que vous venez de créer) et des phases d'exploration où le joueur devrait déplacer son navire sur une carte.