Section courante

A propos

Section administrative du site

Le jeu Missile Command est un jeu dont le but est d'éliminer les missiles visant 6 villes afin qu'il ne les atteignes pas à l'aide d'un pointeur en forme de cible. On peut connaître l'emplacement des missiles en regardant la ligne descendre.

Le programme suivant est écrit pour Turbo Pascal et est uniquement compatible avec le Turbo Pascal, il ne peut pas être exécuter sous Free Pascal ou QuickPascal par exemple, car, d'une part, il fait des accès directe à l'électronique et deuxièmement il utilise l'affichage en mode 320x200 en 256 couleurs du VGA, lequel n'était pas convenablement supporté par le Turbo Pascal. De plus, l'utilisation de la souris dans le jeu nécessaire l'appel de fonction et procédure n'étant pas disponible en standard dans le Turbo Pascal. Encore une fois, il s'agit d'un jeu que j'avais d'abord inclus dans le MonsterBook, lequel disposait d'une très forte bibliothèque graphiques, pour l'isoler de l'application, j'ai dû mettre de nombreuses routines simplifié, et de nombreuses routines ont été créé afin de maintenir une compatibilité entre le Turbo Pascal et le code source du jeu. Ainsi, il est entièrement autonome, et ne nécessite pas d'unité supplémentaire, outre Crt et DOS.

Le problème le plus complexe du jeu réside dans le fait qu'on doit tracer des lignes (appliqué par PutMissile) entre la source et une destination (potentiellement une ville). Après quelques expérimentation, il n'était pas possible d'avoir une ligne droite sans savoir quel était la destination de la ligne. Ainsi, même si la ligne n'est pas encore rendu à la destination on affiche la ligne au complet et lorqu'elle atteint la limite (indiquer par les variables de référence XOut et YOut) où elle est rendu dans sa descente, on arrête de l'afficher.

Au début, lorsque j'ai développé le jeu, j'ai tentez d'utiliser le clavier pour jouer mais le pointeur de cible ne se déplaçait jamais assez vite, j'ai ensuite envisager la manette de jeu, mais comme je n'avais pas de manette de jeu disponible, mais une souris, je me suis résigner à utiliser la souris pour jouer. Résultat, le jeu est probablement un peu trop facile pour certain. La reprogrammation du pointeur de la souris avec l'interruption 33h n'était pas assez confortable, alors j'ai changé l'approche traditionnelle d'utilisation de la souris, ainsi, j'indique au pilote de la souris que la souris est limité dans une zone horizontale et verticale, je demande ensuite les coordonnées de la souris et enfin on affiche le pointeur de cible dès qu'il a une position différente du pointeur de souris.

Tout comme le jeu Tetris que j'avais développé, j'avais un problème de délai de fluidité entre chaque ajout de pixel des missiles, j'utilisais donc une procédure WaitRetrace. J'utilisais un délai de 1/60 de seconde définit par le signal de rafraîchissement retourner par le port 03DAh par les écrans et le standard des cartes vidéos EGA, VGA, toutefois avec les systèmes d'exploitation 32 bits comme OS/2 et Windows 95, cette possibilité de calculer l'intervalle de temps de façon fiable à disparu. J'ai donc remplacé l'appel de l'électronique beaucoup plus rapide et fiable par l'appel de la fonction DELAY fournit avec l'unité CRT. L'ennui sous DOS, c'est que a la procédure avec les machines anciennes (PC et XT), c'est que le temps ne peut pas être précisé avec plus de 1/18,2 par seconde.

