Section courante

A propos

Section administrative du site

Vous vous savez du fabuleux jeux soviétique «Tetris», succès incroyable des années 1980, où il faut placer des cubes afin de faire disparaître des lignes. Voici la version que j'avais inclus dans le MonsterBook et que j'ai adapté pour Turbo Pascal et son unité «Crt». Ainsi, il n'est nullement nécessaire de développer se jeu dans un écran graphique, tout peut être fait en écran de texte avec les performances nettement plus élevé que cela offre.

Lors du développement de la version original de ma version de jeu Tetris, que j'avais effectué sur mon Amdek System/88, afin d'avoir le délai le plus proche de la réalité, lors des mouvements des pièces, j'ai définit la 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 CGA, MDA, 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 remplacer 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, le problème en résultat que sur les vieilles machines, le mouvements du déplacements des pièces est toujours assez lent et que finalement lorsqu'on atteint un certain niveau, le temps d'attente en chaque pièce est toujours le même et que donc, plus le jeu est lent plus c'est facile d'augmenter son pointage et de résister longtemps à des niveau élevé.

La lecture des touches du clavier se faisait à l'origine avec l'interruption 16h, fonction 00h, car je voulais supporté la touche 5 du bloc numérique du clavier pour faire la rotation des pièces, et la fonction ReadKey de l'unité du Crt ne le supportait puisqu'elle est appelait l'interruption 21h du système d'exploitation MS-DOS de Microsoft. Ainsi, afin de rester au compatible avec les restrictions sous-évolutives futurs et le Free Pascal, j'ai dû me résigner à abandonner cette possibilité.

Par soucis de performance, les déplacements de bloc de mémoire utilisaient des routines MoveLeft ou MoveRight en langages machines de langage Assembleur 8086. Bien qu'il existait une routine Move dans le Turbo Pascal 7, dans les versions plus anciennes, il ne vérifiait pas si la copie des données étaient effectué à partir du début (MoveLeft) ou à partir de la fin (MoveRight). Cette technique étaient inspiré des routines MoveLeft et MoveRight du Apple Pascal pour les Apple II.

