program Tiersuche_im_Feld;
uses Crt, CursorOnOff;
type TBuchQuadrat = array[1..20,1..20] of char;
const DesktopCol=2;
      Quadrat: TBuchQuadrat =
(('A','M','S','E','L','L','E','R','O','F','M','R','U','W','D','N','A','B','O','A'),
 ('L','E','G','I','U','H','E','G','N','A','L','H','C','S','N','A','N','D','U','L'),
 ('B','O','C','K','B','U','E','N','A','Y','H','O','R','N','I','S','S','E','H','L'),
 ('N','H','A','H','E','H','S','U','A','L','U','C','H','S','T','S','R','L','U','I'),
 ('R','P','N','E','Z','N','A','W','R','E','H','D','R','A','P','O','E','L','R','G'),
 ('E','A','I','E','R','E','W','I','E','S','E','L','R','E','C','H','L','I','U','A'),
 ('P','V','U','C','E','T','R','A','D','N','A','P','C','H','C','E','S','R','G','T'),
 ('I','I','G','H','T','S','O','B','N','A','L','H','S','S','O','C','T','G','N','O'),
 ('V','A','N','W','T','U','D','A','A','P','T','E','U','Z','Y','H','E','B','A','R'),
 ('M','N','I','A','A','G','N','R','R','M','I','M','S','I','O','T','R','L','K','H'),
 ('M','I','P','N','N','N','O','S','A','I','L','E','L','E','T','T','A','R','C','S'),
 ('E','U','L','R','S','A','K','C','W','H','T','T','N','G','E','M','A','S','U','H'),
 ('R','B','W','B','E','L','L','H','H','C','I','A','N','E','A','N','I','A','K','C'),
 ('E','B','B','E','E','I','E','E','E','S','S','U','T','O','I','F','R','N','C','V'),
 ('I','E','L','O','F','T','E','W','D','H','E','N','B','C','I','B','E','T','U','F'),
 ('H','V','M','L','R','F','O','G','O','V','E','R','H','A','O','P','D','I','K','A'),
 ('E','L','E','E','L','L','A','R','A','U','P','E','I','R','K','F','R','L','R','H'),
 ('R','E','G','E','L','E','N','M','K','N','W','E','S','P','E','A','A','O','A','C'),
 ('E','I','N','D','E','B','U','A','T','E','S','I','E','M','A','U','M','P','C','S'),
 ('T','F','L','O','W','P','A','N','T','H','E','R','N','R','E','T','S','E','E','S'));

var whats: string;
    times: byte;

procedure DrawBorder(x1,y1,x2,y2,FG,BG: byte);
const frame='Ű';
var i,j,xlen,ylen: byte;
    tox,toy: byte;
    xc,yc: byte;
    max: byte;
    DDel: byte;
begin
  CursorOff;
  xlen := (x2-x1);
  ylen := (y2-y1);
  TextColor(FG);
  TextBackground(BG);
  if xlen>ylen then max:=xlen else max:=ylen;
  DDel:=400 DIV max;
  for i:=0 to max do begin
    tox:=(xlen*i) DIV max;
    toy:=(ylen*i) DIV max;

    for j:=0 to 100 do begin
      xc := (x1+(tox*(100-j) DIV 100));
      yc := (y1+(toy*j DIV 100));
      if (xc>x1) AND (yc>y1) AND (xc<x2) AND (yc<y2) then begin
        GotoXY(xc,yc);
        Write(' ');
      end;
      xc := (x2-(tox*(100-j) DIV 100));
      yc := (y2-(toy*j DIV 100));
      if (xc>x1) AND (yc>y1) AND (xc<x2) AND (yc<y2) then begin
        GotoXY(xc,yc);
        Write(' ');
      end;
    end;

    GotoXY(x1+tox,y1);
    Write(frame);
    GotoXY(x1,y1+toy);
    Write(frame);
    GotoXY(x2-tox,y2);
    Write(frame);
    GotoXY(x2,y2-toy);
    Write(frame);
    Delay(DDel);
  end;
  for i:=x1+1 to x2-1 do begin
    for j:=y1+1 to y2-1 do begin
      GotoXY(i,j);
      Write(' ');
    end;
  end;
  CursorOn;
end;

procedure WriteMash;
var x,y: byte;
begin
  TextColor(15);
  TextBackground(1);
  for y:=1 to 20 do begin
    for x:=1 to 20 do begin
      GotoXY(4+x,4+y);
      Write(Quadrat[y,x]);
    end;
  end;
end;

