Program reší tajenku osemsměrovky

{ 8SMER.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Program lusti osemsmerovku.                                       }
{ Zadanie musi byt v subore tajnicka.dat.                           }
{ Vyzaduje subory rutiny.pas a trsek.pas.                           }
{                                                                   }
{ Datum:28.05.1996                             http://www.trsek.com }
 
program osemsmerovka;
uses crt, dos, trsek;
 
const PocSlov = 600;            { Maximalny pocet slov pre tajnicku }
      MAX  = 100;               { maximalne znakov v poli }
      MAXX = 30;                { maximalne znakov v riadkoch, stlpcoch }
      SPACE= ' ';
 
var  PTaj   : array[1..MAX,1..MAX] of string[2]; { Ulozena tajnicka }
     OKRieT : array[1..MAX,1..MAX] of Boolean;   { Pismeno uz skrtnute = false }
     Slov   : array[1..PocSlov] of string[30];   { Ulozene slova ktore sa hladaju v tajnicke }
     OKSlov : array[1..PocSlov] of Boolean;      { false ak bolo slovo najdene }
     ColP, ColB   : byte;       { Aktualna farba pisma, podkladu }
     ColPI, ColBI : byte;       { Aktualna farba inverzna }
     Subor: string;
     px,py : byte;              { pocet znakov xovej, yovej }
     pp : integer;              { tolko znakov ma vysledok }
     ppz: integer;              { kolko zatial ostalo pismen }
     ps : integer;              { kolko slov hladam }
     ys,yr : integer;           { pre zoznam slov vpravo }
     x,y : integer;             { pre poziciu tajnicky }
     xt,yt,sm : integer;        { tu uklada najdene riesenie }
     kl:char;
     i:integer;
     MAXY:integer;
 
{ Rutinky }
{$I rutiny.pas }
 
procedure chyba( cis:integer );
begin
 writeln('Chyba c.',cis );
end;
 
 
procedure MoveTajnicka;
begin
 
 repeat
 
  kl := readkey;
 
  if( kl = #0 )then
   begin
    kl := readkey;
    if( kl = #77 )then x:=x+1;
    if( kl = #75 )then x:=x-1;
    if( kl = #80 )then y:=y+1;
    if( kl = #72 )then y:=y-1;
 
    VisTab(x,y);
   end;
 
 until( kl in [#13,#27,#9] );
 
end;
 
 
 
BEGIN
 ColP:=Yellow; ColPI:=LightBlue;
 ColB:=Blue;   ColBI:=Red;
 MAXY := Hi(WindMax)-2;
 Subor:='tajnicka.dat';
 Obrazovka;
 
 Citaj_subor(subor);
 
 ppz := Disp(1);
 x:=1; y:=1;
 ys:=1; yr:=0;
 VisTab(x,y);
 VisSlova(ys,yr);
 
 repeat
 
  kl := readkey;
 
  { presun na posuv tabulky }
  if( kl = #9 )then
   begin
    VisSlova(ys,-1);
    MoveTajnicka;
    VisSlova(ys,yr);
   end;
 
 
  { editacia slova }
  if( kl = #13 )then
   begin
    Slov[ys+yr] := tread( 2*MAXX+3, yr+1, 77-(2*MAXX), Slov[ys+yr], #0, #0 );
 
    for i:=length( Slov[ys+yr] ) downto 1 do
      if( Slov[ys+yr][i] = SPACE )then
        delete( Slov[ys+yr],i,1 )
       else
        Slov[ys+yr][i] := UpCase( Slov[ys+yr][i] );
 
    VisSlova(ys,yr);
    KurzorZap(false);
   end;
 
 
  { hybe sa sipkami }
  if( kl = #0 )then
   begin
 
    kl := readkey;
 
    { help }
    if( kl = #59 )then
     begin
      Help;
      Obrazovka;
      ppz := Disp(1);
      VisTab(x,y);
      VisSlova(ys,yr);
     end;
 
    { uloz do suboru }
    if( kl = #60 )then Save;
 
    { vycitaj zo suboru }
    if( kl = #61 )then
     begin
      Load;
      Obrazovka;
      Citaj_subor(subor);
 
      ppz := Disp(1);
      x:=1; y:=1;
      ys:=1; yr:=0;
      VisTab(x,y);
      VisSlova(ys,yr);
     end;
 
    { stlacil ze chce hladat }
    if( kl in [#62,#82] )then
     begin
      Hladaj( xt,yt,sm,Slov[ys+yr] );
 
      if( yt<>0 )then
       begin
        farba( ColB, ColP+blink );
        OznacNajdene( xt,yt,sm,ys+yr );
        delay(500);
 
        farba( ColB, ColPI );
        OznacNajdene( xt,yt,sm,ys+yr );
       end;
 
      ppz := Disp(1);
      kl := #80;
     end;
 
 
    { hlada vsetky slova }
    if( kl = #63 )then
     for i:=1 to ps do
      begin
 
       farba( ColB, ColPI );
       Hladaj( xt,yt,sm,Slov[i] );
       delay(100);
 
       if( yt<>0 )then
         OznacNajdene( xt,yt,sm,i );
 
       ppz := Disp(1);
      end;
 
 
    { posuv sipkami }
    if( kl = #80 )then yr:=yr+1;
    if( kl = #72 )then yr:=yr-1;
 
 
    { posuv stlpca }
    if( yr<0 )then
     begin
      yr:=0;
      if( ys > 1 )then ys:=ys-1;
     end;
 
    { posuv stlpca }
    if( yr>=MAXY )then
     begin
      yr:=MAXY-1;
      if( ys < MAXY )then ys:=ys+1;
     end;
 
    VisSlova(ys,yr);
 
   end;
 
 until( kl=#27 );
 
END.