Section courante

A propos

Section administrative du site

Tetris

Présentation

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 disparaitre des lignes. Voici la version que j'avais inclus dans le MonsterBook et que j'ai adapté pour Delphi et le «Win32».


Code source Delphi

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

  1. Program TetrisConsole;
  2.  
  3. {$APPTYPE CONSOLE}
  4. Uses Windows,SysUtils;
  5.  
  6. Const
  7.  {Code de touche clavier renvoy‚e par ReadKey}
  8.  kbNoKey=0;{Pas de touche}
  9.  kbEsc=$011B;{Escape}
  10.  kbUp=$4800;{Up}
  11.  kbLeft=$0025;{FlŠche de gauche (Left)}
  12.  kbKeypadLeft=$0064;{FlŠche de gauche (Left)}
  13.  kbKeypad5NumLock=$0065;{5 du bloc num‚rique}
  14.  kbKeypad5=$000C;{5 du bloc num‚rique}
  15.  kbKeypadRight=$0066;{FlŠche de droite (Right)}
  16.  kbRight=$0027;{FlŠche de droite (Right)}
  17.  kbDn=$0028;{FlŠche du bas (Down)}
  18.  kbKeypadDn=$0062;{FlŠche du bas (Down)}
  19.  
  20.  Black=0;
  21.  
  22.  
  23. Type
  24.  TetrisGame=Record
  25.   Mode:(tmNone,tmStart,tmPlay,tmGameOver);
  26.   Level:Byte;
  27.   Score:LongInt;
  28.   Bar,SLevel:Word;
  29.   Tbl:Array[0..20,0..9]of Boolean; 
  30.   Form,_Move,X,Y,Sleep:Byte;
  31.   Touch,Ok:Boolean;
  32.   SleepDelay:Byte;
  33.   FBar:Word;
  34.   UpDate:Boolean;
  35.  End;
  36.  
  37. Function  TetrisInit(Var Q:TetrisGame):Boolean;Forward;
  38. Procedure TetrisStart(Var Q:TetrisGame);Forward;
  39. Procedure TetrisRefresh(Var Q:TetrisGame);Forward;
  40. Function  TetrisPlay(Var Q:TetrisGame):Word;Forward;
  41.  
  42. Const
  43.  HomeX=15;
  44.  HomeY=2;
  45.  CurrX1:Byte=0;
  46.  CurrY1:Byte=0;
  47.  CurrX2:Byte=79;
  48.  CurrY2:Byte=24;
  49.  
  50. Procedure GotoXY(X,Y:Byte);
  51. Var
  52.  _Pos:TCoord;
  53. Begin
  54.  _Pos.X:=X;
  55.  _Pos.Y:=Y;
  56.  SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE),_Pos);
  57. End;
  58.  
  59. Procedure TextAttr(Attr:Byte);Begin
  60.  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),Attr);
  61. End;
  62.  
  63. Procedure TextBackground(Color:Byte);
  64. Var
  65.  Info:TConsoleScreenBufferInfo;
  66. Begin
  67.  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),Info);
  68.  TextAttr((Color shl 4)+(Info.wAttributes and $F));
  69. End;
  70.  
  71. Procedure TextForeground(Color:Byte);
  72. Var
  73.  Info:TConsoleScreenBufferInfo;
  74. Begin
  75.  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),Info);
  76.  TextAttr((Info.wAttributes shl 4)+(Color and $F));
  77. End;
  78.  
  79. Procedure Window(X1,Y1,X2,Y2:Byte);Begin
  80.  CurrX1:=X1;
  81.  CurrY1:=Y1;
  82.  CurrX2:=X2;
  83.  CurrY2:=Y2;
  84. End;
  85.  
  86. Procedure ClrScr;
  87. Var
  88.  _Pos:TCoord;
  89.  Console:THandle;
  90.  Info:TConsoleScreenBufferInfo;
  91.  Output:DWORD;
  92.  J:Word;
  93. Begin
  94.  Console:=GetStdHandle(STD_OUTPUT_HANDLE);
  95.  GetConsoleScreenBufferInfo(Console,Info);
  96.  FillChar(_Pos,SizeOf(_Pos),0);
  97.  GotoXY(0,0);
  98.  For J:=CurrY1 to CurrY2 do Begin
  99.   _Pos.X:=CurrX1;
  100.   _Pos.Y:=J;
  101.   FillConsoleOutputCharacter(Console,#32 ,CurrX2-CurrX1+1,_Pos,Output);
  102.   FillConsoleOutputAttribute(Console,Info.wAttributes,CurrX2-CurrX1+1,_Pos,Output);
  103.  End;
  104.  GotoXY(0,0);
  105. End;
  106.  
  107. Function KeyPressed:Boolean;
  108. Var
  109.  Nbr:DWORD;
  110.  Q:TInputRecord;
  111. Begin
  112.  Nbr:=0;
  113.  PeekConsoleInput(GetStdHandle(STD_INPUT_HANDLE),Q,1,Nbr);
  114.  KeyPressed:=Nbr>0;
  115. End;
  116.  
  117. Function ReadKey:Char;
  118. Var
  119.  Console:THandle;
  120.  K:DWORD;
  121.  Q:TInputRecord;
  122. Begin
  123.  ReadKey:=#0 ;
  124.  K:=0;
  125.  Console:=GetStdHandle(STD_INPUT_HANDLE);
  126.  PeekConsoleInput(Console,Q,1,K);
  127.  If K>0Then Begin
  128.   ReadConsoleInput(Console,Q,1,K);
  129.   If((Q.EventType=1)and(Q.KeyEvent.bKeyDown))Then Begin
  130.    ReadKey:=Char(Q.KeyEvent.wVirtualKeyCode);
  131.   End;
  132.  End;
  133. End;
  134.  
  135. Procedure WaitRetrace;Begin
  136.  Sleep(1000 div 60);
  137. End;
  138.  
  139. Procedure MoveRight(Const Source;Var Dest;_Length:LongInt);Begin
  140.  Move(Source,Dest,_Length);
  141. End;
  142.  
  143. Procedure MoveText(X1,Y1,X2,Y2,X3,Y3:Byte);
  144. Var
  145.  Console:THandle;
  146.  Info:TConsoleScreenBufferInfo;
  147.  lpScrollRectangle,lpClipRectangle:TSmallRect;
  148.  dwDestinationOrigin:TCoord;
  149.  lpFill:TCharInfo;
  150. Begin
  151.  Console:=GetStdHandle(STD_OUTPUT_HANDLE);
  152.  GetConsoleScreenBufferInfo(Console,Info);
  153.  lpScrollRectangle.Left:=X1;
  154.  lpScrollRectangle.Top:=Y1;
  155.  lpScrollRectangle.Right:=X2;
  156.  lpScrollRectangle.Bottom:=Y2+(Y3-Y1);
  157.  lpClipRectangle:=lpScrollRectangle;
  158.  Dec(lpScrollRectangle.Bottom);
  159.  dwDestinationOrigin.X:=lpScrollRectangle.Left;
  160.  dwDestinationOrigin.Y:=lpScrollRectangle.Top + (Y3-Y1);
  161.  lpFill.UnicodeChar:=' ';
  162.  lpFill.Attributes:=Info.wAttributes;
  163.  ScrollConsoleScreenBuffer(Console,lpScrollRectangle,@lpClipRectangle,dwDestinationOrigin,lpFill);
  164. End;
  165.  
  166. Procedure BarSpcHor(X1,Y,X2:Byte);Begin
  167.  Window(X1,Y,X2,Y);
  168.  ClrScr;
  169.  Window(1,1,40,25);
  170. End;
  171.  
  172. Function TetrisInit(Var Q:TetrisGame):Boolean;Begin
  173.  FillChar(Q,SizeOf(Q),0);
  174.  Q.Level:=1;
  175.  Q.Mode:=tmStart;
  176. End;
  177.  
  178. Procedure TetrisStart(Var Q:TetrisGame); 
  179. Var 
  180.  I:Byte;
  181. Begin 
  182.  FillChar(Q.Tbl,SizeOf(Q.Tbl),0); 
  183.  FillChar(Q.Tbl[20],SizeOf(Q.Tbl[20]),Byte(True)); 
  184.  Q.Score:=0;Q.Bar:=0;Q.SleepDelay:=25;Q.Level:=Q.SLevel;
  185.  For I:=0to(Q.SLevel)do If Q.SleepDelay>6Then Dec(Q.SleepDelay,2); 
  186.  Q.FBar:=Q.Level shl 4; 
  187.  Q.Mode:=tmStart; 
  188. End;
  189.  
  190. Procedure TetrisRefresh(Var Q:TetrisGame);
  191. Var
  192.  I,J:Byte;
  193. Begin
  194.  TextBackground(1+Q.Level);
  195.  ClrScr;
  196.  GotoXY(3,2);Write('Niveau:');
  197.  GotoXY(4,3);Write(Q.Level);
  198.  GotoXY(3,5);Write('Pointage:');
  199.  GotoXY(4,6);Write('0');
  200.  GotoXY(3,8);Write('Ligne:');
  201.  GotoXY(4,9);Write(Q.Bar);
  202.  Window(HomeX,HomeY,HomeX+9,HomeY+19);
  203.  TextBackground(Black);
  204.  ClrScr;
  205.  Window(1,1,40,25);
  206.  If(Q.Mode)in[tmPlay,tmGameOver]Then Begin
  207.   For J:=0to 19do For I:=0to 9do If Q.Tbl[J,I]Then Begin
  208.    GotoXY(HomeX+I,HomeY+J);Write('þ');
  209.   End;
  210.  End;
  211. End;
  212.  
  213. Function TetrisPlay(Var Q:TetrisGame):Word;Label _Exit;Const
  214.       BlkHeight:Array[0..6,0..3]of Byte=( 
  215.        (4,1,4,1), { Barre } 
  216.        (2,2,2,2), { BoŒte } 
  217.        (3,2,3,2), { V } 
  218.        (3,2,3,2), { L gauche }
  219.        (3,2,3,2), { L droite } 
  220.        (3,2,3,2), { Serpent romain } 
  221.        (3,2,3,2));{ Serpent arabe } 
  222.       BlkLength:Array[0..6,0..3]of Byte=( {Largeur des objets:} 
  223.        (1,4,1,4), { Barre } 
  224.        (2,2,2,2), { BoŒte } 
  225.        (2,3,2,3), { V } 
  226.        (2,3,2,3), { L gauche } 
  227.        (2,3,2,3), { L droite } 
  228.        (2,3,2,3), { Serpent romain }
  229.        (2,3,2,3));{ Serpent arabe } 
  230.       BlkFormat:Array[0..6,0..3,0..3]of Record X,Y:Byte;End=( 
  231.        (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)),   { þþþþ } 
  232.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0)),
  233.         ((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:0;Y:3)), 
  234.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:3;Y:0))), 
  235.        (((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),   { þþ } 
  236.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),   { þþ } 
  237.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1)),
  238.         ((X:0;Y:0),(X:1;Y:0),(X:0;Y:1),(X:1;Y:1))), 
  239.        (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)),   { þþþ } 
  240.         ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:2;Y:1)),   { þ } 
  241.         ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)), 
  242.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:1;Y:1))),
  243.        (((X:0;Y:0),(X:0;Y:1),(X:0;Y:2),(X:1;Y:2)), 
  244.         ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:2;Y:0)),   { þ } 
  245.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:1;Y:2)),   { þ } 
  246.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:0;Y:1))),  { þþ } 
  247.        (((X:1;Y:0),(X:1;Y:1),(X:1;Y:2),(X:0;Y:2)), 
  248.         ((X:0;Y:1),(X:1;Y:1),(X:2;Y:1),(X:0;Y:0)),   { þ } 
  249.         ((X:1;Y:0),(X:0;Y:0),(X:0;Y:1),(X:0;Y:2)),   { þ } 
  250.         ((X:0;Y:0),(X:1;Y:0),(X:2;Y:0),(X:2;Y:1))),  { þþ } 
  251.        (((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)), 
  252.         ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1)), 
  253.         ((X:0;Y:0),(X:0;Y:1),(X:1;Y:1),(X:1;Y:2)), 
  254.         ((X:1;Y:0),(X:2;Y:0),(X:0;Y:1),(X:1;Y:1))), 
  255.        (((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)), 
  256.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)),
  257.         ((X:1;Y:0),(X:0;Y:1),(X:1;Y:1),(X:0;Y:2)),   {þþ } 
  258.         ((X:0;Y:0),(X:1;Y:0),(X:1;Y:1),(X:2;Y:1)))); { þþ }
  259. Var 
  260.  I,J,H,XT:Byte; 
  261.  XJ,YJ,K:Word;
  262.  Touch,Ok,NoAction:Boolean; 
  263.  
  264.  Procedure PutForm(Clr:Boolean); 
  265.  Var 
  266.   Chr:Char;
  267.   I,Attr,X,Y:Byte; 
  268.  Begin 
  269.   X:=HomeX+Q.X;
  270.   Y:=HomeY+Q.Y;
  271.   If(Clr)Then Begin 
  272.    Chr:=' ';Attr:=7; 
  273.   End 
  274.    Else 
  275.   Begin 
  276.    Chr:='þ';Attr:=$71+Q.Form; 
  277.   End; 
  278.   For I:=0to 3do Begin 
  279.    GotoXY(HomeX+Q.X+BlkFormat[Q.Form,Q._Move,I].X,
  280.                             HomeY+Q.Y+BlkFormat[Q.Form,Q._Move,I].Y);
  281.    TextAttr(Attr); 
  282.    Write(Chr); 
  283.    TextAttr(7); 
  284.   End; 
  285.  End;
  286.  
  287.  Procedure Init;Begin 
  288.   Q.Form:=Random(6);
  289.   If Q.Form=5Then Inc(Q.Form,Random(2)); 
  290.   Q.X:=5;Q.Y:=0;
  291.   Q._Move:=0;Q.Sleep:=0;
  292.   PutForm(False); 
  293.  End; 
  294.  
  295.  Function UpDateData:Boolean; 
  296.  Var 
  297.   H,I,J,JK:Byte;
  298.   Bonus:Byte; 
  299.   LnChk:Boolean; 
  300.  Begin 
  301.   UpDateData:=True;Q.Sleep:=0; 
  302.   PutForm(False); 
  303.   Touch:=False;Ok:=False; 
  304.   PutForm(True);
  305.   Inc(Q.Y); 
  306.   For I:=0to 3do Begin 
  307.    Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,Q._Move,I].Y,Q.X+BlkFormat[Q.Form,Q._Move,I].X];
  308.   End; 
  309.   If(Touch)Then Dec(Q.Y);
  310.   PutForm(False); 
  311.   If(Touch)Then Begin 
  312.    While(Q.Sleep>Q.SleepDelay)do Dec(Q.Sleep); 
  313.    Q.Sleep:=0;Ok:=True; 
  314.    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;
  315.    If Q.Level>7Then Begin 
  316.     Inc(Q.Score,LongInt(5)*Q.Level);
  317.     GotoXY(4,6);Write(Q.Score); 
  318.    End;
  319.    Bonus:=0; 
  320.    For J:=0to 19do Begin 
  321.     Touch:=True; 
  322.     For I:=0to 9do Touch:=Touch and Q.Tbl[J,I]; 
  323.     If(Touch)Then Inc(Bonus); 
  324.    End; 
  325.    If Bonus>0Then Dec(Bonus); 
  326.    Touch:=False; 
  327.    For JK:=0to 7do Begin 
  328.     For J:=0to 19do Begin
  329.      LnChk:=True; 
  330.      For I:=0to 9do LnChk:=LnChk and Q.Tbl[J,I]; 
  331.      If(LnChk)Then Begin 
  332.       If Not(Touch)Then Begin 
  333.        Touch:=True;
  334.       End; 
  335.       If JK and 1=0Then TextAttr($FF)
  336.                    Else TextAttr(7); 
  337.       BarSpcHor(HomeX,HomeY+J,HomeX+9); 
  338.      End;
  339.     End; 
  340.     WaitRetrace;WaitRetrace;WaitRetrace; 
  341.    End; 
  342.    For J:=0to 19do Begin 
  343.     Touch:=True; 
  344.     For I:=0to 9do Touch:=Touch and Q.Tbl[J,I]; 
  345.     If(Touch)Then Begin 
  346.      MoveRight(Q.Tbl[0,0],Q.Tbl[1,0],10*J); 
  347.      FillChar(Q.Tbl[0,0],10,0); 
  348.      MoveText(HomeX,HomeY,HomeX+9,HomeY+J-1,HomeX,HomeY+1);
  349.      Inc(Q.Score,LongInt(5)+(Bonus*4)*(Q.Level+1)+10*Q.Level); Inc(Q.Bar); 
  350.      GotoXY(4,6);Write(Q.Score); 
  351.      GotoXY(4,9);Write(Q.Bar); 
  352.      I:=(Q.Bar+Q.FBar)shr 4;
  353.      If(Q.Level<>I)Then Begin 
  354.       Q.Level:=I;
  355.       GotoXY(4,3);Write(Q.Level+1); 
  356.       If Q.SleepDelay>6Then Dec(Q.SleepDelay,2); 
  357.      End;
  358.     End; 
  359.    End; 
  360.    If Q.Y<=1Then Begin 
  361.     UpDateData:=False; 
  362.     Exit;
  363.    End; 
  364.    Init; 
  365.   End; 
  366.  End; 
  367.  
  368.  Function GameOver:Word;Begin 
  369.   GotoXY(10,7);Write('Partie Terminer'); 
  370.   If(Q.UpDate)Then Begin 
  371.    Q.UpDate:=False; 
  372.   End;
  373.   GameOver:=kbEsc;
  374.  End; 
  375.  
  376. Begin
  377.  TetrisRefresh(Q);
  378.  K:=0; 
  379.  Repeat 
  380.   Case(Q.Mode)of 
  381.    tmStart:Begin
  382.     TetrisStart(Q); 
  383.     TetrisRefresh(Q); 
  384.     Init;
  385.     Q.Mode:=tmPlay;Q.UpDate:=True; 
  386.    End;
  387.    tmPlay:Repeat 
  388.     Begin
  389.      Repeat
  390.       If(Q.Sleep>Q.SleepDelay)Then If Not(UpDateData)Then Begin
  391.        Q.Mode:=tmGameOver;
  392.        Goto _Exit;
  393.       End;
  394.       WaitRetrace;
  395.       Inc(Q.Sleep);
  396.      Until KeyPressed;
  397.      K:=Byte(ReadKey);
  398.     End;
  399.     If Chr(K)='2'Then K:=kbDn;
  400.     If Chr(K)='4'Then K:=kbLeft;
  401.     If Chr(K)='6'Then K:=kbRight;
  402.     NoAction:=False;
  403.     Case(K)of
  404.      kbLeft,kbKeypadLeft:If Q.X>0Then Begin
  405.       Touch:=False;
  406.       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];
  407.       If Not(Touch)Then Begin
  408.        PutForm(True);
  409.        Dec(Q.X);
  410.        PutForm(False);
  411.       End;
  412.      End;
  413.      kbRight,kbKeypadRight:If Q.X+BlkLength[Q.Form,Q._Move]-1<9Then Begin
  414.       Touch:=False;
  415.       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];
  416.       If Not(Touch)Then Begin
  417.        PutForm(True);
  418.        Inc(Q.X);
  419.        PutForm(False);
  420.       End;
  421.      End;
  422.      kbDn,kbKeypadDn:While(True)do Begin
  423.       If Not(UpDateData)Then Begin
  424.        Q.Mode:=tmGameOver;
  425.        Goto _Exit;
  426.       End;
  427.       If(Ok)Then Break;
  428.      End;
  429.      Else NoAction:=True;
  430.     End;
  431.     If(NoAction)Then Begin
  432.      If(K in[kbKeyPad5,kbKeypad5NumLock])or(Char(K)in[' ','5'])Then Begin
  433.       Touch:=False;
  434.       For I:=0to 3do Begin
  435.        XT:=Q.X+BlkFormat[Q.Form,(Q._Move+1)and 3,I].X; Touch:=Touch or(XT>9);
  436.        Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
  437.       End; 
  438.       If Not(Touch)Then Begin 
  439.        PutForm(True);
  440.        Q._Move:=(Q._Move+1)and 3;
  441.        PutForm(False) 
  442.       End 
  443.        Else
  444.       Begin 
  445.        Touch:=False; 
  446.        For I:=0to 3do Begin 
  447.         XT:=Q.X;
  448.         If XT>0Then Dec(XT);
  449.         Inc(XT,BlkFormat[Q.Form,(Q._Move+1)and 3,I].X); Touch:=Touch or(XT>9);
  450.         Touch:=Touch or Q.Tbl[Q.Y+BlkFormat[Q.Form,(Q._Move+1)and 3,I].Y,XT];
  451.        End;
  452.        If Not(Touch)Then Begin
  453.         PutForm(True);
  454.         Dec(Q.X); Q._Move:=(Q._Move+1)and 3;
  455.         PutForm(False);
  456.        End;
  457.       End;
  458.      End
  459.       Else
  460.      Break;
  461.     End;
  462.    Until(K=kbEsc)or(Chr(K)='Q');
  463.    tmGameOver:K:=GameOver;
  464.   End;
  465. _Exit: 
  466.   If K<>0Then Break; 
  467.  Until False; 
  468.  TetrisPlay:=K; 
  469. End; 
  470.  
  471. Var 
  472.  Game:TetrisGame;
  473.  
  474. BEGIN 
  475.  TetrisInit(Game); 
  476.  TetrisPlay(Game); 
  477. END.

Binaire

Cliquez ici pour télécharger le fichier exécutable Windows tetrisconsole.zip

Code source

https://github.com/gladir/delphi_tetris

Dernière mise à jour : Mercredi, le 24 juin 2015