{ TWIND.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Sucast programu tc.pas } { Obsahuje rutiny ktore pracuju s oknom. } { } { Datum:28.07.1996 http://www.trsek.com } unit t_Wind; interface type obrazovka=record znak_attr:array[1..25,1..80] of word; end; t_znaky=record poin:array[1..2] of pointer; { ukazuju pred,zanim } znak_attr:word; end; t_pole_okna=record { ukazuju pred,zanim } poin:array[1..2,1..24] of pointer; end; { inicializuj pole pre pracu } function init_okna:pointer; { uvolni pole pre okna } procedure uvolni_inokna(pole_okna:pointer); { Vyrobi riadkove obojsmerne pole smernikov do pole_okna } procedure urobpole(xh,xd,yh,yd:byte;pole:pointer); { uchava/vykresli podklad okna } procedure vepo_podkl(xh,xd,yh,yd:byte;pole:pointer;vezmi:boolean); { pohne oknom v smere do dolava-doprava } procedure move_leri(xh,xd,yh,yd:byte;pole:pointer;left:boolean); { pohne oknom v smere-hore } procedure move_updo(xh,xd,yh,yd:byte;pole:pointer;up:boolean); { uvolni pamat vyhradenu oknami } procedure uvolni_mpole(pole:pointer); { zmensi okno v smere do dolava } procedure size_left(xh,xd,yh,yd:byte;pole:pointer); { zvatsi okno v smere do doprava } procedure size_right(xh,xd,yh,yd:byte;pole:pointer); { zmensi okno smerom nahor } procedure size_up(xh,xd,yh,yd:byte;pole:pointer); { zvatsi okno smerom nadol } procedure size_down(xh,xd,yh,yd:byte;pole:pointer); var obr:^obrazovka; implementation { inicializuj pole pre pracu } function init_okna:pointer; var pole_okna:^t_pole_okna; x:byte; begin GetMem(pole_okna,SizeOf(t_pole_okna)); init_okna:=pole_okna; for x:=1 to 24 do begin pole_okna^.poin[1,x]:=NIL; pole_okna^.poin[2,x]:=NIL; end; end; { uvolni pole pre okna } procedure uvolni_inokna(pole_okna:pointer); begin FreeMem(pole_okna,SizeOf(t_pole_okna)); end; { Vyrobi riadkove obojsmerne pole smernikov do pole_okna } procedure urobpole(xh,xd,yh,yd:byte;pole:pointer); var pole_okna:^t_pole_okna; p_znak,d_znak:^t_znaky; x,y:byte; begin pole_okna:=pole; for y:=yh to yd do begin GetMem(p_znak,SizeOf(t_znaky)); pole_okna^.poin[1,y]:=p_znak; for x:=xh to xd-1 do begin GetMem(d_znak,SizeOf(t_znaky)); p_znak^.poin[2]:=d_znak; d_znak^.poin[1]:=p_znak; p_znak:=d_znak; end; p_znak:=pole_okna^.poin[1,y]; pole_okna^.poin[2,y]:=d_znak; p_znak^.poin[1]:=d_znak; d_znak^.poin[2]:=p_znak; end; end; { uchava/vykresli podklad okna } procedure vepo_podkl(xh,xd,yh,yd:byte;pole:pointer;vezmi:boolean); var x,y:byte; pole_okna:^t_pole_okna; p_znak:^t_znaky; begin pole_okna:=pole; for y:=yh to yd do begin p_znak:=pole_okna^.poin[1,y]; for x:=xh to xd do begin if vezmi then p_znak^.znak_attr:=obr^.znak_attr[y,x] else obr^.znak_attr[y,x]:=p_znak^.znak_attr; p_znak:=p_znak^.poin[2]; end; end; end; { pohne oknom v smere do dolava-doprava } procedure move_leri(xh,xd,yh,yd:byte;pole:pointer;left:boolean); var pole_okna:^t_pole_okna; p_znak:^t_znaky; y:byte; prv,dru,x1,x2,x:byte; ppole:array[1..24] of word; begin pole_okna:=pole; if left then begin prv:=1;dru:=2;x1:=xd;x2:=xh-1;end else begin prv:=2;dru:=1;x1:=xh;x2:=xd+1;end; { tuto skutocne pohne } if left then for y:=yh to yd do begin ppole[y]:=obr^.znak_attr[y,x2]; for x:=xh to xd do obr^.znak_attr[y,x-1]:=obr^.znak_attr[y,x]; end else for y:=yh to yd do begin ppole[y]:=obr^.znak_attr[y,x2]; for x:=xd downto xh do obr^.znak_attr[y,x+1]:=obr^.znak_attr[y,x]; end; for y:=yh to yd do begin p_znak:=pole_okna^.poin[dru,y]; pole_okna^.poin[dru,y]:=p_znak^.poin[prv]; pole_okna^.poin[prv,y]:=p_znak; { najprv obnov podklad } obr^.znak_attr[y,x1]:=p_znak^.znak_attr; { uchovaj nove } p_znak^.znak_attr:=ppole[y]; end; end; { pohne oknom v smere-hore } procedure move_updo(xh,xd,yh,yd:byte;pole:pointer;up:boolean); var pole_okna:^t_pole_okna; p_znak:^t_znaky; x,y:byte; y1,y2:byte; ppole:array[1..80] of word; begin pole_okna:=pole; if up then begin y1:=yh-1;y2:=yd;end else begin y1:=yd+1;y2:=yh;end; p_znak:=pole_okna^.poin[1,y2]; { zapamataj posledny } pole_okna^.poin[1,y2]:=NIL; pole_okna^.poin[2,y2]:=NIL; pole_okna^.poin[1,y1]:=p_znak; { prvy daj to co bolo posledne } pole_okna^.poin[2,y1]:=p_znak^.poin[1]; if up then for x:=xh to xd do begin ppole[x]:=obr^.znak_attr[yh-1,x]; for y:=yh to yd do obr^.znak_attr[y-1,x]:=obr^.znak_attr[y,x]; end else for x:=xh to xd do begin ppole[x]:=obr^.znak_attr[yd+1,x]; for y:=yd downto yh do obr^.znak_attr[y+1,x]:=obr^.znak_attr[y,x]; end; for x:=xh to xd do begin obr^.znak_attr[y2,x]:=p_znak^.znak_attr; p_znak^.znak_attr:=ppole[x]; p_znak:=p_znak^.poin[2]; end; end; { uvolni pamat vyhradenu oknami } procedure uvolni_mpole(pole:pointer); var pole_okna:^t_pole_okna; p_znak:^t_znaky; pom:pointer; y:byte; begin pole_okna:=pole; for y:=1 to 24 do if (pole_okna^.poin[1,y]<>NIL) then begin pom:=pole_okna^.poin[1,y]; repeat p_znak:=pom; pom:=p_znak^.poin[2]; FreeMem(p_znak,SizeOf(t_znaky)); until (pom=pole_okna^.poin[1,y]); end; end; { zmensi okno v smere do dolava } procedure size_left(xh,xd,yh,yd:byte;pole:pointer); var pole_okna:^t_pole_okna; p_znak,d_znak:^t_znaky; y:byte; begin pole_okna:=pole; for y:=yh to yd do begin obr^.znak_attr[y,xd]:=p_znak^.znak_attr; { vykresli podklad } p_znak:=pole_okna^.poin[2,y]; pole_okna^.poin[2,y]:=p_znak^.poin[1]; obr^.znak_attr[y,xd]:=p_znak^.znak_attr; { vyhod posledny stlpec } d_znak:=p_znak^.poin[1]; d_znak^.poin[2]:=p_znak^.poin[2]; d_znak:=p_znak^.poin[2]; d_znak^.poin[1]:=p_znak^.poin[1]; FreeMem(p_znak,SizeOf(t_znaky)); end; end; { zvatsi okno v smere do doprava } procedure size_right(xh,xd,yh,yd:byte;pole:pointer); var pole_okna:^t_pole_okna; p_znak,d_znak:^t_znaky; pom:pointer; y:byte; begin pole_okna:=pole; for y:=yh to yd do begin p_znak:=pole_okna^.poin[2,y]; GetMem(d_znak,SizeOf(t_znaky)); { pridaj posledny stlpec } pom:=p_znak^.poin[2]; p_znak^.poin[2]:=d_znak; d_znak^.poin[1]:=p_znak; p_znak:=pom; p_znak^.poin[1]:=d_znak; d_znak^.poin[2]:=p_znak; pole_okna^.poin[2,y]:=d_znak; { zapamataj podklad } d_znak^.znak_attr:=obr^.znak_attr[y,xd+1]; end; end; { zmensi okno smerom nahor } procedure size_up(xh,xd,yh,yd:byte;pole:pointer); var pole_okna:^t_pole_okna; p_znak:^t_znaky; pom:pointer; x:byte; begin pole_okna:=pole; pom:=pole_okna^.poin[1,yd]; { zapamataj posledny } pole_okna^.poin[1,yd]:=NIL; { zrus cesty na ne } pole_okna^.poin[2,yd]:=NIL; for x:=xh to xd do begin p_znak:=pom; obr^.znak_attr[yd,x]:=p_znak^.znak_attr; pom:=p_znak^.poin[2]; FreeMem(p_znak,SizeOf(t_znaky)); end; end; { zvatsi okno smerom nadol } procedure size_down(xh,xd,yh,yd:byte;pole:pointer); var pole_okna:^t_pole_okna; p_znak,d_znak:^t_znaky; pom:pointer; x:byte; begin pole_okna:=pole; GetMem(p_znak,SizeOf(t_znaky)); pole_okna^.poin[1,yd+1]:=p_znak; p_znak^.znak_attr:=obr^.znak_attr[yd+1,xh]; for x:=xh+1 to xd do begin GetMem(d_znak,SizeOf(t_znaky)); d_znak^.znak_attr:=obr^.znak_attr[yd+1,x]; p_znak^.poin[2]:=d_znak; d_znak^.poin[1]:=p_znak; p_znak:=d_znak; end; p_znak:=pole_okna^.poin[1,yd+1]; pole_okna^.poin[2,yd+1]:=d_znak; p_znak^.poin[1]:=d_znak; d_znak^.poin[2]:=p_znak; end; begin obr:=Ptr($B800,0); { nastav pole do pamate obrazovky } end.