program tetris;
uses
 intuition,graphics,exec;

type
 tetris_block = array [0..3,0..3] of byte;
const
 CEGLAX  = 16;
 CEGLAY  = 8;
 XNOCHR  = 20;
 YNOCHR  = 28;
var
 mywindow : pwindow;
 myimage  : array [0..1] of timage;
 plansza  : array [1..YNOCHR,1..XNOCHR] of byte;

procedure pokaz_klocek(klocek : tetris_block;
                       x,y    : integer;
                       _show  : boolean);
var
 f,d,indx : integer;
begin
 indx:=1;
 if _show then
   indx:=0;
 for f:=0 to 3 do
   for d:=0 to 3 do
     if klocek[d,f]=1 then
       drawimage(mywindow^.rport,@myimage[indx],(x+f-1)*CEGLAX,(y+d-1)*CEGLAY);
end;

function sprawdz_plansze(klocek : tetris_block;
                         x,y    : integer) : boolean;
var
 _stop : boolean;
 f,d   : integer;
begin
  _stop:=false;
  for f:=0 to 3 do                     { czy klocek dotarî do dna }
    for d:=0 to 3 do
      if (klocek[d,f]=1) and (y+d>=ynochr) then
        _stop:=true;
  for f:=0 to 3 do                     { czy klocek jest na innym klocku }
    for d:=0 to 3 do
      if (klocek[d,f]=1) and (plansza[y+d+1,x+f]=1) then
        _stop:=true;
  sprawdz_plansze:=_stop;
end;

function sprawdz_klocek(klocek : tetris_block;
                        x,y    : integer) : boolean;
var
 _ok : boolean;
 f,d : integer;
begin
  _ok:=true;
  for f:=0 to 3 do                { czy klocek jest poza dolna lub gorna ramka }
    for d:=0 to 3 do
      if (klocek[d,f]=1) and ((y+d>YNOCHR) or (y+d<1)) then
        _ok:=false;
  for f:=0 to 3 do                { czy klocek jest poza prawa lub lewa ramka }
    for d:=0 to 3 do
      if (klocek[d,f]=1) and ((x+f>XNOCHR) or (x+f<1)) then
        _ok:=false;
  for f:=0 to 3 do                { czy klocek nie nachodzi na inny klocek }
    for d:=0 to 3 do
      if (klocek[d,f]=1) and (plansza[y+d,x+f]=1) then
        _ok:=false;
  sprawdz_klocek:=_ok;
end;

const
 WBFRAME = 4;
 OFFY    = 11;

function skasuj_wiersz : integer;
var
 _end,_del : boolean;
 f,y,lines : integer;
begin
  lines:=0;
  y:=YNOCHR;
  repeat
    _del:=true;
    _end:=true;
    for f:=1 to XNOCHR do
      if plansza[y,f]=0 then
        _del:=false
      else
        _end:=false;
    if _del then
    begin
      scrollraster(mywindow^.rport,0,-CEGLAY,WBFRAME,OFFY,
                   WBFRAME+CEGLAX*XNOCHR-1,OFFY+CEGLAY*y-1);
      for f:=y-1 downto 1 do
        move(plansza[f],plansza[f+1],XNOCHR);
      inc(lines);
    end
    else
      dec(y);
  until (y=0) or _end;
  skasuj_wiersz:=lines;
end;

procedure uaktualnij_plansze(klocek : tetris_block;
                             x,y    : integer);
var
 f,d : integer;
begin
  for f:=0 to 3 do
    for d:=0 to 3 do
      if klocek[d,f]=1 then
        plansza[y+d,x+f]:=1;
end;

