Section courante

A propos

Section administrative du site

Le jeu Peg Leap est un jeu fort simple et ressemblant au dames. Le but de jeu est d'enlever le plus de jetons possible du jeu en sautant par dessus chaque jeton avec un autre. Vous ne pouvez sauter diagonalement. Le jeton sauté sera enlevé du jeu. D'abord, vous devez placer le curseur sur le jeton sautant et enfoncé la touche ENTER. Ensuite, placer le curseur dans l'espace libre et presser encore ENTER.

Le jeu est très facile à écrire ou voir à reproduire dans n'importe quel langage de programmation. On commence par afficher un simple écran de texte et on affiche les instructions à l'aide de la procédure Instruction. Ensuite, on affiche le jeu le tableau du jeu. Pour des raisons évidente, il est inutile de chercher à écrire une procédure complexe pour afficher la grille, et il est plus simple d'effectuer un affichage bête et simple du texte avec les jetons dedans. Toutefois, afin de pouvoir jouer plus tard, on conservera l'emplacement des 33 jetons dans un tableau nommé Data.

Le jeu a été développé à l'origine en GWBASIC, et c'est la raison pour laquelle, on retrouve de nombreux GOTO à travers les instructions proposé. Ensuite, de nombreux problèmes pour adapter les délais, indiqués par une boucle FOR/NEXT vide du GWBASIC par une procédure WaitRetrace correspondant au rafraîchissement de la vidéo. Mais par la suite, cette même instruction a été encore une fois remplacé par l'instruction DELAY par souci de compatibilité avec les compilateurs de Pascal plus récent.

Le moteur du jeu c'est la procédure ChoicePiece, laquelle permettra de déplacer les pièces en utilisant le curseur. On attend que le joueur enfonce une touche et on tentera de lui associer un déplacement. Lors de sa première sélection, on déterminera s'il existe vraiment une pièce et sa deuxième sélection, on déterminera s'il est possible de déplacer la pièce à l'endroit indiqué à l'aide de la fonction IsOK, sinon, on lui fait choisir à nouveau la deuxième sélection.


