Uses Knihovna,KeHre,Graph,Crt,B_P2,B_P4;
Type
  Pozice=record
    x:integer;
    y:integer;
End;
Var i,o,p:integer;
    Level:byte;
    Hrac:array[1..1] of Pozice;
    Pole:array[1..31,1..20] of Char;
    Pole2:array[1..31,1..20] of boolean;
    Mapa:array[0..12] of string;
    Teleport:array[1..20] of pozice;
    Teleportu:byte;
    Sebrano:byte;
    Konec:byte;
    Lev:array[0..12] of Char;
    F:file of char;
    G:char;
Label Pres,Start;
(***************************************************************************)
Procedure Kurzor;
  const s=20;
  Var x,y:Integer;
  Begin
    setcolor(7);
    X:=Hrac[1].x*s-s+1;
    Y:=Hrac[1].y*s-s+31;
    setfillstyle(1,4);
    fillellipse(x+10,y+10,4,4);
  End;
(***************************************************************************)
Procedure Objekt(X,Y,Typ:integer);
  const s=20;
  Label Pres;
  Begin
    If (Pole2[X,Y]=false) or (y=0) or (x=0) then Begin
    If (Typ <>0) and (y<>0) and (x<>0) then Pole2[X,Y]:=true;
    If Y=0 then Begin
     X:=255;
     Y:=443;
    End Else If x=0 then Begin
     If y=27 then Begin
       x:=247+25;
       y:=9*25+102;
       Typ:=4;
     End;
     If (y>=24) and (y<=26) then Begin
       y:=(y-15)*25+102;
       x:=247;
     End;
     If (y>=22) and (y<=23) then Begin
       x:=247-(y-23)*25;
       y:=8*25+102;
     End;
     If (y=21) Then Begin
       y:=(y-14)*25+102;
       x:=247;
     End;
     If (y=20) then Goto Pres;
     If (y=19) Then Begin
       y:=(y-13)*25+102;
       x:=247;
     End;
     If (y>=13) and (y<=18) Then Begin
       x:=247+125-(y-13)*25;
       y:=5*25+102;
     End;
     If (y>=7) and (y<=12) then Begin
       x:=247+(y-7)*25;
       y:=4*25+102;
     End;
     If (y>=4) and (y<=6) then goto Pres;
     If (y<=3) then Begin
       y:=y*25+102;
       x:=247;
     End;
    End Else Begin
     X:=X*s-s+1;
     Y:=Y*s-s+31;
    End;
    If Typ=0 Then Begin
      SetFillStyle(1,0);
      Setcolor(0);
      Bar(x,y,x+s,y+s);
    End Else Begin
      SetColor(8);
      Rectangle(X,Y,X+s,Y+s);
      Case Typ of
     1,20: Begin (*prazdno*)
             Setfillstyle(1,0);
             Bar(x+1,y+1,x+19,y+19);
           End;
        2: Begin (*stena*)
             Setcolor(15);
             Line(x+1,y+1,x+19,y+1);
             Line(x+1,y+2,x+19,y+2);
             Line(x+1,y+1,x+1,y+18);
             Line(x+2,y+1,x+2,y+18);
             Setcolor(8);
             Line(x,y+s-1,x+s,y+s-1);
             Line(x+s-1,y+2,x+s-1,y+s);
             SetfillStyle(1,7);
             Bar(x+2,y+2,x+s-2,y+s-2);
           End;
       19: Begin (*c¡l*)
             setcolor(4);
             setfillstyle(1,8);
             Bar(x+1,y+1,x+s-1,y+s-1);
             Rectangle(x+1,y+1,x+s-1,y+s-1);
             Line(x+4,y+4,x+16,y+16);
             Line(x+16,y+4,x+4,y+16);
           End;
    7..12: Begin (*zamky*)
             Setcolor(7);
             Line(x+1,y+1,x+19,y+1);
             Line(x+1,y+2,x+19,y+2);
             Line(x+1,y+1,x+1,y+18);
             Line(x+2,y+1,x+2,y+18);
             Setcolor(8);
             Line(x,y+s-1,x+s,y+s-1);
             Line(x+s-1,y+2,x+s-1,y+s);
             SetfillStyle(1,15);
             Bar(x+2,y+2,x+s-2,y+s-2);
             Case Typ of
                7:setcolor(12);
                8:setcolor(9);
                9:setcolor(2);
               10:setcolor(8);
               11:setcolor(6);
               12:setcolor(5);
             End;
             Rectangle(x+4,y+8,x+16,y+16);
             PieSlice(x+10,y+8,0,180,4);
             circle(x+10,y+11,1);
             line(x+10,y+11,x+10,y+13);
           End;
   13..18: Begin (*klice*)
             Setfillstyle(1,0);
             Bar(x+1,y+1,x+19,y+19);
             Case Typ of
               18:setcolor(12);
               17:setcolor(9);
               16:setcolor(2);
               15:setcolor(8);
               14:setcolor(6);
               13:setcolor(5);
             End;
             circle(x+10,y+6,3);
             line(x+10,y+9,x+10,y+17);
             line(x+10,y+13,x+12,y+13);
             line(x+10,y+16,x+12,y+16);
           End;
    25,23: Begin (*voda*)
             SetFillStyle(1,9);
             Bar(x+1,y+1,x+19,y+19);
             If Typ=23 then Begin
               setcolor(8);
               line(x+1,y+4,x+19,y+4);
               line(x+1,y+10,x+19,y+10);
               line(x+1,y+16,x+19,y+16);
             End;
           End;
     24,4: Begin (*prepinac*)
             Setfillstyle(1,0);
             Bar(x+1,y+1,x+19,y+19);
             setFillStyle(1,7);
             if typ=24 then Bar(x+4,y+4,x+16,y+6);
             if typ=4 then Bar(x+4,y+15,x+16,y+13);
             Setcolor(7);
             Line(x+7,y+6,x+7,y+13);
             Line(x+13,y+6,x+13,y+13);
           End;
       22: Begin (*lavka*)
             SetFillStyle(1,6);
             Bar(x+1,y+1,x+19,y+19);
             setcolor(8);
             line(x+1,y+4,x+19,y+4);
             line(x+1,y+10,x+19,y+10);
             line(x+1,y+16,x+19,y+16);
           End;
        3: Begin (*bedna*)
             SetFillStyle(9,6);
             Bar(x+1,y+1,x+19,y+19);
             setcolor(6);
             Rectangle(x+1,y+1,x+19,y+19);
           End;
       26: Begin (*drevo*)
             Setfillstyle(1,0);
             Bar(x+1,y+1,x+19,y+19);
             setcolor(6);
             Line(x+4,y+10,x+10,y+4);
             Line(x+4,y+10,x+8,y+14);
             Line(x+10,y+4,x+17,y+4);
             Line(x+8,y+14,x+17,y+5);
             setfillstyle(1,6);
             FloodFill(x+10,y+6, 6);
           End;
       21: Begin (*teleport*)
             setfillstyle(1,0);
             Bar(x+1,y+1,x+19,y+19);
             Setcolor(14);
             Circle(x+10,y+10,8);
             setcolor(12);
             Circle(x+10,y+10,4);
             putpixel(x+10,y+10,14);
           End;
      End;
    End;
    End;