const
 NOITEMS = 7;
 klocki  : array [1..NOITEMS,1..4] of tetris_block =
   ((((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)),
     ((0,1,0,0),(0,1,0,0),(0,1,0,0),(0,1,0,0))),
    (((0,0,0,0),(1,1,1,0),(0,0,1,0),(0,0,0,0)),
     ((0,1,0,0),(0,1,0,0),(1,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,1,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)),
     ((1,1,0,0),(0,1,0,0),(0,1,0,0),(0,0,0,0)),
     ((0,0,1,0),(1,1,1,0),(0,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,0,0),(1,1,0,0),(0,1,1,0),(0,0,0,0)),
     ((0,0,1,0),(0,1,1,0),(0,1,0,0),(0,0,0,0)),
     ((0,0,0,0),(1,1,0,0),(0,1,1,0),(0,0,0,0)),
     ((0,0,1,0),(0,1,1,0),(0,1,0,0),(0,0,0,0))),
    (((0,0,0,0),(0,1,1,0),(1,1,0,0),(0,0,0,0)),
     ((0,1,0,0),(0,1,1,0),(0,0,1,0),(0,0,0,0)),
     ((0,0,0,0),(0,1,1,0),(1,1,0,0),(0,0,0,0)),
     ((0,1,0,0),(0,1,1,0),(0,0,1,0),(0,0,0,0))),
    (((0,0,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
     ((0,1,0,0),(1,1,0,0),(0,1,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),(0,1,1,0),(0,1,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))));
var
 score : integer;

procedure zamknij_okno;
const
 MYLOOP = 4600;
var
 imessage           : pintuimessage;
 code               : integer;
 f,d                : integer;
 _quit,_move,_drop  : boolean;
 _yes,_start        : boolean;
 pozx,pozy,angle    : integer;
 oldx,oldy,oldangle : integer;
 counter,number     : integer;
begin
  score:=0;                                                          { 01 }
  for f:=1 to YNOCHR do
    for d:=1 to XNOCHR do
      plansza[f,d]:=0;
  counter:=MYLOOP;
  pozy:=1;
  _quit:=false;
  _start:=true;
  randomize;
  repeat
    if _start then                                                   { 02 }
    begin
      pozx:=XNOCHR div 2;
      number:=random(NOITEMS)+1;
      angle:=1;
      _drop:=false;
      _start:=false;
    end;
    oldx:=pozx;                                                      { 03 }
    oldy:=pozy;
    oldangle:=angle;
    _move:=false;
    imessage:=pintuimessage(getmsg(mywindow^.userport));             { 04 }
    if imessage<>nil then                                            { 05 }
    begin
      code:=imessage^.code;
      replymsg(pmessage(imessage));
      if _drop=false then
      begin                                                          { 06 }
        case chr(code) of
          #27 : _quit:=true;
          'a' : if sprawdz_klocek(klocki[number,angle],pozx-1,pozy) then
                  dec(pozx);
          's' : if sprawdz_klocek(klocki[number,angle],pozx+1,pozy) then
                  inc(pozx);
          ' ' : begin
                  f:=angle+1;
                  if f>4 then
                    f:=1;
                  if sprawdz_klocek(klocki[number,f],pozx,pozy) then
                    angle:=f;
                end;
          #13 : _drop:=true;
        end;
        _move:=true;                                                 { 07 }
      end;
    end;
    if (counter=MYLOOP) or _drop then                                { 08 }
      inc(pozy);
    if (counter=MYLOOP) or _move or _drop then                       { 09 }
    begin
      pokaz_klocek(klocki[number,oldangle],oldx,oldy,false);
      pokaz_klocek(klocki[number,angle],pozx,pozy,true);
      if sprawdz_plansze(klocki[number,angle],pozx,pozy) then        { 10 }
      begin
        uaktualnij_plansze(klocki[number,angle],pozx,pozy);
        score:=score+10*skasuj_wiersz;
        pozy:=1;
        _start:=true;
      end;
    end;
    if counter=MYLOOP then                                           { 11 }
      counter:=0;
    inc(counter);
  until _quit;                                                       { 12 }
  closewindow(mywindow);
end;

const
 obrazek : array [0..1,1..CEGLAY] of word =
  (($FFFC,$FFFC,$FFFC,$FFFC,$FFFC,$FFFC,$FFFC,$C000),
   ($0003,$3FFF,$3FFF,$3FFF,$3FFF,$3FFF,$3FFF,$3FFF));
var
 my_title : string;

procedure otworz_okno;
var
 prewin : tnewwindow;
begin
  my_title:=' IZ Tetris 1.0 '+#0;
  with prewin do
  begin
    leftedge    :=0;
    topedge     :=0;
    width       :=WBFRAME*2+XNOCHR*CEGLAX;
    height      :=OFFY+YNOCHR*CEGLAY+WBFRAME;
    detailpen   :=1;
    blockpen    :=2;
    idcmpflags  :=VANILLAKEY;
    flags       :=SMART_REFRESH or NOCAREREFRESH or ACTIVATE or WINDOWDRAG
                  or WINDOWDEPTH;
    firstgadget :=nil;
    checkmark   :=nil;
    title       :=@my_title[1];
    screen      :=nil;
    bitmap      :=nil;
    minwidth    :=0;
    minheight   :=0;
    maxwidth    :=0;
    maxheight   :=0;
    type_       :=WBENCHSCREEN;
  end;
  mywindow:=openwindow(@prewin);
end;

begin
  intuitionbase:=pintuitionbase(oldopenlibrary('intuition.library'));
  openintuition;
  gfxbase:=pgfxbase(oldopenlibrary('graphics.library'));
  with myimage[0] do
  begin
    leftedge   :=WBFRAME;
    topedge    :=OFFY;
    width      :=CEGLAX;
    height     :=CEGLAY;
    depth      :=2;
    imagedata  :=@obrazek;
    planepick  :=3;
    planeonoff :=0;
    nextimage  :=nil;
  end;
  with myimage[1] do
  begin
    leftedge   :=WBFRAME;
    topedge    :=OFFY;
    width      :=CEGLAX;
    height     :=CEGLAY;
    depth      :=2;
    imagedata  :=nil;
    planepick  :=0;
    planeonoff :=0;
    nextimage  :=nil;
  end;
  otworz_okno;
  zamknij_okno;
  closelibrary(plibrary(intuitionbase));
  closelibrary(plibrary(gfxbase));
  writeln;
  writeln('     Remember to subscribe IMAZINE');
  writeln;
  writeln('  your score : ',score);
  writeln;
end.