Dze je subor www.TrSek.com/pas/8smer.pas

{ 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.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com