Pres:
  End;
(***************************************************************************)
Procedure Odkryj(X,Y:integer); forward;
(***************************************************************************)
Procedure Seber(X:byte);
  Begin
    Objekt(1,0,x);
  End;
(***************************************************************************)
Procedure Prvky;
  Var i:byte;
  Begin
    For i:=1 to 27 do Begin
     Objekt(0,i,i);
    End;
  End;
(***************************************************************************)
Procedure NactiMapu(Level: byte);
  Var z:file of char;
      s:string;
      i,o:integer;
      a:char;
  Begin
    Str(Level,s);
    B_P2.napistext(0,0,Mapa[Level],1);
    B_P4.napistext(112,0,s+'. - ',1);
    s:='Level'+s+'.mpk';
    Assign(z,s);Reset(z);
    Teleportu:=0;
    For i:=1 to 20 do
       For o:=1 to 31 do Begin
         Read(z,a);
         Pole[o,i]:=a;
         Pole2[o,i]:=false;
         Objekt(o,i,0);
         if a='T' then begin
           Hrac[1].x:=o;Hrac[1].y:=i;
         End;
       (**)
    End;
    Read(z,a);
    s:='';
    while not eof(z) do Begin
      read(z,a);
      If a='U' then Begin
        Val(s,i,o);
        Teleportu:=Teleportu+1;
        Teleport[Teleportu].x:=i;
        s:='';
      End Else
      If a='#' then Begin
        Val(s,i,o);
        Teleport[Teleportu].y:=i;
        s:='';
      End Else s:=s+a;
    End;
    Close(z);
    Odkryj(Hrac[1].x,Hrac[1].y);
    Kurzor;Konec:=0;
    Sebrano:=0;
    Seber(0);
  End;
