Rem BATNAV 2.1 version souris Rem Bataille navale Rem par Factor23 Rem Autres versions sur TI99/4A ( TI basic ) et Atari ST ( Gfabasic ) Dim a%(11, 11), b!(11, 11), r%(10), b%(16), lo%(10), m%(4), pos%(10, 2), hv!(10) Dim B$, C$, Z$, II%, NB%, I%, LG%, N%, H%, IX%, IC%, J%, K%, L%, C%, X%, I1%, J1%, I!, F!, Z% Dim mx%, my%, mk%, X%, y%, m$, l$, it% OpenW # 1, 10, 10, 600, 800, 16 TitleW # 1, "Bataille navale" ArrayFill b!(), 0 ArrayFill a%(), 0 DefFill Chr$(0, 0, 0, 0, 0, 0, 0, 0) II% = 0 NB% = 1 Local fnt As Handle Rem Font "roman" Font Italic 0, Weight 1000 , Width 5, Height 15 Font To fnt SetFont fnt Input "voulez-vous les instructions du jeux : ", l$ Cls If Upper(Left(l$ + "N", 1)) = "O" TitleW # 3, "Instructions pour la bataille navale" Print "Bataille Navale " Print Print "Vous devez essayer de détruire la flotte de l’ordinateur composée de 10 vaisseaux." Print Print "Les vaisseaux sont à l’intérieure d’une grille 10 sur 10, et peuvent être en position horizontale" Print "ou verticale :" Print "1 très grand vaisseau de 4 cases " Print "2 grands vaisseaux de 3 cases" Print "3 moyens vaisseaux de 2 cases" Print "4 petits vaisseaux de 1 case" Print Print "Un décompte des navires présent figure à droite de la grille" Print Print "2 vaisseaux ne peuvent se toucher" Print Print "Cliquer un une cache pour essayer d’atteindre un vaisseau." Print "Le résultat du coup apparait en haut à gauche." Print "Raté si le coup est à plus d’une case d’un navire affichage de la case en rouge." Print "En vue si le coup est sur une case qui touche le navire affichage de la case en vert." Print "Touché si le coup est réussi affichage de la case en gris." Print "Si un navire est complètement touché les cases se noircissent et le décompte des navires" Print "est mis à jour." Print Print "Lorsque tous les navires sont détruits un message vous précise votre victoire en vous" Print "donnant le nombre de coups joués, vous pouvez alors faire entrée pour quitter le jeu." Print Print "Vous pouvez quitter en jeu à tout moment en cliquent sur le bouton droit." Print Print "Appuyez sur une touche pour quitter cet écran" KeyGet Z% Cls EndIf Font Italic 0, Weight 1000 , Width 14, Height 30 Font Orientation 0, StrikeOut 0, Underline 0, Escapement 0 Font Family 0, CharSet 0 , Pitch 2 Font To fnt SetFont fnt Cls Rem Tracé de la grille ClearW # 1 For I% = 50 To 350 Step 30 Line I%, 150, I%, 450 Line 50, I% + 100, 350, I% + 100 Next Text 50, 115, "A B C D E F G H I J" For I% = 1 To 10 Text 20, 120 + 30 * I%, Chr$(64 + I%) Next I% Rem Tracé du compte des bateaux For I% = 1 To 4 For J% = 1 To I% Box 400 + J% * 30, 150 + I% * 60, 430 + J% * 30, 180 + I% * 60 Color RGB(0, 255, 0) Fill 415 + J% * 30, 165 + I% * 60 Color RGB(0, 0, 0) Next J% Text 560, 150 + I% * 60, Chr$(53 - I%) Next I% Rem Calcul de l'emplacement des bateaux Color RGB(0, 0, 255) For I% = 1 To 4 m%(I%) = NB% LG% = 5 - I% For N% = 1 To NB% H% = Random(2) IX% = 0 ressai: IC% = Random(10) + 1 If H% GoTo vertical EndIf For J% = 1 To 11 - LG% For K% = J% To J% + LG% - 1 I! = b!(K%, IC%) Exit If I! <> 0 Next K% If I! = 0 Inc IX% r%(IX%) = J% EndIf Next J% If IX% = 0 GoTo ressai EndIf Inc II% J% = r%(Random(IX%) + 1) b%(II%) = LG% For K% = J% To J% + LG% - 1 a%(K%, IC%) = II% Rem Fill 35 + K% * 30, 135 + IC% * 30 Next K% For K% = J% - 1 To J% + LG% For L% = IC% - 1 To IC% + 1 b!(K%, L%) = 1 Next L% Next K% pos%(II%, 1) = J% pos%(II%, 2) = IC% hv!(II%) = 0 GoTo et2 vertical: For J% = 1 To 11 - LG% For K% = J% To J% + LG% - 1 I! = b!(IC%, K%) Exit If I! <> 0 Next K% If I! = 0 Inc IX% r%(IX%) = J% EndIf Next J% If IX% = 0 GoTo ressai EndIf Inc II% J% = r%(Random(IX%) + 1) b%(II%) = LG% For K% = J% To J% + LG% - 1 a%(IC%, K%) = II% Rem Fill 35 + IC% * 30, 135 + K% * 30 Next K% For K% = J% - 1 To J% + LG% For L% = IC% - 1 To IC% + 1 b!(L%, K%) = 1 Next L% Next K% pos%(II%, 1) = IC% pos%(II%, 2) = J% hv!(II%) = 1 et2: lo%(II%) = I% Next N% Add NB%, 1 Next I% Rem Entrée à la souris ArrayFill b!(), 0 entree: Do Sleep mx% = MouseX, my% = MouseY, mk% = MouseK Loop Until mk% > 0 If mk% > 1 Then GoTo fin '##B# If mx% < 50 Or mx% > 350 Or my% < 150 Or my% > 450 mess( "Hors grille") GoTo entree Else X% = (mx% - 20) \ 30 y% = (my% - 120) \ 30 Rem Color RGB(255, 255, 0) Rem Fill 35 + X% * 30, 135 + y% * 30 Rem Pause 8 EndIf Rem KeyGet z% If J% = y% And I% = X% Then GoTo entree J% = y% I% = X% If b!(I%, J%) = 1 mess("Déja joué ") GoTo entree EndIf Inc C% Color RGB(255, 0, 0) Print AT(1, 18); Spc(50); AT(1, 18); " Coup :"; C%; Spc(5); Chr$(64 + y%); Chr$(64 + X%) it% = I% '##B# b!(I%, J%) = 1 X% = a%(I%, J%) If X% > 0 Dec b%(X%) If b%(X%) = 0 Dec m%(lo%(X%)) Color RGB(0, 0, 0) Text 560, 150 + (5 - lo%(X%)) * 60, Chr$(m%(lo%(X%)) + 48) Dec II% Color RGB(127, 127, 127) Fill 35 + I% * 30, 135 + J% * 30 Color RGB(0, 0, 0) If hv!(X%) = 0 For I% = pos%(X%, 1) To 4 - lo%(X%) + pos%(X%, 1) Fill 35 + I% * 30, 135 + pos%(X%, 2) * 30 Next I% Else For I% = pos%(X%, 2) To 4 - lo%(X%) + pos%(X%, 2) Fill 35 + pos%(X%, 1) * 30, 135 + I% * 30 Next I% EndIf If II% = 0 mess("Gagné en " + Str$(C%) + " coups" ) Rem Color RGB(127, 127, 127) Rem Fill 35 + I% * 30, 135 + J% * 30 Do Until MouseK > 1 Or InKey$ <> "" CloseW # 1 End Else mess("Coulé ") I% = it% EndIf Else mess("Touché ") Color RGB(127, 127, 127) Fill 35 + I% * 30, 135 + J% * 30 EndIf GoTo entree EndIf a%(I%, J%) = 0 F! = 0 For I1% = I% - 1 To I% + 1 For J1% = J% - 1 To J% + 1 F! = F! Or a%(I1%, J1%) > 0 Next J1% Next I1% If F! mess("En vue ") Color RGB(0, 255, 0) Fill 35 + I% * 30, 135 + J% * 30 Else mess("Raté") Color RGB(255, 0, 0) Fill 35 + I% * 30, 135 + J% * 30 EndIf GoTo entree fin: SetFont SYSTEM_FONT FreeFont fnt CloseW # 1 End Procedure mess(m$) Color RGB(255, 127, 0) Print AT(1, 1); Spc(50); AT(1, 1); m$ Rem KeyGet Z% EndProc