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 :
- Program Tetris;
-
- Uses Crt;
-
- Const
- {Code de touche clavier renvoy‚e par ReadKey}
- kbNoKey=0;{Pas de touche}
- kbEsc=$011B;{Escape}
- kbUp=$4800;{Up}
- kbLeft=$4B00;{FlŠche de gauche (Left)}
- kbKeypad5=$4CF0;{5 du bloc num‚rique}
- kbRight=$4D00;{FlŠche de droite (Right)}
- kbDn=$5000;{FlŠche du bas (Down)}
-
- Type
- TetrisGame=Record
- Mode:(tmNone,tmStart,tmPlay,tmGameOver);
- Level:Byte;
- Score:LongInt;
- _Bar,SLevel:Word;
- Tbl:Array[0..20,0..9]of Boolean;
- Form,_Move,X,Y,Sleep:Byte;
- Touch,Ok:Boolean;
- SleepDelay:Byte;
- FBar:Word;
- UpDate:Boolean;
- End;
-
- Function TetrisInit(Var Q:TetrisGame):Boolean;Forward;
- Procedure TetrisStart(Var Q:TetrisGame);Forward;
- Procedure TetrisRefresh(Var Q:TetrisGame);Forward;
- Function TetrisPlay(Var Q:TetrisGame):Word;Forward;
-
- Const
- HomeX=15;
- HomeY=2;
-
- Procedure WaitRetrace;Begin
- Delay(1000 div 60);
- End;
-
- Procedure MoveRight(Const Source;Var Dest;_Length:LongInt);Begin
- Move(Source,Dest,_Length);
- End;
-
- Procedure TextAttr(Attr:Byte);Begin
- TextColor(Attr and $F);
- TextBackground(Attr shr 4);
- End;
-
- Procedure MoveText(X1,Y1,X2,Y2,X3,Y3:Byte);Begin
- Window(X1,Y1,X2,Y2+1);
- If(Y3>Y1)Then Begin
- GotoXY(1,1);
- InsLine;
- End
- Else
- Begin
- GotoXY(1,1);
- DelLine;
- End;
- Window(1,1,40,25);
- End;
-
- Procedure BarSpcHor(X1,Y,X2:Byte);Begin
- Window(X1,Y,X2,Y);
- ClrScr;
- Window(1,1,40,25);
- End;
-
- Function TetrisInit(Var Q:TetrisGame):Boolean;Begin
- FillChar(Q,SizeOf(Q),0);
- Q.Level:=1;
- Q.Mode:=tmStart;
- End;
-
- Procedure TetrisStart(Var Q:TetrisGame);
- Var
- I:Byte;
- Begin
- FillChar(Q.Tbl,SizeOf(Q.Tbl),0);
- FillChar(Q.Tbl[20],SizeOf(Q.Tbl[20]),Byte(True));
- Q.Score:=0;Q._Bar:=0;Q.SleepDelay:=25;Q.Level:=Q.SLevel;
- For I:=0to(Q.SLevel)do If Q.SleepDelay>6Then Dec(Q.SleepDelay,2);
- Q.FBar:=Q.Level shl 4;
- Q.Mode:=tmStart;
- End;
-
- Procedure TetrisRefresh(Var Q:TetrisGame);
- Var
- I,J:Byte;
- Begin
- TextBackground(1+Q.Level);
- ClrScr;
- GotoXY(3,2);Write('Niveau:');
- GotoXY(4,3);Write(Q.Level);
- GotoXY(3,5);Write('Pointage:');
- GotoXY(4,6);Write('0');
- GotoXY(3,8);Write('Ligne:');
- GotoXY(4,9);Write(Q._Bar);
- Window(HomeX,HomeY,HomeX+9,HomeY+19);
- TextBackground(Black);
- ClrScr;
- Window(1,1,40,25);
- If(Q.Mode)in[tmPlay,tmGameOver]Then Begin
- For J:=0to 19do For I:=0to 9do If Q.Tbl[J,I]Then Begin
- GotoXY(HomeX+I,HomeY+J);Write('þ');
- End;
- End;
- End;
-
- Function TetrisPlay(Var Q:TetrisGame):Word;Label _Exit;Const
- BlkHeight:Array[0..6,0..3]of Byte=(
- (4,1,4,1), { Barre }
- (2,2,2,2), { BoŒte }
- (3,2,3,2), { V }
- (3,2,3,2), { L gauche }
- (3,2,3,2), { L droite }
- (3,2,3,2), { Serpent romain }
- (3,2,3,2));{ Serpent arabe }
- BlkLength:Array[0..6,0..3]of Byte=( {Largeur des objets:}
- (1,4,1,4), { Barre }
- (2,2,2,2), { BoŒte }
- (2,3,2,3), { V }
- (2,3,2,3), { L gauche }
- (2,3,2,3), { L droite }
- (2,3,2,3), { Serpent romain }
- (2,3,2,3));{ Serpent arabe }
- BlkFormat:Array[0..6,0..3,0..3]of Record X,Y:Byte;End=(
- (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)), { þþþþ }
- ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0)),
- ((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),
- ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0))),
- (((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)), { þþ }
- ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)), { þþ }
- ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),
- ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1))),
- (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)), { þþþ }
- ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:2;Y:1)), { þ }
- ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
- ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:1;Y:1))),
- (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:1;Y:2)),
- ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:2;Y:0)), { þ }
- ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:1;Y:2)), { þ }
- ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:0;Y:1))), { þþ }
- (((X:1;Y:0),(X:1;Y:1),(X:1;Y:2),(X:0;Y:2)),
- ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:0;Y:0)), { þ }
- ((X:1;Y:0),(X:0;Y:0),(X:0;Y:1),(X:0;Y:2)), { þ }
- ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:2;Y:1))), { þþ }
- (((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
- ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1)),
- ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),
- ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1))),
- (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),
- ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)),
- ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)), {þþ }
- ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)))); { þþ }
- Var
- I,J,H,XT:Byte;
- XJ,YJ,K:Word;
- Touch,Ok,NoAction:Boolean;
-
- Procedure PutForm(Clr:Boolean);
- Var
- Chr:Char;
- I,Attr,X,Y:Byte;
- Begin
- X:=HomeX+Q.X;
- Y:=HomeY+Q.Y;
- If(Clr)Then Begin
- Chr:=' ';Attr:=7;
- End
- Else
- Begin
- Chr:='þ';Attr:=$71+Q.Form;
- End;
- For I:=0to 3do Begin
- GotoXY(HomeX+Q.X+BlkFormat[Q.Form,Q._Move,I].X,
- HomeY+Q.Y+BlkFormat[Q.Form,Q._Move,I].Y);
- TextAttr(Attr);
- Write(Chr);
- TextAttr(7);
- End;
- End;
-
- Procedure Init;Begin
- Q.Form:=Random(6);
- If Q.Form=5Then Inc(Q.Form,Random(2));
- Q.X:=5;Q.Y:=0;
- Q._Move:=0;Q.Sleep:=0;
- PutForm(False);
- End;
-
- Function UpDateData:Boolean;
- Var
- H,I,J,JK:Byte;
- Bonus:Byte;
- LnChk:Boolean;
- Begin
- UpDateData:=True;Q.Sleep:=0;
- PutForm(False);
- Touch:=False;Ok:=False;
- PutForm(True);
- Inc(Q.Y);
- For I:=0to 3do Begin
- Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X];
- End;
- If(Touch)Then Dec(Q.Y);
- PutForm(False);
- If(Touch)Then Begin
- While(Q.Sleep>Q.SleepDelay)do Dec(Q.Sleep);
- Q.Sleep:=0;Ok:=True;
- 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;
- If Q.Level>7Then Begin
- Inc(Q.Score,LongInt(5)*Q.Level);
- GotoXY(4,6);Write(Q.Score);
- End;
- Bonus:=0;
- For J:=0to 19do Begin
- Touch:=True;
- For I:=0to 9do Touch:=Touch and Q.Tbl[J,I];
- If(Touch)Then Inc(Bonus);
- End;
- If Bonus>0Then Dec(Bonus);
- Touch:=False;
- For JK:=0to 7do Begin
- For J:=0to 19do Begin
- LnChk:=True;
- For I:=0to 9do LnChk:=LnChk and Q.Tbl[J,I];
- If(LnChk)Then Begin
- If Not(Touch)Then Begin
- Touch:=True;
- End;
- If JK and 1=0Then TextAttr($FF)
- Else TextAttr(7);
- BarSpcHor(HomeX,HomeY+J,HomeX+9);
- End;
- End;
- WaitRetrace;WaitRetrace;WaitRetrace;
- End;
- For J:=0to 19do Begin
- Touch:=True;
- For I:=0to 9do Touch:=Touch and Q.Tbl[J,I];
- If(Touch)Then Begin
- MoveRight(Q.Tbl[0,0],Q.Tbl[1,0],10*J);
- FillChar(Q.Tbl[0,0],10,0);
- MoveText(HomeX,HomeY,HomeX+9,HomeY+J-1,HomeX,HomeY+1);
- Inc(Q.Score,LongInt(5)+(Bonus*4)*(Q.Level+1)+10*Q.Level); Inc(Q._Bar);
- GotoXY(4,6);Write(Q.Score);
- GotoXY(4,9);Write(Q._Bar);
- I:=(Q._Bar+Q.FBar)shr 4;
- If(Q.Level<>I)Then Begin
- Q.Level:=I;
- GotoXY(4,3);Write(Q.Level+1);
- If Q.SleepDelay>6Then Dec(Q.SleepDelay,2);
- End;
- End;
- End;
- If Q.Y<=1Then Begin
- UpDateData:=False;
- Exit;
- End;
- Init;
- End;
- End;
-
- Function GameOver:Word;Begin
- GotoXY(10,7);Write('Partie Terminer');
- If(Q.UpDate)Then Begin
- Q.UpDate:=False;
- End;
- GameOver:=kbEsc;
- End;
-
- Begin
- TextMode(CO40);
- TetrisRefresh(Q);
- K:=0;
- Repeat
- Case(Q.Mode)of
- tmStart:Begin
- TetrisStart(Q);
- TetrisRefresh(Q);
- Init;
- Q.Mode:=tmPlay;Q.UpDate:=True;
- End;
- tmPlay:Repeat
- Begin
- Repeat
- If(Q.Sleep>Q.SleepDelay)Then If Not(UpDateData)Then Begin
- Q.Mode:=tmGameOver;
- Goto _Exit;
- End;
- WaitRetrace;
- Inc(Q.Sleep);
- Until KeyPressed;
- K:=Byte(ReadKey);
- If K=0Then K:=K or (Byte(ReadKey)shl 8);
- End;
- If Chr(K)='2'Then K:=kbDn;
- If Chr(K)='4'Then K:=kbLeft;
- If Chr(K)='6'Then K:=kbRight;
- NoAction:=False;
- Case(K)of
- kbLeft:If Q.X>0Then Begin
- Touch:=False;
- 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];
- If Not(Touch)Then Begin
- PutForm(True);
- Dec(Q.X);
- PutForm(False);
- End;
- End;
- kbRight:If Q.X+BlkLength[Q.Form,Q._Move]-1<9Then Begin
- Touch:=False;
- 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];
- If Not(Touch)Then Begin
- PutForm(True);
- Inc(Q.X);
- PutForm(False);
- End;
- End;
- kbDn:While(True)do Begin
- If Not(UpDateData)Then Begin
- Q.Mode:=tmGameOver;
- Goto _Exit;
- End;
- If(Ok)Then Break;
- End;
- Else NoAction:=True;
- End;
- If(NoAction)Then Begin
- If(K=kbKeyPad5)or(Char(K)in[' ','5'])Then Begin
- Touch:=False;
- For I:=0to 3do Begin
- XT:=Q.X+BlkFormat[Q.Form,(Q._Move+1)and 3,I].X; Touch:=Touch or(XT>9);
- Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
- End;
- If Not(Touch)Then Begin
- PutForm(True);
- Q._Move:=(Q._Move+1)and 3;
- PutForm(False)
- End
- Else
- Begin
- Touch:=False;
- For I:=0to 3do Begin
- XT:=Q.X;
- If XT>0Then Dec(XT);
- Inc(XT,BlkFormat[Q.Form,(Q._Move+1)and 3,I].X); Touch:=Touch or(XT>9);
- Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
- End;
- If Not(Touch)Then Begin
- PutForm(True);
- Dec(Q.X); Q._Move:=(Q._Move+1)and 3;
- PutForm(False);
- End;
- End;
- End
- Else
- Break;
- End;
- Until(K=kbEsc)or(Chr(K)='Q');
- tmGameOver:K:=GameOver;
- End;
- _Exit:
- If K<>0Then Break;
- Until False;
- TetrisPlay:=K;
- End;
-
- Var
- Game:TetrisGame;
-
- BEGIN
- TetrisInit(Game);
- TetrisPlay(Game);
- 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 |