(***************************************************************************)
Procedure Odkryj(X,Y:integer);
  Begin
    If Y>1 Then Begin
      If X>1 then Objekt(x-1,y-1,Ord(Pole[x-1,y-1])-64);
      Objekt(x,y-1,Ord(Pole[x,y-1])-64);
      If X<31 then Objekt(x+1,y-1,Ord(Pole[x+1,y-1])-64);
    End;
    If X>1 then Objekt(x-1,y,Ord(Pole[x-1,y])-64);
    Objekt(x,y,Ord(Pole[x,y])-64);
    If X<31 then Objekt(x+1,y,Ord(Pole[x+1,y])-64);
    If Y<20 Then Begin
      If X>1 then Objekt(x-1,y+1,Ord(Pole[x-1,y+1])-64);
      Objekt(x,y+1,Ord(Pole[x,y+1])-64);
      If X<31 then Objekt(x+1,y+1,Ord(Pole[x+1,y+1])-64);
    End;
  End;
(***************************************************************************)
Procedure Pohyb(X,Y:integer);
  Var a,b,c,i,o:integer;
  Label Pres,Pres2;
  Begin
    a:=Hrac[1].x+x;
    b:=Hrac[1].y+y;
    c:=Ord(Pole[a,b])-64;
    If (c<>2) then Begin
      If ((c>=7) and (c<=12)) or (c=25) then Begin (*klice + drevo*)
        If (c<=12) and ((sebrano=0) or (Sebrano+c<>25)) then Goto pres;
        If (c=25) and (sebrano=0) then goto pres2;
        Pole[a,b]:='A';
        Pole2[a,b]:=false;
        Objekt(a,b,1);
        Sebrano:=0;Seber(0);
      End;
      If (c=24) or (c=4) then Begin (*prepinace*)
         If Pole[a,b]='X' then Pole[a,b]:='D' else Pole[a,b]:='X';
         Pole2[a,b]:=false;
         Objekt(a,b,Ord(Pole[a,b])-64);
         For i:=1 to 20 do
           For o:=1 to 31 do Begin
             If (Pole[o,i]='V') or (Pole[o,i]='W') Then Begin (*l vka,voda*)
               If Pole[o,i]='V' then Pole[o,i]:='W' else Pole[o,i]:='V';
               If Pole2[o,i]=True Then Begin
                 Pole2[o,i]:=false;
                 Objekt(o,i,Ord(Pole[o,i])-64);
               End;
             End;
           (**)
         End;
      End;
      If c=3 then Begin (*Bedna*)
        If (Pole[a+x,b+y]='A') or (Pole[a+x,b+y]='T') Then Begin
          Pole[a,b]:='A';
          Pole2[a,b]:=false;
          Pole[a+x,b+y]:='C';
          Pole2[a+x,b+y]:=false;
          Objekt(a+x,b+y,3);
        End Else Goto Pres;
      End;
      If c=21 then Begin (*Teleport*)
        odkryj (a,b);
        o:=(b-1)*31+a;
        Pole2[a-x,b-y]:=false;
        Objekt(a-x,b-y,Ord(Pole[a-x,b-y])-64);
        For i:=1 to Teleportu do Begin
           If Teleport[i].x=o then Begin
             o:=Teleport[i].y;
             i:=1;
             while o>31 do begin
               o:=o-31;
               i:=i+1;
             End;
             a:=o;
             b:=i;
             Break;
           End;
        End;
      End;