L'exemple de jeu Peg Leap suivant est développé en Turbo Pascal 7 et fonctionne également sous Free Pascal. Voici le code source en Turbo Pascal du jeu :

  1. Program PegLeap;
  2.  
  3. Uses Crt;
  4.  
  5. Label 40,360,410,690,_Continue1,_Continue2;
  6.  
  7. Const
  8.  {Code de touche clavier renvoyée par ReadKey}
  9.  kbNoKey=0;{Pas de touche}
  10.  kbEsc=$001B;{Escape}
  11.  kbUp=$4800;{Up}
  12.  kbLeft=$4B00;{Flèche de gauche (Left)}
  13.  kbRight=$4D00;{Flèche de droite (Right)}
  14.  kbDn=$5000;{Flèche du bas (Down)}
  15.  kbHome=$4700;{Home}
  16.  kbTab=$0F09;{Tabulation}
  17.  kbEnd=$4F00;{End}
  18.  kbEnter=$000D;{Enter}
  19.  kbF10=$4400;{F10}
  20.  
  21. Function MultChr(Chr:Char;Len:Byte):String;
  22. Var
  23.  I:Byte;
  24.  S:String;
  25. Begin
  26.  S:='';
  27.  For I:=1 to Len do S:=S+Chr;
  28.  MultChr:=S;
  29. End;
  30.  
  31. Procedure WaitRetrace;Begin
  32.  Delay(10);
  33. End;
  34.  
  35. Procedure Instruction;
  36. Label Break;
  37. Var
  38.  J:Byte;
  39.  K:Word;
  40.  CK:Char Absolute K;
  41. Begin
  42.  TextBackground(0);
  43.  TextColor(6);
  44.  ClrScr;
  45.  Write(MultChr('¦',80));
  46.  For J:=1 to 21 do Begin
  47.   GotoXY(1,J+1);
  48.   Write('¦');
  49.   GotoXY(80,J+1);
  50.   Write('¦');
  51.  End;
  52.  GotoXY(1,23);
  53.  Write(MultChr('¦',80));
  54.  GotoXY(34,3);
  55.  TextColor(11);
  56.  Write('P E G L E A P');
  57.  TextColor(15);
  58.  GotoXY(22,8);
  59.  Write('Voulez-vous les instructions ? <O/N>');
  60.  TextColor(3);
  61.  Repeat
  62.   K:=Byte(ReadKey);
  63.   If K=0Then K:=K or (Byte(ReadKey)shl 8);
  64.   Case(CK)of
  65.    'n','N':GOTO Break;
  66.    'o','O':Begin
  67.     GotoXY(21,7);
  68. Write(' Il s''agit d''un jeu fort simple qui res-');
  69.     GotoXY(21,8);
  70. Write(' semble aux dames. Le but du jeu est');
  71.     GotoXY(21,9);
  72. Write(' d''enlever le plus de jetons possible du');
  73.     GotoXY(21,10);
  74. Write(' en sautant par dessus chaque jeton avec');
  75.     GotoXY(21,11);
  76. Write(' un autre. Vous ne pouvez sauter diagonale-');
  77.     GotoXY(21,12);
  78. Write(' ment. Le jeton sauté sera enlevé du jeu.');
  79.     GotoXY(21,14);
  80. Write(' D''abord place le curseur sous le jeton');
  81.     GotoXY(21,15);
  82. Write(' qui saute et pèse <ENTER>.');
  83.     GotoXY(21,17);
  84. Write(' Ensuite place le curseur dans l''espace');
  85.     GotoXY(21,18);
  86. Write(' libre où sauter et pèse encore <ENTER>.');
  87.     GotoXY(28,25);
  88. TextColor(15);
  89. Write('Presse une touche pour continuer');
  90.     If(ReadKey<>#0)Then;
  91.     GOTO Break;
  92.    End;
  93.   End;
  94.  Until False;
  95. Break:
  96.  ClrScr;
  97. End;
  98.  
  99. Const Data:Array[0..32]of Byte=(13,14,15,
  100. 22,23,24,
  101.   29,30,31,32,33,34,35,
  102.   38,39,40,41,42,43,44,
  103.   47,48,49,50,51,52,53,
  104. 58,59,60,
  105. 67,68,69);
  106. DataPtr:Byte=0;
  107.  
  108. Var
  109.  Pegs,Holes,Contents:String;
  110.  B:Array[0..70]of LongInt;
  111.  T,XY:Array[0..9,0..9]of LongInt;
  112.  XLin,XPos,XSave,YSave,XCoord,YCoord,ZXSave,ZYSave,ZXCoord,ZYCoord:Integer;
  113.  A,_B,F,P,R,C,W,X,Y,Z,_T:Integer;
  114.  K:Word;
  115.  CK:Char Absolute K;
  116.  
  117. Procedure ExitMsg;Begin
  118.  GotoXY(25,25);
  119.  TextColor(7);
  120.  Write(' Presse <F10> pour abandonner ce Jeu ');
  121.  TextColor(3);
  122.  GotoXY(1,1);
  123. End;
  124.  
  125. Procedure Restore;Begin
  126.  DataPtr:=0;
  127. End;
  128.  
  129. Function XCur:Integer;Begin
  130.  XCur:=WhereX;
  131. End;
  132.  
  133. Function YCur:Integer;Begin
  134.  YCur:=WhereY;
  135. End;
  136.  
  137. Procedure ChoicePeace;
  138. Var
  139.  Ok:Boolean;
  140. Begin
  141. { SimpleCur;}
  142.  Ok:=False;
  143.  Repeat
  144.   K:=Byte(ReadKey);
  145.   If K=0Then K:=K or (Byte(ReadKey)shl 8);
  146.   Case(K)of
  147.    kbUp:If YCur>=6Then Begin
  148.     If Not((YCur<12)and(XCur in[0..33,48..255]))Then Begin
  149.      GotoXY(WhereX,WhereY-3);
  150.     End;
  151.    End;
  152.    kbLeft:If XCur>=28Then Begin
  153.     If Not((YCur in[0..8,16..255])and(XCur<40))Then Begin
  154.  GotoXY(WhereX-6,WhereY);
  155.     End;
  156.    End;
  157.    kbRight:If XCur<=53Then Begin
  158.     If Not((YCur in[0..8,16..255])and(XCur>41))Then Begin
  159.  GotoXY(WhereX+6,WhereY);
  160.     End;
  161.    End;
  162.    kbDn:If YCur<=20Then Begin
  163.     If Not((YCur>12)and(XCur in[0..33,48..255]))Then Begin
  164.  GotoXY(WhereX,WhereY+3);
  165.     End;
  166.    End;
  167.    kbEnter,kbEsc,kbF10:Ok:=True;
  168.   End;
  169.   If CK=' 'Then Begin
  170.    K:=kbEnter;
  171.    Ok:=True;
  172.   End;
  173.  Until Ok;
  174.  {CloseCur;}
  175.  XSave:=XCur;XCoord:=(XSave-10)div 6;
  176.  YSave:=YCur;YCoord:=(YSave div 3)+1;
  177. End;
  178.  
  179. Function IsOK:Boolean;
  180. Label 1140,1160;
  181. Begin
  182.  IsOk:=False;C:=1;
  183.  For X:=1 to 9do For Y:=1to 9do Begin
  184.   If(C<>Z)Then Goto 1160;
  185.   If(C+2=P)Then Begin
  186.    If T[X,Y+1]=0Then Exit;
  187.    T[X,Y+2]:=5;T[X,Y+1]:=0;B[C+1]:=-3;
  188.    Goto 1140
  189.   End;
  190.   If(C+18=P)Then Begin
  191.    If T[X+1,Y]=0Then Exit;
  192.    T[X+2,Y]:=5;T[X+1,Y]:=0;B[C+9]:=-3;
  193.    Goto 1140
  194.   End;
  195.   If(C-2=P)Then Begin
  196.    If T[X,Y-1]=0Then Exit;
  197.    T[X,Y-2]:=5;T[X,Y-1]:=0;B[C-1]:=-3;
  198.    Goto 1140;
  199.   End;
  200.   If(C-18=P)Then Begin
  201.    If T[X-1,Y]=0Then Exit;
  202.    T[X-2,Y]:=5;T[X-1,Y]:=0;B[C-9]:=-3;B[Z]:=-3;B[P]:=-7;
  203. 1140:B[Z]:=-3;B[P]:=-7;T[X,Y]:=0;
  204.    IsOk:=True;
  205.    Exit;
  206.   End;
  207. 1160:Inc(C);
  208.  End;
  209.  IsOk:=True;
  210. End;
  211.  
  212. Procedure UpDate;Var XOffset,YOffset:Integer;Begin
  213.  CONTENTS:=HOLES;
  214.  If T[ZYCOORD,ZXCOORD]=5Then Contents:=Pegs;
  215.  GotoXY(ZXSave,ZYSave);
  216.  Write(Contents);
  217.  Contents:=Holes;
  218.  If T[YCoord,XCoord]=5Then Contents:=Pegs;
  219.  GotoXY(XSAVE,YSAVE);
  220.  Write(Contents);
  221.  YOFFSET:=ZYCOORD-YCOORD;
  222.  XOFFSET:=ZXCOORD-XCOORD;
  223.  If YOFFSET>0Then YOFFSET:=1;
  224.  If XOFFSET>0Then XOFFSET:=1;
  225.  If YOFFSET<0Then YOFFSET:=-1;
  226.  If XOFFSET<0Then XOFFSET:=-1;
  227.  CONTENTS:=HOLES;
  228.  GotoXY(XSAVE+(XOFFSET*6),YSAVE+(YOFFSET*3));
  229.  Write(Contents);
  230. End;
  231.  
  232. Procedure _Halt;Begin
  233.  XLIN:=WhereX;
  234.  XPOS:=WhereY;
  235.  GotoXY(1,25);
  236.  Write(' ':80);
  237.  GotoXY(21,24);
  238.  Write('Voulez-vous abandonner ce Jeu ? <O/N>');
  239.  Repeat
  240.   K:=Byte(ReadKey);
  241.   If K=0Then K:=K or (Byte(ReadKey)shl 8);
  242.   If CK in['O','o']Then Halt;
  243.  Until CK in['n','N'];
  244.  ExitMsg;
  245. End;
  246.  
  247. BEGIN
  248.  TextMode(C80);
  249.  ClrScr;
  250.  Instruction;
  251.  PEGS:='o';HOLES:=' ';
  252. 40:
  253.  ClrScr;
  254.  XLIN:=0;XPOS:=0;
  255.  ExitMsg;
  256.  FillChar(R,SizeOf(R),0);
  257.  FillChar(C,SizeOf(C),0);
  258.  FillChar(XY,SizeOf(XY),0);
  259.  For R:=1to 9do For C:=1to 9do Begin
  260.   If(((R-4)*(R-5)*(R-6)=0)or((C-4)*(C-5)*(C-6)=0))and Not((R-1)*(C-1)*(R-9)*(C-9)=0)Then Begin
  261.     T[R,C]:=5;XY[R,C]:=Data[DataPtr];
  262. Inc(DataPtr)
  263.   End
  264.    Else
  265.   T[R,C]:=-5;
  266.  End;
  267.  T[5,5]:=0;
  268.  GotoXY(1,2);
  269.  WriteLn(' ':32,'+---+ +---+ +---+');
  270.  WriteLn(' ':32,'¦ o ¦ ¦ o ¦ ¦ o ¦');
  271.  WriteLn(' ':32,'+---+ +---+ +---+');
  272.  WriteLn(' ':32,'+---+ +---+ +---+');
  273.  WriteLn(' ':32,'¦ o ¦ ¦ o ¦ ¦ o ¦');
  274.  WriteLn(' ':32,'+---+ +---+ +---+');
  275.  WriteLn(' ':20,'+---+ +---+ +---+ +---+ +---+ +---+ +---+');
  276.  WriteLn(' ':20,'¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦');
  277.  WriteLn(' ':20,'+---+ +---+ +---+ +---+ +---+ +---+ +---+');
  278.  WriteLn(' ':20,'+---+ +---+ +---+ +---+ +---+ +---+ +---+');
  279.  WriteLn(' ':20,'¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦');
  280.  WriteLn(' ':20,'+---+ +---+ +---+ +---+ +---+ +---+ +---+');
  281.  WriteLn(' ':20,'+---+ +---+ +---+ +---+ +---+ +---+ +---+');
  282.  WriteLn(' ':20,'¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦ ¦ o ¦');
  283.  WriteLn(' ':20,'+---+ +---+ +---+ +---+ +---+ +---+ +---+');
  284.  WriteLn(' ':32,'+---+ +---+ +---+');
  285.  WriteLn(' ':32,'¦ o ¦ ¦ o ¦ ¦ o ¦');
  286.  WriteLn(' ':32,'+---+ +---+ +---+');
  287.  WriteLn(' ':32,'+---+ +---+ +---+');
  288.  WriteLn(' ':32,'¦ o ¦ ¦ o ¦ ¦ o ¦');
  289.  WriteLn(' ':32,'+---+ +---+ +---+');
  290.  Restore;
  291.  For W:=1to 33do Begin
  292.   B[Data[DataPtr]]:=-7;
  293.   Inc(DataPtr)
  294.  End;
  295.  B[41]:=-3;
  296. 360:YSave:=12;XSave:=41;
  297.  GotoXY(1,25);
  298.  Write(' ':24,'Place le curseur et presse <ENTER>.');
  299.  ClrEol;
  300.  GotoXY(32,24);
  301.  Write(' Quelle piece ? ');
  302.  ClrEol;
  303.  GotoXY(XSave,YSave);
  304. 410:ChoicePeace;
  305.  If(K=kbEsc)or(K=kbF10)Then _Halt;
  306.  ZYSAVE:=YSAVE;ZXSAVE:=XSAVE;ZYCOORD:=YCOORD;ZXCOORD:=XCOORD;Z:=XY[YCOORD,XCOORD];
  307.  If B[Z]<>-7Then Begin
  308. 690:CONTENTS:=HOLES;
  309.   If T[ZYCOORD,ZXCOORD]=5THEN CONTENTS:=PEGS;
  310.   GotoXY(ZXSave,ZYSave);
  311.   Write(CONTENTS);
  312.   CONTENTS:=HOLES;
  313.   If T[YCOORD,XCOORD]=5THEN CONTENTS:=PEGS;
  314.   GotoXY(XSave,YSave);
  315.   Write(CONTENTS);
  316.   GotoXY(1,20);
  317.   Write('Invalide...recommence.');
  318.   WaitRetrace;WaitRetrace;WaitRetrace;WaitRetrace;WaitRetrace;
  319.   WaitRetrace;WaitRetrace;WaitRetrace;WaitRetrace;WaitRetrace;
  320.   GotoXY(1,20);
  321.   Write(' ':27);
  322.   {SetPos(XSave-1,YSave-1);
  323. SetCurPos(XSave-1,YSave-1);}
  324.   Goto 360;
  325.  End;
  326.  GotoXY(33,23);
  327.  Write(' Ou? ');
  328.  GotoXY(XSave,YSave);
  329.  TextColor(7);
  330.  TextBackground(8);
  331.  Write(PEGS);
  332.  TextBackground(0);
  333.  GotoXY(XSave,YSave);
  334.  ChoicePeace;
  335.  If(K=kbEsc)or(K=kbF10)Then _Halt;
  336.  P:=XY[YCOORD,XCOORD];
  337.  If(B[P]=0)or(B[P]=-7)Then Goto 690;
  338.  If(Z=P)Then Goto 360;
  339.  If (Z+P)and 1=1Then Goto 690;
  340.  If(ABS(Z-P)-2)*(ABS(Z-P)-18)<>0 THEN Goto 690;
  341.  If Not(IsOK)Then Goto 690;
  342.  UpDate;
  343.  F:=0;
  344.  For R:=2to 8do Begin
  345.   For C:=2to 8do Begin
  346.    If T[R,C]=5Then Begin
  347.     Inc(F);
  348.     For A:=R-1to R+1do Begin
  349.      _T:=0;For _B:=C-1to C+1do Inc(_T,T[A,_B]);
  350.      If _T<>10Then Goto _Continue1;
  351.      If T[A,C]<>0Then Goto 360;
  352. _Continue1:
  353.     End;
  354.     For X:=C-1to C+1do Begin
  355.      _T:=0;For Y:=R-1to R+1do Inc(_T,T[Y,X]);
  356.      If _T<>10Then Goto _Continue2;
  357.      If T[R,X]<>0Then Goto 360;
  358. _Continue2:
  359.     End;
  360.    End;
  361.   End;
  362.  End;
  363.  GotoXY(1,22);
  364.  Write('Il ne vous reste que ',F,' pièces.');
  365.  GotoXY(1,24);
  366.  Write(' ':80);
  367.  Case(F)of
  368.   1:Begin
  369.    GotoXY(1,21);
  370.    Write('BRAVO !');
  371.    GotoXY(1,23);
  372.    Write('Parfait !');
  373.    If T[5,5]=5Then Begin
  374.     GotoXY(1,23);
  375. Write('Dans le centre ! Vous etes un Génie !');
  376.    End;
  377.   End;
  378.   2:Begin
  379.    GotoXY(1,21);
  380.    Write('EXECELLENT !');
  381.    GotoXY(3,21);
  382.    Write('Essaie encore.');
  383.   End;
  384.   3,4:Begin
  385.    GotoXY(1,21);
  386.    Write('Très bien !');
  387.    GotoXY(1,23);
  388.    Write('N''abandonnez pas!');
  389.   End;
  390.   5..7:Begin
  391.    GotoXY(1,21);
  392.    Write('PAS PIRE');
  393.    GotoXY(1,23);
  394.    Write('Essaie encore.');
  395.   End;
  396.  End;
  397.  If Not(F<8)Then Begin
  398.   If F>24Then Begin
  399.    GotoXY(1,21);
  400.    Write('Ce n''est pas le but du jeu');
  401.    GotoXY(1,23);
  402.    Write('Lisser les instructions !');
  403.   End
  404.    Else
  405.   Begin
  406.    GotoXY(1,21);
  407.    Write('OUCH!');
  408.    GotoXY(1,22);
  409.    Write('Il ne reste que ',F,' pièces.');
  410.    GotoXY(1,23);
  411.    Write('Ce n''est pas votre journée!');
  412.   End;
  413.  End;
  414.  GotoXY(1,24);
  415.  Write('Aimeriez-vous jouer encore ? <O/N>');
  416.  Repeat
  417.   K:=Byte(ReadKey);
  418.   If K=0Then K:=K or (Byte(ReadKey)shl 8);
  419.   If(CK in['n','N'])or(K=kbEsc)Then Halt;
  420.  Until CK in['o','O'];
  421.  Restore;
  422.  Goto 40;
  423. END.

Code source

Voici le code source du jeu sur GitHub :

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


Dernière mise à jour : Jeudi, le 28 juillet 2022