Hra tetris v textovom mode

Kategórie: KMP (Programy mladých programátorů)

Autor: Werbhofen
Program: Tetris.pas,  Kniznica.pas,  Tetrunit.pas,  Tetrdata.pas
Soubor exe: Tetris.exe

{ KNIZNICA.PAS                                                      }
{ Kniznica pre tetris a phyton.                                     }
{                                                                   }
{ Author: WERBHOFEN                                                 }
{ Datum: 12.10.2009                            http://www.trsek.com }
 
UNIT Kniznica;
 
INTERFACE
USES Crt,Dos;
TYPE TInt2D=record
       x,y:integer;
     end;
 
     TInt3D=record
       x,y,z:integer;
     end;
 
     TReal2D=record
       x,y:real;
     end;
 
     TReal3D=record
       x,y,z:real;
     end;
 
     TTrojuholnik=array[1..3]of TInt2D;
 
procedure Rot(var x,y:integer; Sx,Sy,uhol:integer);
procedure ClearKeyboardBuffer;
procedure WriteXY(x,y:integer; s:string);
procedure DelicKmitoctu;
procedure Cakaj(oneskorenie:integer);
procedure VymazKurzor;
 
IMPLEMENTATION
 
procedure Rot(var x,y:integer; Sx,Sy,uhol:integer);
(* SX,SY - stred otacania; x,y - otacany bod; *)
  var m,n:integer;
      c:real;
  begin
    c:=uhol*PI/180;
    m:=round((x-Sx)*cos(c) - (y-Sy)*sin(c) + Sx);
    n:=round((x-Sx)*sin(c) + (y-Sy)*cos(c) + Sy);
    x:=m; y:=n;
  end;
 
procedure ClearKeyboardBuffer;
  var g:char;
  begin
    while keypressed do g:=readkey;
  end;
 
procedure WriteXY(x,y:integer; s:string);
  begin
    GoToXY(x,y); write(s);
  end;
 
procedure DelicKmitoctu;
  begin
    Port[$40]:=Lo(1);  (* 65535 = maximalna hodnota, ide to pomaly *)
    Port[$40]:=Hi(1);  (*     1 = minimalna hodnota, ide to rychlo *)
  end;
 
procedure Cakaj(oneskorenie:integer);  (* vzdy pred prvym pouzitim treba zapnut proc. DelicKmitoctu *)
  var StaryCas,NovyCas:byte;
      cas:integer;
  begin
    if oneskorenie>0 then begin
      cas:=0;
      StaryCas:=mem[$40:$6c];
      repeat
        NovyCas:=round(mem[$40:$6c]);
        if NovyCas<>StaryCas then begin
          cas:=cas+1;
          StaryCas:=mem[$40:$6c];
        end;
      until oneskorenie=cas;
    end;
  end;
 
procedure VymazKurzor; (* schovani kurzoru nastavenim jeho velikosti *)
  var reg:Registers;
  begin
    reg.ah:=1;
    reg.ch:=$20;
    reg.cl:=$1f;
    Intr($10,reg);
  end;
 
END.