program EVIL_Tetris_fast;
uses crt;
const
tetra:array[0..6,0..3] of array[0..3,0..3] of byte =
(

(
((0,1,0,0),
 (0,1,0,0),
 (0,1,0,0),
 (0,1,0,0)),
((0,0,0,0),
 (1,1,1,1),
 (0,0,0,0),
 (0,0,0,0)),
((0,1,0,0),
 (0,1,0,0),
 (0,1,0,0),
 (0,1,0,0)),
((0,0,0,0),
 (1,1,1,1),
 (0,0,0,0),
 (0,0,0,0))
),

(
((1,1,0,0),
 (1,1,0,0),
 (0,0,0,0),
 (0,0,0,0)),
((1,1,0,0),
 (1,1,0,0),
 (0,0,0,0),
 (0,0,0,0)),
((1,1,0,0),
 (1,1,0,0),
 (0,0,0,0),
 (0,0,0,0)),
((1,1,0,0),
 (1,1,0,0),
 (0,0,0,0),
 (0,0,0,0))
),

(
((0,1,1,0),
 (0,1,0,0),
 (0,1,0,0),
 (0,0,0,0)),
((1,0,0,0),
 (1,1,1,0),
 (0,0,0,0),
 (0,0,0,0)),
((0,1,0,0),
 (0,1,0,0),
 (1,1,0,0),
 (0,0,0,0)),
((0,0,0,0),
 (1,1,1,0),
 (0,0,1,0),
 (0,0,0,0))
),

(
((1,1,0,0),
 (0,1,0,0),
 (0,1,0,0),
 (0,0,0,0)),
((0,0,0,0),
 (1,1,1,0),
 (1,0,0,0),
 (0,0,0,0)),
((0,1,0,0),
 (0,1,0,0),
 (0,1,1,0),
 (0,0,0,0)),
((0,0,1,0),
 (1,1,1,0),
 (0,0,0,0),
 (0,0,0,0))
),

(
((1,0,0,0),
 (1,1,0,0),
 (0,1,0,0),
 (0,0,0,0)),
((0,1,1,0),
 (1,1,0,0),
 (0,0,0,0),
 (0,0,0,0)),
((1,0,0,0),
 (1,1,0,0),
 (0,1,0,0),
 (0,0,0,0)),
((0,1,1,0),
 (1,1,0,0),
 (0,0,0,0),
 (0,0,0,0))
),

(
((0,1,0,0),
 (1,1,0,0),
 (1,0,0,0),
 (0,0,0,0)),
((1,1,0,0),
 (0,1,1,0),
 (0,0,0,0),
 (0,0,0,0)),
((0,1,0,0),
 (1,1,0,0),
 (1,0,0,0),
 (0,0,0,0)),
((1,1,0,0),
 (0,1,1,0),
 (0,0,0,0),
 (0,0,0,0))
),

(
((0,1,0,0),
 (1,1,1,0),
 (0,0,0,0),
 (0,0,0,0)),
((0,1,0,0),
 (1,1,0,0),
 (0,1,0,0),
 (0,0,0,0)),
((1,1,1,0),
 (0,1,0,0),
 (0,0,0,0),
 (0,0,0,0)),
((0,1,0,0),
 (0,1,1,0),
 (0,1,0,0),
 (0,0,0,0))
)

);
var
  tet:array[0..9, 0..19] of byte;
  key:char;
  fig,col,rot:byte;
  score:longint;
  x,y:integer;
function intToStr(n:longint):string;
var
  s:string;
begin
  str(n,s);
  intToStr:=s;
end;
procedure strOut(x,y,bg,fg:byte;s:String);
var
  i,cc:byte;
begin
for i:=1 to length(s) do
  begin
    cc:=ord(s[i]);
    asm
      mov ah, 02h
      mov bh, 00h
      mov dh, y
      mov dl, x
      add dl, i
      sub dl, 1
      int 10h
      mov ah, 09h
      mov al, cc
      mov bh, bg
      mov bl, fg
      mov cx, 01h
      int 10h
    end;
  end;
end;
procedure initProgramm;
var
  i,j:byte;
