PROGRAM Escape;

(* v.0.12 (c) Karl A. Brokstad 2018,19 *)

(* Init program *)

var map : array [1..80, 1..25] of byte;

    mex : integer;   (* location of me *)
    mey : integer;

    ghosts : integer;                     (* number of ghosts *)
    ghostx : array [1..100] of integer;   (* locations of ghosts *)
    ghosty : array [1..100] of integer;

    seed : integer; (* for random generator *)
    level : integer;
    time : integer;

    inp : char;   (* input, direction and status *)
    dir : char;
    status : integer;

    x, y, z : integer;
   
    ego, ghost, wall, stone, Xin, Xout : char;

(* * * * * * * * * @BDOS * * * * * * * * * * * * * * *)

external
   function @BDOS (Func : integer; Para : word) : integer; 

(* * * * * * * * DELAY  * * * * * * * * * * * * * *)

procedure delay (d : integer);
var i,j : integer;
begin
     for i := 1 to d do 
        begin
           j := i*i ;
        end;
end;

(* * * * * * * * * KEYPRESSED * * * * * * * * * * * *)

function keypressed : boolean;
begin
  keypressed := (@BDOS(11, wrd(0)) <> 0)
end;

(* * * * * * * * * CONIN * * * * * * * * * * * *)

function conin : char;
begin
   conin := chr(@BDOS(1, wrd($FF))); (* READ CHARACTER *)
end;

(* * * * * * * * * CONOUT * * * * * * * * * * * *)

procedure conout ( c : char);
var r : integer;
begin
   r := @BDOS(2, wrd(c));
end;

(* * * * * * * * * CLRSCR * * * * * * * * * * * *)

