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