Pres2:
      Pole2[a-x,b-y]:=false;
      Objekt(a-x,b-y,ord(Pole[a-x,b-y])-64);
      Hrac[1].x:=a;
      Hrac[1].y:=b;
      Odkryj(a,b);
      Kurzor;
Pres:
      If Pole[a,b]='Y' then Konec:=1;
      If Pole[a,b]='W' then Konec:=1;
      If Pole[a,b]='S' then Konec:=2;
    End;
  End;
(***************************************************************************)
Begin
  Mapa[0]:='Uroven    Tutorial';
  Mapa[1]:='Uroven    Vodnik';
  Mapa[2]:='Uroven    Pozor bedna';
  Mapa[3]:='Uroven    Beem Up';
  Mapa[4]:='Uroven    Sklepeni';
  Mapa[5]:='Uroven    Dzabdzerb';
  Mapa[6]:='Uroven    Prepinac';
  Mapa[7]:='Uroven    Nezablud';
  Mapa[8]:='Uroven    Hloviznul';
  Mapa[9]:='Uroven    Pozor voda';
 Mapa[10]:='Uroven    Zmateni';
 Mapa[11]:='Uroven    Tezka volba';
 Mapa[12]:='Uroven    Vodni kralovstvi';
  Assign(F,'Levely.dat');
  Reset(F);
  For i:=0 to 12 do begin
    Read(f,g);
    Lev[i]:=g;
  End;
  Close(f);
  Grafika;
  Uvod;
  (*Uvod;*)
Start:
  i:=DejMenu;
  while i=-10 do Begin
    Prvky;
    i:=DejMenu;
  End;
  if i=20 then Begin
    Konec:=10;Goto Pres;
  End;
  Level:=i;
  ClearDevice;
  setcolor(7);
  Rectangle(0,30,622,432);
  B_P2.napisText(0,442,'Sebrany predmet',1);
  B_P4.napisText(232,441,':',1);
  NactiMapu(i);
  Repeat
    If Konec>0 Then Goto Pres;
    i:=Ord(Readkey);
    Case i of
      075:If Hrac[1].x>1 then Pohyb(-1,0);
      077:If Hrac[1].x<31 then Pohyb(1,0);
      072:If Hrac[1].y>1 then Pohyb(0,-1);
      080:If Hrac[1].y<20 then Pohyb(0,1);
      115:Begin (*sebrat*)
            If Sebrano=0 Then Begin
              o:=Ord(Pole[Hrac[1].x,Hrac[1].y])-64;
              if ((o>=13) and (o<=18)) or (o=26) Then Begin
                Sebrano:=o;
                Seber(o);
                o:=Hrac[1].x;p:=Hrac[1].y;
                Pole[o,p]:='A';
                Pole2[o,p]:=false;
                Objekt(o,p,1);
                Kurzor;
              End;
            End;
          End;
      102:Begin (*polozit*)
            If Sebrano>0 then Begin
              o:=Hrac[1].x;p:=Hrac[1].y;
              If (Pole[o,p]='A') or (Pole[o,p]='T') Then Begin
                Seber(0);
                Pole[o,p]:=Chr(sebrano+64);
                Pole2[o,p]:=false;
                Objekt(o,p,sebrano);
                Kurzor;
                Sebrano:=0;
              End;
            End;
          End;
       27:Begin
            Konec:=3;
            Goto Pres;
          End;
       98:Begin
            Konec:=11;
            Goto Pres;
          End;
    End;
  Until i<>i;
Pres:
  If Konec=2 Then Begin
    Vitez;
    Lev[Level]:='1';
    Assign(F,'Levely.dat');
    rewrite(F);
    For i:=0 to 12 do begin
      Write(f,Lev[i]);
    End;
    Close(f);
  End;
  If Konec=1 Then Utopil;
  If Konec<10 then goto Start;
  Ukonci;
End.