procedure Init;
begin
  TextMode(CO80+Font8x8);
  ClrScr;
  DrawBorder(1,1,79,49,14,DesktopCol);
  DrawBorder(53,13,71,21,0,3);
  TextColor(0);
  TextBackground(3);
  GotoXY(55,15);
  Write('Richtungsschema');
  GotoXY(60,17);
  Write('8 1 2');
  GotoXY(60,18);
  Write('7 ');
  TextColor(15);
  WritE('X');
  TextColor(0);
  Write(' 3');
  GotoXY(60,19);
  Write('6 5 4');
  DrawBorder(3,3,26,26,15,1);
  WriteMash;
  CursorOff;
end;

procedure Outit;
begin
  DrawBorder(1,1,79,49,0,0);
  TextMode(CO80);
end;

function Get(x,y,dir,len: byte): string;
var i: byte;
    ax,ay: byte;
    tmp: string;
begin
  i:=len;
  ax:=x;
  ay:=y;
  tmp:='';
  repeat
    tmp:=tmp+Quadrat[ay,ax];
    case dir of
      1: Dec(ay);
      2: begin Inc(ax); Dec(ay); end;
      3: Inc(ax);
      4: begin Inc(ax); Inc(ay); end;
      5: Inc(ay);
      6: begin Dec(ax); Inc(ay); end;
      7: Dec(ax);
      8: begin Dec(ax); Dec(ay); end;
    end;
    Dec(i);
  until i=0;
  Get:=tmp;
end;

procedure Input;
var i: byte;
   tmp: string;
begin
  DrawBorder(33,5,73,11,11,1);
  TextColor(11);
  TextBackground(1);
  GotoXY(43,7);
  WriteLn('Geben Sie ein Tier an');
  TextColor(15);
  GotoXY(38,9);
  CursorOn;
  ReadLn(tmp);
  CursorOff;
  whats:='';
  for i:=1 to Length(tmp) do whats:=whats+UpCase(tmp[i]);
  DrawBorder(33,5,73,11,DesktopCol,DesktopCol);
  TextColor(15);
end;

procedure Mark(x,y,dir,len,fg,bg: byte);
var ax,ay,i: byte;
begin
  TextColor(fg);
  TextBackground(bg);
  ax:=x; ay:=y;
  i:=len;
  repeat
    GotoXY(4+ax,4+ay);
    if (ay>=1) AND (ay<=20) AND (ax>=1) AND (ax<=20) then Write(Quadrat[ay,ax]);
    case dir of
      1: Dec(ay);
      2: begin Inc(ax); Dec(ay); end;
      3: Inc(ax);
      4: begin Inc(ax); Inc(ay); end;
      5: Inc(ay);
      6: begin Dec(ax); Inc(ay); end;
      7: Dec(ax);
      8: begin Dec(ax); Dec(ay); end;
    end;
    Dec(i);
  until i=0;
  Delay(30);
  TextBackground(0);
  TextColor(15);
end;

procedure Search(what: string);
var i,j,k: byte;
    ox,oy: byte;
    tmp: string;
begin
  TextBackground(0);
  ox:=1;
  oy:=1;
  for i:=1 to 20 do begin
    for j:=1 to 20 do begin
      (* Mark(j,i,1,1,9,1); *)
      if (Quadrat[i,j]=what[1]) then begin
        for k:=1 to 8 do begin
          tmp:=Get(j,i,k,Length(what));
          (* Mark(j,i,k,Length(what),0,1); *)
          if tmp=what then begin
            Window(5,30,75,46);
            GotoXY(ox,oy);
            Inc(times);
            WriteLn('Hab ''',what,''' bei (',j:2,'|',i:2,') gefunden. Richtung ',k,', L„nge ',Length(what));
            ox:=WhereX; oy:=WhereY;
            Window(1,1,80,50);
            Mark(j,i,k,Length(what),0,7);
            Delay(50);
          end;
          (* Mark(j,i,k,Length(what),15,1); *)
        end;
      end;
      (* Mark(j,i,1,1,15,1); *)
    end;
  end;
  window(5,30,75,46);
  GotoXY(ox,oy);
  if (times=0) then begin
    WriteLn('Hab nix gefunden - versuch'' was anderes.');
  end;
end;

procedure ClearErg;
begin
  DrawBorder(3,28,77,47,DesktopCol,DesktopCol);
  DrawBorder(3,28,77,47,15,0);
end;

begin
  Init;
  repeat
    times:=0;
    { WriteMash; }
    ClearErg;
    Input;
    if (whats<>'') then begin
      Search(whats);
      WriteLn;
      WriteLn('[ Taste drcken, um fort zu fahren ]');
      window(1,1,80,50);
      ReadKey;
    end;
  until whats='';
  Outit;
end.