home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / MYPROGS.ZIP / TETRIS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-06  |  13KB  |  594 lines
  1. PROGRAM TETRIS;
  2. { conçu, emballé et ficelé
  3.   par...  VIDAL    Dominique
  4.           PEREIRA  Alfredo   }
  5.  
  6. USES
  7.  crt;
  8.  
  9. CONST
  10.  ncarre          = 4;
  11.  npiece          = 7;
  12.  npiece4         = npiece*4;
  13.  
  14.  xmax            = 10;
  15.  ymax            = 20;
  16.  xdecal          = 4;
  17.  ydecal          = 24;
  18.  
  19.  score_ligne     = 10;
  20.  score_piece     = 1;
  21.  
  22.  delais          = 1000;
  23.  temps_init      = 10000;
  24.  
  25.  espace          = ' ';
  26.  gf              = '░';  {gris fonce}
  27.  g               = '▒';  {gris}
  28.  gc              = '▓';  {gris clair}
  29.  b               = '█';  {blanc}
  30.  
  31.  rotat           = ' ';
  32.  gauche          = '4';
  33.  droite          = '6';
  34.  chute           = '5';
  35.  fin_jeu         = 'F';
  36.  
  37.  
  38. TYPE
  39.  coord       = record
  40.                 x,y : integer;
  41.                end;
  42.  
  43.  forme       = array[1..ncarre] of coord;
  44.  
  45.  coul_forme  = record
  46.                 c : char;
  47.                 f : forme;
  48.                end;
  49.  
  50.  ensemble_cf = array[1..npiece4] of coul_forme;
  51.  
  52.  piece       = record
  53.                 rang : integer;
  54.                 ref  : coord;
  55.                 cf   : coul_forme;
  56.                end;
  57.  
  58.  tableau     = array[0..xmax+1,0..ymax] of char;
  59.  
  60.  
  61. CONST
  62.  origine  : coord       = (x:xmax div 2;y:ymax-3);
  63.  dep_gche : coord       = (x:-1;y:0);
  64.  dep_dte  : coord       = (x:1;y:0);
  65.  dep_bas  : coord       = (x:0;y:-1);
  66.  suivant  : coord       = (x:22;y:14);
  67.  
  68.  ens      : ensemble_cf = ((c:gf;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:0;y:2))),
  69.                            (c:g;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:1;y:1))),
  70.                            (c:b;f:((x:0;y:0),(x:1;y:0),(x:-1;y:0),(x:2;y:0))),
  71.                            (c:gc;f:((x:0;y:0),(x:-1;y:0),(x:0;y:1),(x:0;y:2))),
  72.                            (c:b;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:-1;y:0))),
  73.                            (c:gf;f:((x:0;y:0),(x:-1;y:0),(x:0;y:1),(x:1;y:1))),
  74.                            (c:gc;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:-1;y:1))),
  75.  
  76.                            (c:gf;f:((x:0;y:0),(x:1;y:0),(x:-1;y:0),(x:1;y:1))),
  77.                            (c:g;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:1;y:1))),
  78.                            (c:b;f:((x:0;y:0),(x:0;y:1),(x:0;y:2),(x:0;y:3))),
  79.                            (c:gc;f:((x:0;y:1),(x:-1;y:1),(x:1;y:1),(x:1;y:0))),
  80.                            (c:b;f:((x:0;y:0),(x:0;y:1),(x:0;y:2),(x:-1;y:1))),
  81.                            (c:gf;f:((x:0;y:0),(x:-1;y:1),(x:0;y:1),(x:-1;y:2))),
  82.                            (c:gc;f:((x:0;y:0),(x:1;y:1),(x:0;y:1),(x:1;y:2))),
  83.  
  84.                            (c:gf;f:((x:0;y:0),(x:-1;y:2),(x:0;y:1),(x:0;y:2))),
  85.                            (c:g;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:1;y:1))),
  86.                            (c:b;f:((x:0;y:0),(x:1;y:0),(x:-1;y:0),(x:2;y:0))),
  87.                            (c:gc;f:((x:0;y:0),(x:1;y:2),(x:0;y:1),(x:0;y:2))),
  88.                            (c:b;f:((x:0;y:0),(x:1;y:1),(x:0;y:1),(x:-1;y:1))),
  89.                            (c:gf;f:((x:0;y:0),(x:-1;y:0),(x:0;y:1),(x:1;y:1))),
  90.                            (c:gc;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:-1;y:1))),
  91.  
  92.                            (c:gf;f:((x:-1;y:0),(x:-1;y:1),(x:0;y:1),(x:1;y:1))),
  93.                            (c:g;f:((x:0;y:0),(x:1;y:0),(x:0;y:1),(x:1;y:1))),
  94.                            (c:b;f:((x:0;y:0),(x:0;y:1),(x:0;y:2),(x:0;y:3))),
  95.                            (c:gc;f:((x:0;y:0),(x:-1;y:0),(x:-1;y:1),(x:1;y:0))),
  96.                            (c:b;f:((x:0;y:0),(x:1;y:1),(x:0;y:1),(x:0;y:2))),
  97.                            (c:gf;f:((x:0;y:0),(x:-1;y:1),(x:0;y:1),(x:-1;y:2))),
  98.                            (c:gc;f:((x:0;y:0),(x:1;y:1),(x:0;y:1),(x:1;y:2))) );
  99.  
  100.  
  101.  
  102. VAR
  103.  arret,perdu,sortir            : boolean;
  104.  piece_suivante                : boolean;
  105.  nligne,score,niveau           : integer;
  106.  i,temps                       : integer;
  107.  touche                        : char;
  108.  dep                           : coord;
  109.  p,p_suiv                      : piece;
  110.  tab                           : tableau;
  111.  
  112.  
  113. FUNCTION test_rotation:integer;
  114.  var
  115.   i,test  : integer;
  116.   temp    : coord;
  117.  
  118.  begin
  119.   test:=p.rang+npiece;
  120.   if test>npiece4 then
  121.      test:=test-npiece4;
  122.   i:=0;
  123.  
  124.   repeat
  125.     inc(i);
  126.     temp.x:=p.ref.x + ens[test].f[i].x;
  127.     temp.y:=p.ref.y + ens[test].f[i].y;
  128.     if (temp.x>=1) and (temp.x<=xmax) then
  129.        begin
  130.         if tab[temp.x , temp.y] <> espace then
  131.         test:=0;
  132.        end
  133.     else
  134.        test:=0;
  135.   until (i=ncarre) or (test=0);
  136.  
  137.   test_rotation:=test;
  138.  end;
  139.  
  140.  
  141. FUNCTION test_deplacement(dep : coord):boolean;
  142.  var
  143.   i       : integer;
  144.   test    : boolean;
  145.   temp    : coord;
  146.  
  147.  begin
  148.   test:=false;
  149.   i:=0;
  150.   temp.x:=p.ref.x+dep.x;
  151.   temp.y:=p.ref.y+dep.y;
  152.  
  153.   repeat
  154.    inc(i);
  155.    if tab[temp.x + p.cf.f[i].x , temp.y + p.cf.f[i].y] <> espace then
  156.       test:=true;
  157.   until (i=ncarre) or test;
  158.  
  159.   test_deplacement:=test;
  160.  end;
  161.  
  162.  
  163. FUNCTION test_ligne(y:integer):boolean;
  164.  var
  165.   i       : integer;
  166.   test    : boolean;
  167.  
  168.  begin
  169.   test:=false;
  170.   i:=0;
  171.  
  172.   repeat
  173.    inc(i);
  174.    if tab[i,y]=espace then
  175.       test:=true;
  176.   until (i=xmax) or test;
  177.  
  178.   test_ligne:=test;
  179.  end;
  180.  
  181.  
  182. PROCEDURE affiche_score;
  183.  const
  184.   long                = 5;
  185.   coordniveau : coord = (x:56;y:16);
  186.   coordlignes : coord = (x:56;y:18);
  187.   coordpoints : coord = (x:56;y:20);
  188.  
  189.  begin
  190.   gotoxy(coordniveau.x,coordniveau.y);
  191.   write(niveau:long);
  192.   gotoxy(coordlignes.x,coordlignes.y);
  193.   write(nligne:long);
  194.   gotoxy(coordpoints.x,coordpoints.y);
  195.   write(score:long);
  196.   gotoxy(1,1);
  197.  end;
  198.  
  199.  
  200. PROCEDURE affiche_perdu;
  201.  const
  202.   phrase             = 'PERDU.';
  203.   coordperdu : coord = (x:xdecal+xmax+2-length(phrase) div 2;
  204.                         y:ydecal-ymax);
  205.  
  206.  begin
  207.   gotoxy(coordperdu.x,coordperdu.y);
  208.   write(phrase);
  209.  end;
  210.  
  211.  
  212. PROCEDURE affiche(p : piece;vis : boolean);
  213.  var
  214.   i       : integer;
  215.   car     : char;
  216.   temp    : coord;
  217.  
  218.  begin
  219.   if vis then
  220.      car:=p.cf.c
  221.   else
  222.      car:=espace;
  223.   temp.x:=xdecal+2*p.ref.x;
  224.   temp.y:=ydecal-p.ref.y;
  225.  
  226.   for i:=1 to ncarre do
  227.    begin
  228.     gotoxy(temp.x+2*p.cf.f[i].x,temp.y-p.cf.f[i].y);
  229.     write(car,car);
  230.    end;
  231.  
  232.   gotoxy(1,1);
  233.  end;
  234.  
  235.  
  236. PROCEDURE nouveau_tableau; {initialise le tableau de jeu :
  237.   au depart, il est vide}
  238.  
  239.  const
  240.   non_blanc = b;
  241.  
  242.  var
  243.   i,j,temp : integer;
  244.  
  245.  begin
  246.   for i:=1 to xmax do
  247.    for j:=1 to ymax do
  248.     tab[i,j]:=espace;
  249.  
  250.   temp:=xmax+1;
  251.   for j:=0 to ymax do
  252.       begin
  253.        tab[0,j]:=non_blanc;
  254.        tab[temp,j]:=non_blanc;
  255.       end;
  256.  
  257.   for i:=1 to xmax do
  258.       tab[i,0]:=non_blanc;
  259.  
  260.  end;
  261.  
  262.  
  263. PROCEDURE marque_tableau;
  264.  {enregistre la piece dans le tableau
  265.   une fois qu'elle s'est arretee}
  266.  
  267.  var
  268.   i       : integer;
  269.  
  270.  begin
  271.   for i:=1 to ncarre do
  272.    tab[p.ref.x + p.cf.f[i].x , p.ref.y + p.cf.f[i].y]:=p.cf.c;
  273.  end;
  274.  
  275.  
  276. PROCEDURE affiche_tableau;
  277.  {affiche l'interieur du tableau
  278.   de jeu (sans le contour)}
  279.  
  280.  var
  281.   i,j     : integer;
  282.  
  283.  begin
  284.   for i:=1 to xmax do
  285.    for j:=1 to ymax do
  286.     begin
  287.      gotoxy(2*i+xdecal,ydecal-j);
  288.      write(tab[i,j],tab[i,j]);
  289.     end;
  290.   gotoxy(1,1);
  291.  end;
  292.  
  293.  
  294. PROCEDURE efface_ligne(y:integer);
  295.  var
  296.   i,j,max : integer;
  297.  
  298.  begin
  299.   max:=origine.y-2;
  300.   for j:=y to max do
  301.    for i:=1 to xmax do
  302.     tab[i,j]:=tab[i,j+1];
  303.   affiche_tableau;
  304.  end;
  305.  
  306.  
  307. PROCEDURE controle_ligne;
  308.  {quand une piece se pose, cette procedure
  309.   verifie si une ligne a ete completee}
  310.  
  311.  var
  312.   i,y     : integer;
  313.  
  314.  begin
  315.   y:=p.ref.y;
  316.   for i:=1 to ncarre do
  317.    if test_ligne(y) then
  318.       inc(y)
  319.    else
  320.       begin
  321.        if nligne mod 10=9 then
  322.         inc(niveau);
  323.        efface_ligne(y);
  324.        inc(nligne);
  325.        inc(score,score_ligne);
  326.       end;
  327.  end;
  328.  
  329.  
  330. PROCEDURE nouvelle_piece;
  331.  begin
  332.   if piece_suivante then
  333.    begin
  334.     affiche(p_suiv,false);
  335.     p.cf:=p_suiv.cf;
  336.     p.rang:=p_suiv.rang;
  337.     p.ref:=origine;
  338.     affiche(p,true);
  339.     p_suiv.rang:=random(npiece)+1;
  340.     p_suiv.cf:=ens[p_suiv.rang];
  341.     affiche(p_suiv,true);
  342.    end
  343.   else
  344.    begin
  345.     p.rang:=random(npiece)+1;
  346.     p.cf:=ens[p.rang];
  347.     p.ref:=origine;
  348.     affiche(p,true);
  349.    end;
  350.  end;
  351.  
  352.  
  353. PROCEDURE rotation;
  354.  var
  355.   nouv_rang : integer;
  356.  
  357.  begin
  358.   nouv_rang:=test_rotation;
  359.   if nouv_rang<>0 then
  360.      begin
  361.       affiche(p,false);
  362.       p.rang:=nouv_rang;
  363.       p.cf:=ens[p.rang];
  364.       affiche(p,true);
  365.      end;
  366.  end;
  367.  
  368.  
  369. PROCEDURE deplacement(dep : coord);
  370.  var
  371.   i       : integer;
  372.  
  373.  begin
  374.   if test_deplacement(dep) then
  375.      begin
  376.       if dep.y=-1 then
  377.          begin
  378.           arret:=true;
  379.           i:=0;
  380.           repeat
  381.            inc(i);
  382.            if (p.ref.y+p.cf.f[i].y)=origine.y then
  383.            perdu:=true;
  384.           until (i=ncarre) or perdu;
  385.          end;
  386.      end
  387.    else
  388.      begin
  389.       affiche(p,false);
  390.       inc(p.ref.x,dep.x);
  391.       inc(p.ref.y,dep.y);
  392.       affiche(p,true);
  393.      end;
  394.  end;
  395.  
  396.  
  397. PROCEDURE quitter_tetris;
  398.  begin
  399.   arret:=true;
  400.   perdu:=true;
  401.   sortir:=true;
  402.  end;
  403.  
  404.  
  405. PROCEDURE parametres;
  406.  const
  407.   init_niv  = 'N';
  408.   next      = 'P';
  409.   commencer = 'S';
  410.   quitter   = 'Q';
  411.  
  412.  procedure param_niveau;
  413.   begin
  414.    inc(niveau);
  415.    if niveau>9 then
  416.       niveau:=0;
  417.    affiche_score;
  418.   end;
  419.  
  420.  procedure param_suivante;
  421.   begin
  422.    if piece_suivante then
  423.     begin
  424.      piece_suivante:=false;
  425.      affiche(p_suiv,false);
  426.      end
  427.     else
  428.      begin
  429.       piece_suivante:=true;
  430.       p_suiv.rang:=p.rang;
  431.       p_suiv.cf:=p.cf;
  432.       affiche(p_suiv,true);
  433.      end;
  434.   end;
  435.  
  436.  begin
  437.   piece_suivante := true;
  438.   repeat
  439.     repeat
  440.     until keypressed;
  441.     touche:=upcase(readkey);
  442.     case touche of
  443.          init_niv : param_niveau;
  444.          next     : param_suivante;
  445.          quitter  : quitter_tetris;
  446.     end;
  447.   until (touche=commencer) or (touche=quitter);
  448.  end;
  449.  
  450.  
  451. PROCEDURE initialisation;
  452.  begin
  453.   score:=0;
  454.   nligne:=0;
  455.   niveau:=0;
  456.   affiche_score;
  457.   arret:=false;
  458.   perdu:=false;
  459.   sortir:=false;
  460.   nouveau_tableau;
  461.   affiche_tableau;
  462.   p_suiv.ref:=suivant;
  463.   p_suiv.rang:=random(npiece)+1;
  464.   p_suiv.cf:=ens[p_suiv.rang];
  465.   affiche(p_suiv,true);
  466.   p.rang:=p_suiv.rang;
  467.   p.cf:=p_suiv.cf;
  468.   p.ref:=origine;
  469.   randomize;
  470.  end;
  471.  
  472.  
  473. PROCEDURE presentation;
  474.  const
  475.   coing='╚';
  476.   coind='╝';
  477.   bordv='║';
  478.   bordh='═';
  479.   texte0  : coord = (x:43;y:12);
  480.   texte1  : coord = (x:40;y:16);
  481.   texte2  : coord = (x:40;y:18);
  482.   texte3  : coord = (x:40;y:20);
  483.   texte5  : coord = (x:41;y:4);
  484.   phrase0         = 'PIECE SUIVANTE';
  485.   phrase1         = 'NIVEAU       : ';
  486.   phrase2         = 'LIGNES       : ';
  487.   phrase3         = 'POINTS       : ';
  488.   phrase4         = '┌─────────────────┐';
  489.   phrase5         = '│  JEU DE TETRIS  │';
  490.   phrase6         = '└─────────────────┘';
  491.  
  492.  var
  493.   i:integer;
  494.   temp1,temp2,temp3:integer;
  495.  
  496.  begin
  497.   clrscr;
  498.   writeln('change_niveau:N suivant:P commencer:S quitter:Q  ');
  499.   writeln('rotat:espace    gauche :4    droite:6  chute :5  fin_jeu:F  ');
  500.  
  501.   temp1:=xdecal+1;
  502.   temp2:=xdecal+(xmax+1)*2;
  503.  
  504.   gotoxy(temp1,ydecal);
  505.   write(coing);
  506.   gotoxy(temp2,ydecal);
  507.   write(coind);
  508.  
  509.   for i:=1 to origine.y do
  510.    begin
  511.     gotoxy(temp1,ydecal-i);
  512.     write(bordv);
  513.     gotoxy(temp2,ydecal-i);
  514.     write(bordv);
  515.    end;
  516.  
  517.   temp3:=xmax*2+1;
  518.   for i:=2 to temp3 do
  519.    begin
  520.     gotoxy(xdecal+i,ydecal);
  521.     write(bordh);
  522.    end;
  523.  
  524.   gotoxy(texte0.x,texte0.y);
  525.   write(phrase0);
  526.   gotoxy(texte1.x,texte1.y);
  527.   write(phrase1);
  528.   gotoxy(texte2.x,texte2.y);
  529.   write(phrase2);
  530.   gotoxy(texte3.x,texte3.y);
  531.   write(phrase3);
  532.   gotoxy(texte5.x,texte5.y-1);
  533.   write(phrase4);
  534.   gotoxy(texte5.x,texte5.y);
  535.   write(phrase5);
  536.   gotoxy(texte5.x,texte5.y+1);
  537.   write(phrase6);
  538.  end;
  539.  
  540.  
  541.  
  542.  
  543. BEGIN
  544.  presentation;
  545.  
  546.  repeat
  547.   initialisation;
  548.   parametres;
  549.  
  550.   repeat
  551.    nouvelle_piece;
  552.    temps:=temps_init-delais*niveau;
  553.    repeat
  554.     for i:=1 to temps do
  555.       begin
  556.         if keypressed then
  557.           begin
  558.               touche:=readkey;
  559.               touche:=upcase(touche);
  560.               case touche of
  561.                    rotat   : rotation;
  562.                    gauche  : deplacement(dep_gche);
  563.                    droite  : deplacement(dep_dte);
  564.                    chute   : deplacement(dep_bas);
  565.                    fin_jeu : begin
  566.                               arret:=true;
  567.                               perdu:=true;
  568.                              end;
  569.               end;
  570.           end;
  571.       end;
  572.      deplacement(dep_bas);
  573.    until arret;
  574.  
  575.    arret:=false;
  576.    marque_tableau;
  577.    affiche_tableau;
  578.    inc(score,score_piece);
  579.    controle_ligne;
  580.    affiche_score;
  581.  
  582.   until perdu;
  583.  
  584.   affiche_perdu;
  585.   delay(1000);
  586.  
  587.   repeat
  588.   until keypressed;
  589.   affiche(p_suiv,false);
  590.  
  591.  until sortir=true;
  592.  
  593. END.
  594.