begin
  asm
    mov ax, 13h
    int 10h
  end;
end;
procedure terminateProgramm;
begin
  asm
    mov ax, 03h
    int 10h
  end;
end;
procedure putPixel(x,y:integer;c:byte);assembler;
asm
  xor ax, ax
  xor si, si
  mov ax, 0A000h
  mov es, ax
  mov ax, y
  shl ax, 8
  mov bx, y
  shl bx, 6
  add ax, bx
  add ax, x
  mov di, ax
  xor ax, ax
  mov ah, c
  mov es:[di], ah
end;
procedure nextFig;
begin
  x := 5;
  y := 1;
  fig := Random(7);
  rot := 0;
  col := Random(15)+1;
end;
procedure initGame;
var
  i,j:byte;
begin
  key := #$FF;
  nextFig;
  for i:=0 to 9 do
    for j:=0 to 19 do
      tet[i,j] := 0;
end;

procedure visTets;
var
  i,j,k,l:byte;
begin
  for i:=0 to 9 do
     for j:=0 to 199 do
     begin
       if ((i - j+294) div 5 mod 2 = 0) then putPixel(i+99,j,15)
                                        else putPixel(i+99,j,12);
       if ((i + j + 1) div 5 mod 2 = 0) then putPixel(i+210,j,15)
                                        else putPixel(i+210,j,12);
     end;
  for i:=0 to 9 do
    for j:=0 to 19 do
      for k:=0 to 8 do
        for l:=0 to 8 do
          putPixel(i*10+110+k,j*10+l,tet[i,j]);

  for i:=0 to 3 do
    for j:=0 to 3 do
    if (tetra[fig,rot][j,i]=1) then
      for k:=0 to 8 do
        for l:=0 to 8 do
          putPixel((x-1+i)*10+110+k,(y-1+j)*10+l,col);
end;
procedure placeFig;
var
  i,j,k,l,c:byte;
begin
  for i:=0 to 3 do
    for j:=0 to 3 do
    if (tetra[fig,rot][j,i]=1) then
      tet[x-1+i,y-1+j] := col;
  for j := 0 to 19 do
  begin
    c:=0;
    for i := 0 to 9 do
      if tet[i,j] <>0 then c:=c+1;
    if c = 10 then
    begin
      for k:=j downto 1 do
        for l:=0 to 9 do
          tet[l,k] := tet[l,k-1];
       score:=score+1;
    end;
  end;

end;
procedure movSideFig(d:integer);
var
  i,j,k,l:byte;
begin
  for i:=0 to 3 do
    for j:=0 to 3 do
      if (tetra[fig,rot][j,i]=1) then
      if ((x-1+i+d<0) or (x-1+i+d>9) or (tet[x-1+i+d,y-1+j]<>0)) then d:=0;
  x:=x+d;
end;
procedure movDownFig;
var
  i,j,k,l:byte;
begin
  for i:=0 to 3 do
    for j:=0 to 3 do
      if (tetra[fig,rot][j,i]=1) then
      if ((y+j>19) or (tet[x-1+i,y+j]<>0)) then
      begin
        placeFig;
        nextFig;
        exit;
      end;
  y:=y+1;
end;
procedure rotFig;
var
  i,j,n:integer;
begin
  if (rot<3) then n:=rot+1 else n:=0;
  for i:=0 to 3 do
    for j:=0 to 3 do
      if (tetra[fig,n][j,i]=1) then
      if (tet[x-1+i,y-1+j]<>0)or
      (x-1+i>9)or
      (x-1+i<0)or
      (y-1+j>19)
       then exit;
   rot:=n;
end;
begin
  initProgramm;
  initGame;
  repeat
    key := readKey;
    if key = #0 then
    key := readKey;
{    key := readKey;}
{    putPixel(10,10,15);}
    if (key = #72) then rotFig;
    if (key = #75) then movSideFig(-1);
    if (key = #77) then movSideFig(+1);
    movDownFig;
    visTets;
    strOut(0,0,0,10, 'Your Score: '+intToStr(score))
{    if keyPressed then key := readKey
                  else key := #$FF;}
  until key=#27;
  terminateProgramm;
end.