Le déplacement des zones des pièces (soit le défilement de l'écran), utilisait à l'origine la procédure MoveText proposé dans la bibliothèque de code que j'avais inclus dans le MonsterBook, lequel permettant également de faire des défilements autant horizontale que verticale, ne sont plus supporté. Malheureusement, les techniques utilisés dans cette routine passait directement par l'électronique et se de se fait, n'était plus compatible avec la technique proposé par les autres compilateurs Pascal, j'ai donc modifié la procédure pour qu'elle soit uniquement compatible avec l'unité Crt et ce jeu et elle ne supporte pas le défilement horizontale.

Le jeu est construit en quatre sections : soit l'initialisation (TetrisInit), le démarrage (TetrisStart), le rafraîchissement des données (TetrisRefresh) et le la partie jeu (TetrisPlay). Cette structure est essentiel, car, à l'origine, je voulais que le jeu soit intégrable dans un environnement avec de la programmation événementielle.

La partie TetrisPlay contient le moteur de jeu. Elle contient un tableau BlkFormat mémorisant la forme de chacune des pièces du jeu, soit les coordonnées de chacune des 4 parties d'une pièces. Afin de facilité le travaille de repérage, les tableaux BlkLength et BlkHeight contiennent respectivement la largeur et la hauteur de chacune des pièces du jeu. Une fois qu'on connaît les pièces du jeu, on les mettra dans le tableau «Q.Tbl» allant contenir chacune des pièces occupés dans le jeu Tetris. On sait déjà que le tableau du jeu contient 10 colonnes et 20 lignes et que chaque pièces contient 4 emplacements. Au bout d'un certain temps spécifié par WaitRetrace, on descend la pièce jusqu'à ce qu'elle touche un emplacement dans le tableau. Le délai WaitRetrace n'est pas diminuer par cette procédure mais par la variable Q.Speed, étant une simple boucle allant diminuer au furent et à mesure que le niveau augmente. Lorsqu'elle touche un emplacement, on doit parcourir les 20 lignes et tester chacune des lignes si les 10 emplacements sont occupés et si oui, on élimine toutes les lignes concerné et en déplace vers le bas chacune des pièces résultants. S'il n'est pas possible de descendre une pièce et que la fonction UpdateDate retourne FALSE, la partie est terminé. Lorsqu'on élimine les lignes, on additionne également le ligne accumulé, indiqué par la variable Q._Bar, et à chaque plateau de 16 lignes (calculer avec SHR 4 plutôt que DIV 16, car avec une machine fonctionnant à 4,77 Mhz, 200 cycles d'horloge de plus sur une puce Intel 8088, ça paraissait beaucoup), on augmente le niveau.

A l'aide du code source Pascal suivant pour le Turbo Pascal, vous trouvez la réponse que vous souhaitez :

  1. Program Tetris;
  2.  
  3. Uses Crt;
  4.  
  5. Const
  6.  {Code de touche clavier renvoy‚e par ReadKey}
  7.  kbNoKey=0;{Pas de touche}
  8.  kbEsc=$011B;{Escape}
  9.  kbUp=$4800;{Up}
  10.  kbLeft=$4B00;{FlŠche de gauche (Left)}
  11.  kbKeypad5=$4CF0;{5 du bloc num‚rique}
  12.  kbRight=$4D00;{FlŠche de droite (Right)}
  13.  kbDn=$5000;{FlŠche du bas (Down)}
  14.  
  15. Type
  16.  TetrisGame=Record
  17.   Mode:(tmNone,tmStart,tmPlay,tmGameOver);
  18.   Level:Byte;
  19.   Score:LongInt;
  20.   _Bar,SLevel:Word;
  21.   Tbl:Array[0..20,0..9]of Boolean;
  22.   Form,_Move,X,Y,Sleep:Byte;
  23.   Touch,Ok:Boolean;
  24.   SleepDelay:Byte;
  25.   FBar:Word;
  26.   UpDate:Boolean;
  27.  End;
  28.  
  29. Function  TetrisInit(Var Q:TetrisGame):Boolean;Forward;
  30. Procedure TetrisStart(Var Q:TetrisGame);Forward;
  31. Procedure TetrisRefresh(Var Q:TetrisGame);Forward;
  32. Function  TetrisPlay(Var Q:TetrisGame):Word;Forward;
  33.  
  34. Const
  35.  HomeX=15;
  36.  HomeY=2;
  37.  
  38. Procedure WaitRetrace;Begin
  39.  Delay(1000 div 60);
  40. End;
  41.  
  42. Procedure MoveRight(Const Source;Var Dest;_Length:LongInt);Begin
  43.  Move(Source,Dest,_Length);
  44. End;
  45.  
  46. Procedure TextAttr(Attr:Byte);Begin
  47.  TextColor(Attr and $F);
  48.  TextBackground(Attr shr 4);
  49. End;
  50.  
  51. Procedure MoveText(X1,Y1,X2,Y2,X3,Y3:Byte);Begin
  52.  Window(X1,Y1,X2,Y2+1);
  53.  If(Y3>Y1)Then Begin
  54.   GotoXY(1,1);
  55.   InsLine;
  56.  End
  57.   Else
  58.  Begin
  59.   GotoXY(1,1);
  60.   DelLine;
  61.  End;
  62.  Window(1,1,40,25);
  63. End;
  64.  
  65. Procedure BarSpcHor(X1,Y,X2:Byte);Begin
  66.  Window(X1,Y,X2,Y);
  67.  ClrScr;
  68.  Window(1,1,40,25);
  69. End;
  70.  
  71. Function TetrisInit(Var Q:TetrisGame):Boolean;Begin
  72.  FillChar(Q,SizeOf(Q),0);
  73.  Q.Level:=1;
  74.  Q.Mode:=tmStart;
  75. End;
  76.  
  77. Procedure TetrisStart(Var Q:TetrisGame);
  78. Var
  79.  I:Byte;
  80. Begin
  81.  FillChar(Q.Tbl,SizeOf(Q.Tbl),0);
  82.  FillChar(Q.Tbl[20],SizeOf(Q.Tbl[20]),Byte(True));
  83.  Q.Score:=0;Q._Bar:=0;Q.SleepDelay:=25;Q.Level:=Q.SLevel;
  84.  For I:=0to(Q.SLevel)do If Q.SleepDelay>6Then Dec(Q.SleepDelay,2);
  85.  Q.FBar:=Q.Level shl 4;
  86.  Q.Mode:=tmStart;
  87. End;
  88.  
  89. Procedure TetrisRefresh(Var Q:TetrisGame);
  90. Var
  91.  I,J:Byte;
  92. Begin
  93.  TextBackground(1+Q.Level);
  94.  ClrScr;
  95.  GotoXY(3,2);Write('Niveau:');
  96.  GotoXY(4,3);Write(Q.Level);
  97.  GotoXY(3,5);Write('Pointage:');
  98.  GotoXY(4,6);Write('0');
  99.  GotoXY(3,8);Write('Ligne:');
  100.  GotoXY(4,9);Write(Q._Bar);
  101.  Window(HomeX,HomeY,HomeX+9,HomeY+19);
  102.  TextBackground(Black);
  103.  ClrScr;
  104.  Window(1,1,40,25);
  105.  If(Q.Mode)in[tmPlay,tmGameOver]Then Begin
  106.   For J:=0to 19do For I:=0to 9do If Q.Tbl[J,I]Then Begin
  107.    GotoXY(HomeX+I,HomeY+J);Write('þ');
  108.   End;
  109.  End;
  110. End;
  111.  
  112. Function TetrisPlay(Var Q:TetrisGame):Word;Label _Exit;Const
  113.       BlkHeight:Array[0..6,0..3]of Byte=(
  114.        (4,1,4,1), { Barre }
  115.        (2,2,2,2), { BoŒte }
  116.        (3,2,3,2), { V }
  117.        (3,2,3,2), { L gauche }
  118.        (3,2,3,2), { L droite }
  119.        (3,2,3,2), { Serpent romain }
  120.        (3,2,3,2));{ Serpent arabe }
  121.       BlkLength:Array[0..6,0..3]of Byte=( {Largeur des objets:}
  122.        (1,4,1,4), { Barre }
  123.        (2,2,2,2), { BoŒte }
  124.        (2,3,2,3), { V }
  125.        (2,3,2,3), { L gauche }
  126.        (2,3,2,3), { L droite }
  127.        (2,3,2,3), { Serpent romain }
  128.        (2,3,2,3));{ Serpent arabe }
  129.       BlkFormat:Array[0..6,0..3,0..3]of Record X,Y:Byte;End=(
  130.        (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),   { þþþþ }
  131.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0)),
  132.         ((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),
  133.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0))),
  134.        (((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),   { þþ }
  135.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),   { þþ }
  136.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),
  137.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1))),
  138.        (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),   { þþþ }
  139.         ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:2;Y:1)),   { þ }
  140.         ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
  141.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:1;Y:1))),
  142.        (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:1;Y:2)),
  143.         ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:2;Y:0)),   { þ }
  144.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:1;Y:2)),   { þ }
  145.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:0;Y:1))),  { þþ }
  146.        (((X:1;Y:0),(X:1;Y:1),(X:1;Y:2),(X:0;Y:2)),
  147.         ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:0;Y:0)),   { þ }
  148.         ((X:1;Y:0),(X:0;Y:0),(X:0;Y:1),(X:0;Y:2)),   { þ }
  149.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:2;Y:1))),  { þþ }
  150.        (((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
  151.         ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1)),
  152.         ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
  153.         ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1))),
  154.        (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
  155.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)),
  156.         ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),   {þþ }
  157.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)))); { þþ }
  158. Var
  159.  I,J,H,XT:Byte;
  160.  XJ,YJ,K:Word;
  161.  Touch,Ok,NoAction:Boolean;
  162.  
  163.  Procedure PutForm(Clr:Boolean);
  164.  Var
  165.   Chr:Char;
  166.   I,Attr,X,Y:Byte;
  167.  Begin
  168.   X:=HomeX+Q.X;
  169.   Y:=HomeY+Q.Y;
  170.   If(Clr)Then Begin
  171.    Chr:=' ';Attr:=7;
  172.   End
  173.    Else
  174.   Begin
  175.    Chr:='þ';Attr:=$71+Q.Form;
  176.   End;
  177.   For I:=0to 3do Begin
  178.    GotoXY(HomeX+Q.X+BlkFormat[Q.Form,Q._Move,I].X,
  179.                             HomeY+Q.Y+BlkFormat[Q.Form,Q._Move,I].Y);
  180.    TextAttr(Attr);
  181.    Write(Chr);
  182.    TextAttr(7);
  183.   End;
  184.  End;
  185.  
  186.  Procedure Init;Begin
  187.   Q.Form:=Random(6);
  188.   If Q.Form=5Then Inc(Q.Form,Random(2));
  189.   Q.X:=5;Q.Y:=0;
  190.   Q._Move:=0;Q.Sleep:=0;
  191.   PutForm(False);
  192.  End;
  193.  
  194.  Function UpDateData:Boolean;
  195.  Var
  196.   H,I,J,JK:Byte;
  197.   Bonus:Byte;
  198.   LnChk:Boolean;
  199.  Begin
  200.   UpDateData:=True;Q.Sleep:=0;
  201.   PutForm(False);
  202.   Touch:=False;Ok:=False;
  203.   PutForm(True);
  204.   Inc(Q.Y);
  205.   For I:=0to 3do Begin
  206.    Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X];
  207.   End;
  208.   If(Touch)Then Dec(Q.Y);
  209.   PutForm(False);
  210.   If(Touch)Then Begin
  211.    While(Q.Sleep>Q.SleepDelay)do Dec(Q.Sleep);
  212.    Q.Sleep:=0;Ok:=True;
  213.    For I:=0to 3do Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X]:=True;
  214.    If Q.Level>7Then Begin
  215.     Inc(Q.Score,LongInt(5)*Q.Level);
  216.     GotoXY(4,6);Write(Q.Score);
  217.    End;
  218.    Bonus:=0;
  219.    For J:=0to 19do Begin
  220.     Touch:=True;
  221.     For I:=0to 9do Touch:=Touch and Q.Tbl[J,I];
  222.     If(Touch)Then Inc(Bonus);
  223.    End;
  224.    If Bonus>0Then Dec(Bonus);
  225.    Touch:=False;
  226.    For JK:=0to 7do Begin
  227.     For J:=0to 19do Begin
  228.      LnChk:=True;
  229.      For I:=0to 9do LnChk:=LnChk and Q.Tbl[J,I];
  230.      If(LnChk)Then Begin
  231.       If Not(Touch)Then Begin
  232.        Touch:=True;
  233.       End;
  234.       If JK and 1=0Then TextAttr($FF)
  235.                    Else TextAttr(7);
  236.       BarSpcHor(HomeX,HomeY+J,HomeX+9);
  237.      End;
  238.     End;
  239.     WaitRetrace;WaitRetrace;WaitRetrace;
  240.    End;
  241.    For J:=0to 19do Begin
  242.     Touch:=True;
  243.     For I:=0to 9do Touch:=Touch and Q.Tbl[J,I];
  244.     If(Touch)Then Begin
  245.      MoveRight(Q.Tbl[0,0],Q.Tbl[1,0],10*J);
  246.      FillChar(Q.Tbl[0,0],10,0);
  247.      MoveText(HomeX,HomeY,HomeX+9,HomeY+J-1,HomeX,HomeY+1);
  248.      Inc(Q.Score,LongInt(5)+(Bonus*4)*(Q.Level+1)+10*Q.Level); Inc(Q._Bar);
  249.      GotoXY(4,6);Write(Q.Score);
  250.      GotoXY(4,9);Write(Q._Bar);
  251.      I:=(Q._Bar+Q.FBar)shr 4;
  252.      If(Q.Level<>I)Then Begin
  253.       Q.Level:=I;
  254.       GotoXY(4,3);Write(Q.Level+1);
  255.       If Q.SleepDelay>6Then Dec(Q.SleepDelay,2);
  256.      End;
  257.     End;
  258.    End;
  259.    If Q.Y<=1Then Begin
  260.     UpDateData:=False;
  261.     Exit;
  262.    End;
  263.    Init;
  264.   End;
  265.  End;
  266.  
  267.  Function GameOver:Word;Begin
  268.   GotoXY(10,7);Write('Partie Terminer');
  269.   If(Q.UpDate)Then Begin
  270.    Q.UpDate:=False;
  271.   End;
  272.   GameOver:=kbEsc;
  273.  End;
  274.  
  275. Begin
  276.  TextMode(CO40);
  277.  TetrisRefresh(Q);
  278.  K:=0;
  279.  Repeat
  280.   Case(Q.Mode)of
  281.    tmStart:Begin
  282.     TetrisStart(Q);
  283.     TetrisRefresh(Q);
  284.     Init;
  285.     Q.Mode:=tmPlay;Q.UpDate:=True;
  286.    End;
  287.    tmPlay:Repeat
  288.     Begin
  289.      Repeat
  290.       If(Q.Sleep>Q.SleepDelay)Then If Not(UpDateData)Then Begin
  291.        Q.Mode:=tmGameOver;
  292.        Goto _Exit;
  293.       End;
  294.       WaitRetrace;
  295.       Inc(Q.Sleep);
  296.      Until KeyPressed;
  297.      K:=Byte(ReadKey);
  298.      If K=0Then K:=K or (Byte(ReadKey)shl 8);
  299.     End;
  300.     If Chr(K)='2'Then K:=kbDn;
  301.     If Chr(K)='4'Then K:=kbLeft;
  302.     If Chr(K)='6'Then K:=kbRight;
  303.     NoAction:=False;
  304.     Case(K)of
  305.      kbLeft:If Q.X>0Then Begin
  306.       Touch:=False;
  307.       For I:=0to 3do Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X-1];
  308.       If Not(Touch)Then Begin
  309.        PutForm(True);
  310.        Dec(Q.X);
  311.        PutForm(False);
  312.       End;
  313.      End;
  314.      kbRight:If Q.X+BlkLength[Q.Form,Q._Move]-1<9Then Begin
  315.       Touch:=False;
  316.       For I:=0to 3do Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X+1];
  317.       If Not(Touch)Then Begin
  318.        PutForm(True);
  319.        Inc(Q.X);
  320.        PutForm(False);
  321.       End;
  322.      End;
  323.      kbDn:While(True)do Begin
  324.       If Not(UpDateData)Then Begin
  325.        Q.Mode:=tmGameOver;
  326.        Goto _Exit;
  327.       End;
  328.       If(Ok)Then Break;
  329.      End;
  330.      Else NoAction:=True;
  331.     End;
  332.     If(NoAction)Then Begin
  333.      If(K=kbKeyPad5)or(Char(K)in[' ','5'])Then Begin
  334.       Touch:=False;
  335.       For I:=0to 3do Begin
  336.        XT:=Q.X+BlkFormat[Q.Form,(Q._Move+1)and 3,I].X; Touch:=Touch or(XT>9);
  337.        Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
  338.       End;
  339.       If Not(Touch)Then Begin
  340.        PutForm(True);
  341.        Q._Move:=(Q._Move+1)and 3;
  342.        PutForm(False)
  343.       End
  344.        Else
  345.       Begin
  346.        Touch:=False;
  347.        For I:=0to 3do Begin
  348.         XT:=Q.X;
  349.         If XT>0Then Dec(XT);
  350.         Inc(XT,BlkFormat[Q.Form,(Q._Move+1)and 3,I].X); Touch:=Touch or(XT>9);
  351.         Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
  352.        End;
  353.        If Not(Touch)Then Begin
  354.         PutForm(True);
  355.         Dec(Q.X); Q._Move:=(Q._Move+1)and 3;
  356.         PutForm(False);
  357.        End;
  358.       End;
  359.      End
  360.       Else
  361.      Break;
  362.     End;
  363.    Until(K=kbEsc)or(Chr(K)='Q');
  364.    tmGameOver:K:=GameOver;
  365.   End;
  366. _Exit:
  367.   If K<>0Then Break;
  368.  Until False;
  369.  TetrisPlay:=K;
  370. End;
  371.  
  372. Var
  373.  Game:TetrisGame;
  374.  
  375. BEGIN
  376.  TetrisInit(Game);
  377.  TetrisPlay(Game);
  378. END.

Code source

Voici le code source du jeu sur GitHub :

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


Dernière mise à jour : Dimanche, le 17 janvier 2016