L'exemple de jeu Missile Command suivant est développé en Turbo Pascal 7 et fonctionne uniquement sous Turbo Pascal 7. Voici le code source en Turbo Pascal du jeu :

  1. Program MissileCommand;
  2.  
  3. Uses Crt,DOS;
  4.  
  5. Type
  6.  {Palette RVB (RGB) }
  7.  RGB=Record
  8.   R:Byte;                       { (R)ouge ((R)ed) }
  9.   G:Byte;                       { (V)ert ((G)reen) }
  10.   B:Byte;                       { (B)leu ((B)lue) }
  11.  End;
  12.  
  13. Const
  14.  LevelMissile:Array[0..5]of Byte=(10,10,20,50,100,200);
  15.  LevelMaxMissile:Array[0..5]of Byte=(2,4,5,6,10,16);
  16.  
  17.  DefaultRGB:Array[0..15]of RGB=({ Palette RVB par d,faut }
  18.   (R:$00;G:$00;B:$00), { 00h (0): Palette RVB Noir par d,faut }
  19.   (R:$00;G:$00;B:$70), { 01h (1): Palette RVB Bleu par d,faut }
  20.   (R:$00;G:$70;B:$00), { 02h (2): Palette RVB Vert par d,faut }
  21.   (R:$00;G:$70;B:$70), { 03h (3): Palette RVB Cyan par d,faut }
  22.   (R:$70;G:$00;B:$00), { 04h (4): Palette RVB Rouge par d,faut }
  23.   (R:$70;G:$00;B:$70), { 05h (5): Palette RVB Magenta par d,faut }
  24.   (R:$70;G:$48;B:$00), { 06h (6): Palette RVB Brun par d,faut }
  25.   (R:$C4;G:$C4;B:$C4), { 07h (7): Palette RVB Gris clair par d,faut }
  26.   (R:$34;G:$34;B:$34), { 08h (8): Palette RVB Gris fonc, par d,faut }
  27.   (R:$00;G:$00;B:$FF), { 09h (9): Palette RVB Bleu claire par d,faut }
  28.   (R:$24;G:$FC;B:$24), { 0Ah (10): Palette RVB Vert claire par d,faut }
  29.   (R:$00;G:$FC;B:$FC), { 0Bh (11): Palette RVB Cyan claire par d,faut }
  30.   (R:$FC;G:$14;B:$14), { 0Ch (12): Palette RVB Rouge claire par d,faut }
  31.   (R:$B0;G:$00;B:$FC), { 0Dh (13): Palette RVB Magenta claire par d,faut }
  32.   (R:$FC;G:$FC;B:$24), { 0Eh (14): Palette RVB Jaune par d,faut }
  33.   (R:$FF;G:$FF;B:$FF));{ 0Fh (15): Palette RVB blanc par d,faut }
  34.  
  35. Var
  36.  MI,ML:Array[0..19]of Byte;
  37.  MX1,MX2:Array[0..19]of Word;
  38.  MaxMissile,Missile2Send:Integer;
  39.  Level:Word;
  40.  MouseFound:Boolean;
  41.  Score:LongInt;
  42.  NmCity:Byte;
  43.  CurrColor:Byte;
  44.  OldMouseX,OldMouseY,OldMouseButton:Word;
  45.  BufMouse:Array[0..32*16-1]of Byte;
  46.  
  47.  
  48. Function MouseDriverFound:Boolean;
  49. Var
  50.  Regs:Registers;
  51. Begin
  52.  Regs.AX:=0;
  53.  Intr($33,Regs);
  54.  MouseDriverFound:=Regs.AX=$FFFF;
  55. End;
  56.  
  57. Procedure SetMouseMoveArea(X1,Y1,X2,Y2:Word);Assembler;ASM
  58.  MOV AX,8
  59.  MOV CX,Y1
  60.  MOV DX,Y2
  61.  INT 033h
  62.  MOV AX,7
  63.  MOV CX,X1
  64.  MOV DX,X2
  65.  INT 033h
  66. END;
  67.  
  68. Procedure GetMouseSwitch(Var X,Y,Button:Word);
  69. Var
  70.  Regs:Registers;
  71. Begin
  72.  Regs.AX:=$0003;
  73.  Intr($33,Regs);
  74.  Button:=Regs.BX;
  75.  X:=Regs.CX;
  76.  Y:=Regs.DX;
  77. End;
  78.  
  79. Function GetMouseButton:Word;
  80. Var
  81.  X,Y,Button:Word;
  82. Begin
  83.  GetMouseSwitch(X,Y,Button);
  84.  GetMouseButton:=Button;
  85. End;
  86.  
  87. Procedure WaitMsBut0;Begin
  88.  While GetMouseButton=0 do Begin
  89.  End;
  90. End;
  91.  
  92. Function CStr(X:LongInt):String;
  93. Var
  94.  S:String;
  95. Begin
  96.  Str(X,S);
  97.  CStr:=S;
  98. End;
  99.  
  100. Function WordToStr(X:Word):String;
  101. Var
  102.  S:String;
  103. Begin
  104.  Str(X,S);
  105.  WordToStr:=S;
  106. End;
  107.  
  108. Procedure GetMouseImage(X1,Y1,X2,Y2:Integer);
  109. Var
  110.  P,J:Integer;
  111. Begin
  112.  P:=0;
  113.  For J:=Y1 to Y2 do Begin
  114.   Move(Mem[SegA000:X1+J*320],BufMouse[P],X2-X1+1);
  115.   Inc(P,X2-X1+1);
  116.  End;
  117. End;
  118.  
  119. Procedure PutMouseImage(X1,Y1,X2,Y2:Integer);
  120. Var
  121.  P,J:Integer;
  122. Begin
  123.  P:=0;
  124.  For J:=Y1 to Y2 do Begin
  125.   Move(BufMouse[P],Mem[SegA000:X1+J*320],X2-X1+1);
  126.   Inc(P,X2-X1+1);
  127.  End;
  128. End;
  129.  
  130. Procedure SetColor(Color:Byte);Begin
  131.  CurrColor:=Color;
  132. End;
  133.  
  134. Procedure SetPixel(X,Y:Integer;Color:Byte);Begin
  135.  Mem[SegA000:X+(Y*320)]:=Color;
  136. End;
  137.  
  138. Function GetPixel(X,Y:Integer):Byte;Begin
  139.  GetPixel:=Mem[SegA000:X+(Y*320)];
  140. End;
  141.  
  142. Procedure SetPalRGB(Var P;Start,Num:Word);Assembler;ASM
  143.  MOV AL,Byte Ptr Start
  144.  MOV DX,3C8h
  145.  OUT DX,AL
  146.  CLD
  147.  INC DX
  148.  PUSH DS
  149.   LDS SI,P
  150.   MOV AX,Num
  151.   MOV CX,AX
  152.   ADD CX,AX
  153.   ADD CX,AX
  154. @2:
  155.   LODSB
  156.   {$IFOPT G+}
  157.    SHR AL,2
  158.   {$ELSE}
  159.    SHR AL,1
  160.    SHR AL,1
  161.   {$ENDIF}
  162.   OUT DX,AL
  163.   LOOP @2
  164.  POP DS
  165. END;
  166.  
  167. Procedure PutLnHor(X1,Y,X2,Kr:Integer);
  168. Var
  169.  I:Integer;
  170. Begin
  171.  If(X1>X2)Then Begin
  172.   I:=X1;
  173.   X1:=X2;
  174.   X2:=I;
  175.  End;
  176.  For I:=X1 to X2 do SetPixel(I,Y,Kr);
  177. End;
  178.  
  179. Procedure PutFillBox(X1,Y1,X2,Y2,Kr:Integer);
  180. Var
  181.  J:Integer;
  182. Begin
  183.  For J:=Y1 to Y2 do PutLnHor(X1,J,X2,Kr);
  184. End;
  185.  
  186. Procedure _PutFillBox(X1,Y1,X2,Y2:Integer);Begin
  187.  PutFillBox(X1,Y1,X2,Y2,CurrColor);
  188. End;
  189.  
  190. Procedure PutLn(X1,Y1,X2,Y2,Kr:Integer);
  191. Var
  192.  D,DX,DY,I,J,Ainc,Binc,Ic:Integer;
  193. Begin
  194.  If(Y2=Y1)Then Begin
  195.   PutLnHor(X1,Y1,X2,Kr);
  196.   Exit;
  197.  End;
  198.  If Abs(X2-X1)<Abs(Y2-Y1)Then Begin
  199.   If(Y1>Y2)Then ASM MOV AX,X1;XCHG AX,X2;MOV X1,AX;MOV AX,Y1;XCHG AX,Y2;MOV Y1,AX;END;
  200.   If(X2>X1)Then Ic:=1 Else Ic:=-1;
  201.   DY:=Y2-Y1;DX:=Abs(X2-X1);D:=(DX shl 1)-DY;Ainc:=(DX-DY)shl 1;Binc:=DX shl 1;J:=X1;
  202.   SetPixel(X1,Y1,Kr);
  203.   I:=Y1+1;
  204.   While(I<=Y2)do Begin
  205.    If D>=0Then Begin Inc(J,Ic);Inc(D,Ainc)End else Inc(D,Binc);
  206.    SetPixel(J,I,Kr);
  207.    Inc(I);
  208.   End;
  209.  End
  210.   else
  211.  Begin
  212.   If(X1>X2)Then ASM MOV AX,X1;XCHG AX,X2;MOV X1,AX;MOV AX,Y1;XCHG AX,Y2;MOV Y1,AX;END;
  213.   If(Y2>Y1)Then Ic:=1 else Ic:=-1;
  214.   DX:=X2-X1;DY:=Abs(Y2-Y1);D:=(DY shl 1)-DX;AInc:=(DY-DX)shl 1;BInc:=DY shl 1;J:=Y1;
  215.   SetPixel(X1,Y1,Kr);
  216.   I:=X1+1;
  217.   While(I<=X2)do Begin
  218.    If D>=0Then Begin Inc(J,Ic);Inc(D,Ainc)End else Inc(D,Binc);
  219.    SetPixel(I,J,Kr);
  220.    Inc(I);
  221.   End;
  222.  End;
  223. End;
  224.  
  225. Function MaxXTxts:Byte;Begin
  226.  MaxXTxts:=39;
  227. End;
  228.  
  229. Procedure CopT8Bin(X,Y,Matrix,ForegroundColor:Integer);
  230. Var
  231.  I:Byte;
  232. Begin
  233.  For I:=0 to 7 do Begin
  234.   If(Matrix shl I)and 128=128 Then Begin
  235.    SetPixel(X+I,Y,ForegroundColor);
  236.   End;
  237.  End;
  238. End;
  239.  
  240. Procedure Copy8Bin(X,Y,Matrix,ForegroundColor,BackgroundColor:Integer);
  241. Var
  242.  I:Byte;
  243. Begin
  244.  For I:=0 to 7 do Begin
  245.   If(Matrix shl I)and 128=128 Then Begin
  246.    SetPixel(X+I,Y,ForegroundColor);
  247.   End
  248.    Else
  249.   Begin
  250.    SetPixel(X+I,Y,BackgroundColor);
  251.   End;
  252.  End;
  253. End;
  254.  
  255. Procedure PutTxtXY(X,Y:Byte;Msg:String;Attr:Byte);
  256. Type
  257.  Font=Array[0..2047]of Byte;
  258.  PFont=^Font;
  259. Var
  260.  Intr:Array[0..255]of PFont Absolute $0000:$0000;
  261.  I,J:Byte;
  262. Begin
  263.  For J:=1 to Length(Msg)do For I:=0 to 7 do Begin
  264.   Copy8Bin((X+J-1)*8,Y*8+I,Intr[$43]^[Byte(Msg[J])*8+I],Attr and $F,Attr shr 4);
  265.  End;
  266. End;
  267.  
  268. Procedure BarSpcHor(X1,Y,X2,Attr:Byte);Begin
  269.  PutFillBox(X1*8,Y*8,X2*8+7,Y*8+7,Attr shr 4);
  270. End;
  271.  
  272. Procedure WaitRetrace;Begin
  273.  Delay(1000 div 60);
  274. End;
  275.  
  276. Function Canon(I:Byte):Byte;
  277. Var
  278.  S:String;
  279. Begin
  280.  S:=Chr(20*8-3)+Chr(20*8-5)+Chr(20*8-6)+Chr(20*8-7)+Chr(20*8-7)+Chr(20*8-8)+
  281.     Chr(20*8-8)+Chr(20*8-8)+Chr(20*8-8)+Chr(20*8-8)+Chr(20*8-8)+Chr(20*8-7)+
  282.     Chr(20*8-7)+Chr(20*8-6)+Chr(20*8-5)+Chr(20*8-3);
  283.  Canon:=Byte(S[I+1]);
  284. End;
  285.  
  286. Function XCity(I:Byte):Word;
  287. Var
  288.  S:String;
  289. Begin
  290.  S:=#5#10#15#23#28#33;
  291.  XCity:=Byte(S[I+1])shl 3;
  292. End;
  293.  
  294. Procedure PtrMs;Assembler;ASM
  295.  DB 11111111b,00000000b,00000000b,11111111b
  296.  DB 11111111b,11111111b,11111111b,11111111b
  297.  DB 11111111b,11111111b,11111111b,11111111b
  298.  DB 11111111b,11111111b,11111111b,11111111b
  299.  DB 11111111b,11111111b,11111111b,11111111b
  300.  DB 11111111b,11111111b,11111111b,11111111b
  301.  DB 01111111b,11111111b,11111111b,11111110b
  302.  DB 01111111b,11111111b,11111111b,11111110b
  303.  DB 01111111b,11111111b,11111111b,11111110b
  304.  DB 01111111b,11111111b,11111111b,11111110b
  305.  DB 11111111b,11111111b,11111111b,11111111b
  306.  DB 11111111b,11111111b,11111111b,11111111b
  307.  DB 11111111b,11111111b,11111111b,11111111b
  308.  DB 11111111b,11111111b,11111111b,11111111b
  309.  DB 11111111b,11111111b,11111111b,11111111b
  310.  DB 11111111b,00000000b,00000000b,11111111b
  311.  
  312.  DB 00000000b,01111100b,00111110b,00000000b
  313.  DB 00000011b,10000000b,00000001b,11000000b
  314.  DB 00001100b,00000000b,00000000b,00110000b
  315.  DB 00110000b,00000000b,00000000b,00001100b
  316.  DB 01000000b,00000000b,00000000b,00000010b
  317.  DB 10000000b,00000001b,10000000b,00000001b
  318.  DB 10000000b,00000001b,10000000b,00000001b
  319.  DB 00000000b,00000111b,11100000b,00000000b
  320.  DB 00000000b,00000111b,11100000b,00000000b
  321.  DB 10000000b,00000001b,10000000b,00000001b
  322.  DB 10000000b,00000001b,10000000b,00000001b
  323.  DB 01000000b,00000000b,00000000b,00000010b
  324.  DB 00110000b,00000000b,00000000b,00001100b
  325.  DB 00001100b,00000000b,00000000b,00110000b
  326.  DB 00000011b,10000000b,00000001b,11000000b
  327.  DB 00000000b,01111100b,00111110b,00000000b
  328. END;
  329.  
  330. Procedure HideMousePtr;Begin
  331.  PutMouseImage(OldMouseX,OldMouseY,OldMouseX+31,OldMouseY+15);
  332. End;
  333.  
  334. Procedure ShowMousePtr;
  335. Type
  336.  TPtrMs=Array[0..1,0..15,0..3]of Byte;
  337. Var
  338.  I,J:Integer;
  339.  MousePtr:^TPtrMs;
  340. Begin
  341.  GetMouseImage(OldMouseX,OldMouseY,OldMouseX+31,OldMouseY+15);
  342.  MousePtr:=@PtrMs;
  343.  For J:=0 to 15 do For I:=0 to 3 do Begin
  344.   CopT8Bin(OldMouseX+I*8,OldMouseY+J,MousePtr^[1,J,I],$F);
  345.  End;
  346. End;
  347.  
  348. Procedure _BackKbd;
  349. Var
  350.  X,Y,Button:Word;
  351. Begin
  352.  GetMouseSwitch(X,Y,Button);
  353.  If(X<>OldMouseX)or(Y<>OldMouseY)Then Begin
  354.   HideMousePtr;
  355.   OldMouseX:=X;
  356.   OldMouseY:=Y;
  357.   ShowMousePtr;
  358.  End;
  359. End;
  360.  
  361. Function PutMissile(X1,Y1,X2,Y2,Limit,Kr:Integer;Var XOut,YOut:Integer):Byte;
  362. Var
  363.  D,DX,DY,I,J,Ainc,Binc,Ic,OK:Integer;
  364. Begin
  365.  PutMissile:=0;
  366.  If Abs(X2-X1)<Abs(Y2-Y1)Then Begin
  367.   If(Y1>Y2)Then ASM
  368.    MOV AX,X1;
  369.    XCHG AX,X2;
  370.    MOV X1,AX;
  371.    MOV AX,Y1;
  372.    XCHG AX,Y2;
  373.    MOV Y1,AX;
  374.   END;
  375.   If(X2>X1)Then Ic:=1 Else Ic:=-1;
  376.   DY:=Y2-Y1;DX:=Abs(X2-X1);D:=(DX shl 1)-DY;Ainc:=(DX-DY)shl 1;Binc:=DX shl 1;J:=X1;
  377.   SetPixel(X1,Y1,Kr);
  378.   I:=Y1+1;
  379.   While(I<=Y2)do Begin
  380.    If D>=0Then Begin Inc(J,Ic);Inc(D,Ainc)End else Inc(D,Binc);
  381.    OK:=GetPixel(J,I);
  382.    If OK in[1,2,3]Then Begin XOut:=J;PutMissile:=OK;Exit;End;
  383.    SetPixel(J,I,Kr);
  384.    If(I>Limit)Then Begin XOut:=J;YOut:=I;Exit;End;
  385.    Inc(I);
  386.   End;
  387.  End
  388.   else
  389.  Begin
  390. { If(X1>X2)Then ASM MOV AX,X1;XCHG AX,X2;MOV X1,AX;MOV AX,Y1;XCHG AX,Y2;MOV Y1,AX;END;}
  391.   If(Y2>Y1)Then Ic:=1 else Ic:=-1;
  392.   DX:=Abs(X2-X1);DY:=Abs(Y2-Y1);D:=(DY shl 1)-DX;AInc:=(DY-DX)shl 1;BInc:=DY shl 1;J:=Y1;
  393.   SetPixel(X1,Y1,Kr);
  394.   If(X1>X2)Then Begin
  395.    I:=X1;
  396.    While(I>=X2)do Begin
  397.     If D>=0Then Begin Inc(J);Inc(D,Ainc)End else Inc(D,Binc);
  398.     OK:=GetPixel(I,J);
  399.     If OK in[1,2,3]Then Begin XOut:=I;PutMissile:=OK;Exit;End;
  400.     SetPixel(I,J,Kr);
  401.     If(J>Limit)Then Begin XOut:=I;YOut:=J;Exit;End;
  402.     Dec(I);
  403.    End;
  404.   End
  405.    Else
  406.   Begin
  407.    I:=X1+1;
  408.    While(I<=X2)do Begin
  409.     If D>=0Then Begin J:=J+Ic;Inc(D,Ainc)End else Inc(D,Binc);
  410.     OK:=GetPixel(I,J);
  411.     If OK in[1,2,3]Then Begin XOut:=I;PutMissile:=OK;Exit;End;
  412.     SetPixel(I,J,Kr);
  413.     If(J>Limit)Then Begin XOut:=I;YOut:=J;Exit;End;
  414.     Inc(I);
  415.    End;
  416.   End;
  417.  End;
  418. End;
  419.  
  420. Function EY(I:Byte):Byte;Near;
  421. Var
  422.  S:String;
  423. Begin
  424.  S:=#0#0#0#0#6#6#2#2#4#4#4#1#5#0#0#0#4#4#2#2#4#0#1;
  425.  EY:=Byte(S[I+1]);
  426. End;
  427.  
  428. Procedure _PutCity(X:Word);
  429. Var
  430.  I:Byte;
  431. Begin
  432.  For I:=0to 22do PutLn(X+I,20*8+EY(I),X+I,22*8-1,CurrColor)
  433. End;
  434.  
  435. Procedure PutCity(X:Word);Begin
  436.  SetColor(3);
  437.  _PutCity(X)
  438. End;
  439.  
  440. Procedure EraseCity(X:Word);
  441. Var
  442.  I:Byte;
  443. Begin
  444.  For I:=0to 5do If(X>=XCity(I))and(X<=XCity(I)+22)Then Break;
  445.  SetColor(0);
  446.  _PutCity(XCity(I));
  447.  For I:=0to 2do Begin
  448.   SetPalRGB(DefaultRGB[15],0,1);WaitRetrace;
  449.   SetPalRGB(DefaultRGB[0],0,1);WaitRetrace
  450.  End;
  451. End;
  452.  
  453. Procedure InitScr;
  454. Var
  455.  J:Byte;
  456. Begin
  457.  SetColor(1);
  458.  PutFillBox(0,22*8,319,191,1);
  459.  _PutFillBox(0,19*8,15,22*8-1);
  460.  _PutFillBox(38*8,19*8,319,22*8-1);
  461.  For J:=0to 15do PutLn(20*8-4+J,Canon(J),20*8-4+J,20*8-1,2);
  462.  _PutFillBox(19*8,20*8,22*8-1,22*8-1);
  463.  For J:=0to 5do PutCity(XCity(J));
  464.  BarSpcHor(0,24,MaxXTxts,$B0);
  465.  PutTxtXY(1,24,'Pointage:',$B0);
  466.  FillChar(BufMouse,SizeOf(BufMouse),0);
  467.  SetPalRGB(DefaultRGB,0,16);
  468.  SetMouseMoveArea(0,0,319-32,19*8-1);
  469.  GetMouseSwitch(OldMouseX,OldMouseY,OldMouseButton);
  470. End;
  471.  
  472. Procedure MakeNewMissile(I:Byte);Begin
  473.  MI[I]:=0;ML[I]:=1+Random(Level);
  474.  MX1[I]:=Random(318);MX2[I]:=Random(38*8-34)+16;
  475. End;
  476.  
  477. Procedure UpDateScore;Begin
  478.  PutTxtXY(11,24,CStr(Score),$B0)
  479. End;
  480.  
  481. Procedure Play;
  482. Label
  483.  C,Chk,BreakAll;
  484. Var
  485.  Out:Byte;
  486.  XOut,T,YOut:Integer;
  487.  X,Y,B:Word;
  488.  I,J,KM:Integer;
  489. Begin
  490.  FillChar(MI,SizeOf(MI),0);
  491.  FillChar(MX1,SizeOf(MX1),0);
  492.  FillChar(MX2,SizeOf(MX2),0);
  493.  Level:=0;Score:=0;NmCity:=6;
  494.  Repeat
  495.   If Level>5Then I:=5 Else I:=Level;
  496.   MaxMissile:=LevelMaxMissile[I];Missile2Send:=LevelMissile[I];KM:=0;
  497.   PutTxtXY(25,24,'Niveau: '+WordToStr(Level+1),$B0);
  498.   UpDateScore;
  499.   For I:=0to(MaxMissile)do MakeNewMissile(I);
  500.   ShowMousePtr;
  501.   Repeat
  502.    _BackKbd;
  503.    I:=0;
  504.    If(KeyPressed)Then Begin
  505.     ReadKey;
  506.     Exit;
  507.    End;
  508.  C:While(I<=MaxMissile)do Begin
  509.     Out:=PutMissile(MX1[I],0,MX2[I],22*8-1,MI[I],15,XOut,YOut);
  510.     If(Out>0)or(MI[I]>=22*8-1)Then Begin
  511.      {__HideMousePtr;}
  512.      PutMissile(MX1[I],0,MX2[I],22*8-1,MI[I],0,T,T);
  513.      If Out=3Then Begin
  514.       Dec(NmCity);
  515.       EraseCity(XOut);
  516.       If NmCity=0Then Begin
  517.        PutTxtXY(20,11,'TOUTES LES CIT?S SONT D?TRUITES,',$C);
  518.        PutTxtXY(20,13,'PARTIE TERMINER!',$C);
  519.        ReadKey;
  520.        Exit;
  521.       End;
  522.      End;
  523.      ShowMousePtr;
  524.      Goto Chk;
  525.     End
  526.      Else
  527.     Begin
  528.      WaitRetrace;
  529.      If Level<4Then WaitRetrace;
  530.      GetMouseSwitch(X,Y,B);
  531.      If B>0Then Begin
  532.       If(X<=XOut)and(X+31>=XOut)and(Y<=YOut)and(Y+15>=YOut)Then Begin
  533.        Inc(KM);
  534.        HideMousePtr;
  535.        PutMissile(MX1[I],0,MX2[I],22*8-1,MI[I],0,T,T);
  536.        ShowMousePtr;
  537.        Inc(Score,100);
  538.        UpDateScore;
  539.    Chk:If Missile2Send>0Then Begin
  540.         MakeNewMissile(I);
  541.         Dec(Missile2Send);
  542.        End
  543.         Else
  544.        If MaxMissile>0Then Begin
  545.         Repeat
  546.          If(I=MaxMissile)or(MaxMissile=0)Then Break;
  547.          For J:=I to MaxMissile-1do Begin
  548.           MI[J]:=MI[J+1];ML[J]:=ML[J+1];MX1[J]:=MX1[J+1];MX2[J]:=MX2[J+1]
  549.          End;
  550.         Until True;
  551.         Dec(MaxMissile);I:=0;
  552.         Goto C;
  553.        End
  554.         Else
  555.        Goto BreakAll;
  556.       End;
  557.      End;
  558.      Inc(MI[I],ML[I]);
  559.     End;
  560.     Inc(I);
  561.    End;
  562.   Until False;
  563. BreakAll:
  564.   HideMousePtr;
  565.   If KM>0Then For I:=0to(15*NmCity)do Begin
  566.    WaitRetrace;
  567.    WaitRetrace;
  568.    Inc(Score,5);
  569.    UpDateScore;
  570.   End;
  571.   Inc(Level);
  572.   PutTxtXY(20,12,'PRES POUR LE NIVEAU '+WordToStr(Level+1)+'!',$B);
  573.   Repeat
  574.    If GetMouseButton>0Then Break;
  575.   Until KeyPressed;
  576.   If GetMouseButton=0Then ReadKey Else WaitMsBut0;
  577.   PutFillBox(0,0,319,19*8-1,0);
  578.  Until False;
  579. End;
  580.  
  581. BEGIN
  582.  Randomize;
  583.  ASM
  584.   MOV AX,0013h
  585.   INT 10h
  586.  END;
  587.  MouseFound:=MouseDriverFound;
  588.  If Not MouseFound Then Begin
  589.   WriteLn('Une souris est requise pour jouer a ce jeu');
  590.  End
  591.   Else
  592.  Begin
  593.   InitScr;
  594.   Play;
  595.  End;
  596.  TextMode(CO80);
  597. END.

Code source

Voici le code source du jeu sur GitHub :

Lien Langage de programmation Projet
https://github.com/gladir/7iles/blob/main/MISSILE.PAS Turbo Pascal, Free Pascal 7iles


Dernière mise à jour : Jeudi, le 4 août 2022