uses Graph, CRT;

var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;

Towers:array[0..2,1..2] of integer;
Current:integer;
Move:boolean;
MoveIndex:integer;
RSIndex:integer;
C:Byte;
Procedure DrawTower(ID:integer);
var
 Index:integer;
 Count:integer;
begin
 if ID=Current then begin
   if Move then
     SetColor(4)
   else
     SetColor(3);
 end
 else
   SetColor(15);
 Count:=0;
 for Index:=0 to 4 do begin
   if Towers[ID,Index]<>0 then begin
     Rectangle(150+ID*160-Towers[ID,Index]*10,380-Index*20,170+ID*160+Towers[ID,Index]*10,400-Index*20);
     inc(Count);
   end
   else
     Break;
 end;
 Rectangle(150+ID*160,200,170+ID*160,400-Count*20);
end;

Procedure NewGame;
begin
  Towers[0,0]:=5;
  Towers[0,1]:=4;
  Towers[0,2]:=3;
  Towers[0,3]:=2;
  Towers[0,4]:=1;
  Towers[1,0]:=0;
  Towers[1,1]:=0;
  Towers[1,2]:=0;
  Towers[1,3]:=0;
  Towers[1,4]:=0;
  Towers[2,0]:=0;
  Towers[2,1]:=0;
  Towers[2,2]:=0;
  Towers[2,3]:=0;
  Towers[2,4]:=0;
  Move:=false;
  Current:=0;
end;

var
 Index:integer;
begin
grDriver := Detect;
InitGraph(grDriver, grMode,' ');
ErrCode := GraphResult;
if ErrCode = grOk then
begin  { Do graphics }
  NewGame;
  while C<>#27 do begin
    ClearDevice;
    SetColor(15);
    OutTextXY(0,0,'Esc - Exit. N - New Game. Left/Right - Move. Space - Select');
    OutTextXY(0,20,'Create by @!!ex. Samara 2007');
    DrawTower(0);
    DrawTower(1);
    DrawTower(0);
    C:=Readkey;
    if C=#0 then begin
      C:=ReadKey;
      if C=#75 then begin
        if Current>0 then begin
          dec(Current);
         if Move then begin
           Move:=False;
           RSIndex:=-1;
           for Index:=0 to 4 do
             if Towers[Current,Index]<>0 then
               RSIndex:=Index;
           if (RSIndex=-1) or (Towers[Current+1,MoveIndex]<Towers[Current,RSIndex]) then begin
             Towers[Current,RSIndex+1]:=Towers[Current+1,MoveIndex];
             Towers[Current+1,MoveIndex]:=0;
           end;
         end;
       end;
      end;
      if C=#77 then begin
        if Current<2 then begin
          inc(Current);
         if Move then begin
           Move:=False;
           RSIndex:=-1;
           for Index:=0 to 4 do
             if Towers[Current,Index]<>0 then
               RSIndex:=Index;
           if (RSIndex=-1) or (Towers[Current-1,MoveIndex]<Towers[Current,RSIndex]) then begin
             Towers[Current,RSIndex+1]:=Towers[Current-1,MoveIndex];
             Towers[Current-1,MoveIndex]:=0;
           end;
         end;
      end;
    end;
    end;
    if (C=#32) and (Towers[Current,0]<>0) then begin
      for Index:=0 to 4 do
        if Towers[Current,Index]<>0 then
          MoveIndex:=Index;
      Move:=true;
    end;
    if (C='N') or (C='n') then
      NewGame;
  end;
  CloseGraph;
end
else
  Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end.

Towers:array[0..2,0..4] of integer;

DrawTower(0)

DrawTower(3)