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 disparaitre des lignes. Voici la version que j'avais inclus dans le MonsterBook et que j'ai adapté pour Turbo Pascal pour Windows et son unité «WinCrt».


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

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

Dernière mise à jour : Dimanche, le 10 décembre 2017