procedure clrscr;
begin
   {  ESC, [2J }
   write(chr(27),'[2J');
end;

(* * * * * * * * * gotoXY * * * * * * * * * * * *)

procedure gotoXY (x, y : byte);
begin
   { Go to coordinate x,y }
   {  ESC, y ; x, H  }
   { write(chr(27), chr(48+y), ';', chr(48+x), 'H') }
   write(chr(27),'[',y,';',x,'H')  
end;

(* * * * * * * * * RANDOM * * * * * * * * * * * * *)

Function Random (s: integer) : byte;
var a,b,c,d: integer;
Begin
    d := d + 1;
    a := (s * d) div 16;
    b := (s * d) mod 16;
    c := a + b + d;
    c := a * b * c;
    Random := c div 7;
End;

(* * * * * * * * Show Splash Screen * * * * * * * * *)

Procedure SplashScreen;
Begin

   clrscr;

   gotoXY(20,5);
   writeln('ESCAPE v0.12');
   gotoXY(20,6);
   writeln('(c) 2018-19, Karl A. Brokstad');
   gotoXY(20,7);
   writeln('www.Z80.no');
   gotoXY(20,10);
   writeln('requirements:'); 
   gotoXY(20,11);
   writeln('ANSI/VT100 compatible console');
   gotoXY(20,12);
   writeln('screen size 80x25');
   gotoXY(10,13);
   writeln('You= ',ego,' Wall= ',wall,'  Stone= ',stone,'  Entrance= ',Xin,'  Exit= ',Xout,'  Ghost= ',ghost);
   gotoXY(20,15);
   writeln('movement:');
   gotoXY(20,16);
   writeln('Z = left, X = up');
   gotoXY(20,17);
   writeln('N = down, M = right');
   gotoXY(20,18);
   writeln('ESC = quit');
   gotoXY(20,20);
   writeln('press RETURN to START');

   repeat
      inp := conin;       {chr(@BDOS(1, wrd($FF)));} (* READ CHARACTER *)
   until inp = chr(13);
End;

(* * * * * * * * * * * Init Map * * * * * * * * * * *)

Procedure InitMap;
    var x,y : integer;
Begin
   for x := 1 to 80 do 
      begin
      for y := 1 to 25 do
         begin
            map[x,y]:= 32;   (* empty space = 32 *)
         end;
      end;
End;

(* * * * * * * * * * * Generate Map * * * * * * * * *)

Procedure MakeMap;
    var x,y,z : integer;
    finished : boolean;
    g : integer;         (* number of ghosts *)
    
Begin

    (* Make Frame *)
    
  for x := 1 to 80 do 
    begin
      map[x, 1] := 35;      (* wall chr(35) = hash *)
      map[x, 2] := 35; 
      map[x, 24] := 35;
      map[x, 25] := 35;
    end;

  for y := 1 to 10 do
    begin
      map[1, y] := 35;
      map[2, y] := 35;
      map[79, y] := 35;
      map[80, y] := 35;      
    end;

  for y := 11 to 15 do      (* door in/out  *)
    begin
      map[1, y] := 62;        (*  > enter *)
      map[80, y] := 58;       (*  : exit *)
    end;     
 
  for y := 16 to 25 do
    begin
      map[1, y] := 35;
      map[2, y] := 35;
      map[79, y] := 35;
      map[80, y] := 35;
    end;
 
      (* Put Random Stones on the map *)

  for z := 1 to 25 do 
    begin
      seed := seed + 1;
      finished := false;

      repeat          (* place a stone *)
        repeat 
          x := random(seed);
          seed := seed + 1;
        until (x>3) and (x<77);

        repeat
          y := random(seed);
          seed := seed + 1;
        until (y>3) and (y<23);

        if (map[x,y] = 32) then 
          begin
            map[x,y] := 38;     (* stone chr(38) "and" sign *)
            finished := true;
        end;
      until finished = true;
    end; (* for end *)

        (*  make ghosts *)

  g := level - 1;
  if (g>10) then g:=10;

  if (g > 0) then
    begin
      for z := 1 to g do
        begin 
          repeat                        (* find ghost position *)
            repeat
              x := random(seed);
              seed := seed + 1;
            until (x>3) and (x<77);

            repeat
              y := random(seed);
              seed := seed + 1;
            until (y>3) and (y<23);
          until ( map[x,y] = 32 );

          ghostx[z] := x;         (* add position of ghost *)
          ghosty[z] := y;
          map[x,y] := 36;         (* ghost is dollar sign *)
          gotoXY(x,y);            (* show ghost *)
          conout('$');
          gotoXY(1,1);            (* park cursor *)
        end; (* for end *)
    end; (* if end *)

End;

(* * * * * * * * * * * Show Map * * * * * * * * * * *)

Procedure ShowMap;
    var x,y : integer;
        c : char;
Begin
   clrscr;

   for x := 1 to 80 do 
      begin
      for y := 1 to 25 do
         begin
            gotoXY (x, y);
            c := chr(map[x, y]);

            if (c=chr(32)) then conout(c);     (* space *)
           
            if (c=chr(35)) then      (* wall *)
              begin
                write(chr(27),'[43m');      (* yellow background *)
                write(chr(27),'[35m');      (* magneta text *)
                conout(c);  
                write(chr(27),'[0m');       { reset colors }
              end;

            if (c=chr(38)) then      (* stone *)
              begin
                write(chr(27),'[43m');      (* yellow background *)
                write(chr(27),'[35m');      (* magneta text *)
                conout(c);  
                write(chr(27),'[0m');       { reset colors }
              end;

            if (c=chr(36)) then      (* ghost *)
              begin
                write(chr(27),'[31m','$');  { write('$'); red text }
              end;

         end;
      end;
End;


(* * * * * * * * * * * Move Ghosts * * * * * * * * * * *)
(* * * * * * * * * * * Game Logic * * * * * * * * * * * *)

Procedure MoveGhost;
    var i,j,k : integer;
        flag : integer;
        c : char;

begin   (*B1*)
  for i := 1 to ghosts do
    begin    (*B2*)
          
      flag := 0;
      j := ghostx[i];  (* X *)
      k := ghosty[i];  (* Y *)
      c := chr(32);
      
      (* X- left *)
  
      if (j > mex) and (flag = 0) then
        begin                                        (*B4*)
          if (map[j-1,k] = 32) then                  (* OK move *)
            begin                                    (*B5*)
              map[j,k] := 32;                        (* clear ghost position *)
              gotoXY(j,k);
              conout(' ');
              j := j - 1;
              ghostx[i] := j;                        (* move ghost *)
              map[j,k] := 36;                        (* new position *)
              gotoXY(j,k);
              write(chr(27),'[31m','$');  { write('$'); red text }
              write(chr(27),'[0m');       { reset colors }
              flag := 1;
              gotoXY(1,1);                           (* park cursor *)
            end                                      (*E5*)
            else begin                               (*B6*)
              if (map[j-1,k] = 64) then
                begin 
                  flag := 99;
                  status := 3;
                end;
            end;                                     (*E6*)
        end;                                         (*E4*)
 
      (* X+ right *)
  
      if (j < mex) and (flag = 0) then
        begin                                        (*B4*)
          if (map[j+1,k] = 32) then                  (* OK move *)
            begin                                    (*B5*)
              map[j,k] := 32;                        (* clear ghost position *)
              gotoXY(j,k);
              conout(' ');
              j := j + 1;
              ghostx[i] := j;                        (* move ghost *)
              map[j,k] := 36;                        (* new position *)
              gotoXY(j,k); 
              write(chr(27),'[31m','$');  { write('$'); red text }
              write(chr(27),'[0m');       { reset colors }
              flag := 1;
              gotoXY(1,1);                           (* park cursor *)
            end
            else begin                               (*B6*)
              if (map[j+1,k] = 64) then
                begin 
                  flag := 99;
                  status := 3;
                end;  
              end;                                  (*E6*)
        end;                                        (*E4*)
 
      (* Y- up *)

      if (k > mey) and (flag = 0) then
        begin                                        (*B4*)
          if (map[j,k-1] = 32) then                  (* OK move *)
            begin                                    (*B5*)
              map[j,k] := 32;                        (* clear ghost position *)
              gotoXY(j,k);
              conout(' ');
              k := k - 1;
              ghosty[i] := k;                        (* move ghost *)
              map[j,k] := 36;                        (* new position *)
              gotoXY(j,k); 
              write(chr(27),'[31m','$');  { write('$'); red text }
              write(chr(27),'[0m');       { reset colors }
              flag := 1;
              gotoXY(1,1);                           (* park cursor *)
            end                                      (*E5*)
            else begin                               (*B6*)
              if (map[j,k-1] = 64) then
                begin 
                  flag := 99;
                  status := 3;
                end; 
              end;                                   (*E6*)          
        end;                                         (*E4*)

      (* Y+ down *)

      if (k < mey) and (flag = 0) then
        begin                                        (*B4*)
          if (map[j,k+1] = 32) then                  (* OK move *)
            begin                                    (*B5*)
              map[j,k] := 32;                        (* clear ghost position *)
              gotoXY(j,k);
              conout(' ');
              k := k + 1;
              ghosty[i] := k;                        (* move ghost *)
              map[j,k] := 36;                        (* new position *)
              gotoXY(j,k); 
              write(chr(27),'[31m','$');  { write('$'); red text }
              write(chr(27),'[0m');       { reset colors }
              flag := 1;
              gotoXY(1,1);                           (* park cursor *)
            end                                      (*E5*)
            else begin                               (*B6*)
              if (map[j,k+1] = 64) then
                begin 
                  flag := 99;
                  status := 3;
                end;    
              end;                                   (*E6*)
        end;                                         (*E4*)

    end;    (*E2*)
  if flag = 99 then
    begin
      for i := 1 to 5 do 
        begin
          gotoXY(mex,mey);
          conout(' ');
          delay(1000);
          gotoXY(mex,mey);
          write(chr(27),'[32m','@');  { write('@'); }
          write(chr(27),'[0m');       { reset colors }
          delay(1000);
        end;
    end;
end;    (*E1*)

(* * * * * * * * * * Start Main Part * * * * * * * * * *)

Begin (* Start Main Part *)

  ego := chr(64);
  ghost := chr(36);
  wall := chr(35);
  stone := chr(38);
  Xin := chr(62);
  Xout := chr(58);

  level := 1;
  ghosts := level - 1;

  SplashScreen;  

  repeat (* Start Main Loop *)

      (* Set up Board *)

    time := 3000;
    status := 0;
    ghosts := level - 1;    

    clrscr;

    InitMap;
    
    MakeMap;

      (* Init Gane *)

    ShowMap;
    
      (* show position and count down *)

    gotoXY(35,1);
    write(' Level : ',level,' ');
    
    mex := 2;     (* start position *)
    mey := 13;
    x := mex;
    y := mey;
                   (* count down *)
    gotoXY(x,y);
    write(chr(27),'[32m','3');  { write('3'); }
    delay(5000);
    gotoXY(x,y);
    write(chr(27),'[32m','2');  { write('2'); }
    delay(5000);
    gotoXY(x,y);
    write(chr(27),'[32m','1');  { write('1'); }
    delay(5000);
    gotoXY(x,y);
    write(chr(27),'[32m','0');  { write('0'); }
    delay(5000);
    gotoXY(x,y);
    write(chr(27),'[32m','@');  { write('@'); }
    write(chr(27),'[0m');       { reset colors }

    gotoXY(1,1);   { park cursor }

    
    repeat (* Game Start *)
    
      (* Check for Movements *)

      delay(time);          (* set delay in game *)
      seed := seed + 1;     (* increase seed for random generator *)
      if seed > 32000 then seed := 1;
      
      if keypressed then                            (* READ KEYBOARD/INPUT *)
        begin
          inp := conin;      { chr(@BDOS(1, wrd($FF))); }

          case inp of                (* read directions *)
            'z','Z' : dir := 'L';    (* left *)
            'x','X' : dir := 'U';    (* right *)
            'n','N' : dir := 'D';    (* down *)
            'm','M' : dir := 'R';    (* up *)
            'q','Q' : dir := 'Q';    (* QUIT *)
            '-'     : time := time + 100;
            '+'     : time := time - 100; 
          end;

          while keypressed do
            inp := conin;      { chr(@BDOS(1, wrd($FF))); }    (* CLEAR INPUT BUFFER *)
          end;

          x := mex;
          y := mey;

          case dir of                                (* MOVE DIRECTION *)
            'L' : x:=x-1;    (* left *)
            'R' : x:=x+1;    (* right *)
            'D' : y:=y+1;    (* down *)
            'U' : y:=y-1;    (* up *)
          end;
 
            (* What do do with the movement *)
               
          case map[x,y] of
            35, 38, 62 : status := 1;   (* no movement, wall-stone-start *)
            58         : status := 2;   (* exit, finished level *)
            36         : status := 3;   (* chrash in ghost, game over *)
            0, 32      : status := 4;   (* move OK *)
          end;
 
          if status = 1 then    (* don't do anything *)
            begin
              seed := seed + 1; 
            end; 
          
          if status = 2 then    (* exit level *)
            begin
              seed := seed + 1;
              level := level + 1; 
            end; 
        
          if status = 3 then    (* game over *)
            begin
              seed := seed + 1; 
            end; 
                    
          if status = 4 then    (* valid move *)
            begin
              seed := seed + 1;
              map[mex,mey] := 32;       (* clear previous position *)
              gotoXY(mex,mey);
              conout(' ');
              mex := x;                 (* show new position *)
              mey := y;
              map[mex,mey] := 64;       
              gotoXY(mex,mey); 
              write(chr(27),'[32m','@');  { write('@'); }
              write(chr(27),'[0m');       { reset colors }

              gotoXY(1,1);              (* park cursor *)
            end;

        (* MOVE GHOSTS *)
        
        ghosts := level - 1 ;
        if (ghosts > 0) and (ghosts <11) then
          begin        
            MoveGhost;
          end

    until ( status = 2 ) or ( status = 3 ) or ( dir ='Q' )


  until ( status = 3 ) or ( dir = 'Q' ); (* End Main Loop: Game Over *)
    
    (* Clean Up and Exit Game or Restart *)
  if status = 3 then
    begin
      gotoXY(30,10);
      write(' - You Lost, GAME OVER - ');
      gotoXY(30,12);
      write(' press return to exit ');
    end
    else
      begin 
        gotoXY(30,10);
        write(' - QUIT - ');
        gotoXY(30,12);
        write(' press return to exit ');
      end;

  repeat
    inp := conin         {chr(@BDOS(1, wrd($FF)));} (* READ CHARACTER *)
  until inp = chr(13);

  clrscr;

    (* Game End *)
End.