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