unit finestre;
{----------------------------------------------------------------------------

  21/12/1999                 (c) by A.Paolo

  -La seguente unit serve per gestire in modo semplice tre tipi
   di finestre in modo testo.
  -Sono stati creati i seguenti tre oggetti :
   +finestre semplici che hanno le seguenti procedure
    init : obbligatoria da utilizzarla per inizializzare l'oggetto;
    apri(ascissa pi— a sinistra , ordinata pi— in alto ,
      ascissa pi— a destra , ordinata pi— in basso ,
      colore testo , colore sfondo) : apre la finestra anche se le coordinate
      date sono oltre i limiti;
    chiudi : chiude la finestra ripristinando lo schermo com'era prima
      di aprirla;
   +finestre con cornice che hanno le stesse procedure del precedente tipo
   +finestre con cornice e titolo che oltre alle procedure
   del precedente tipo hanno la seguente:
    titolo(stringa) : la procedura deve venir chiamata solo dopo aver aperto
      la finesra in questione e prima di aprirne altre.
  -Per un esempio vedere demofin.pas.

Per qualsiasi motivo, si puo' contattare l'autore a xenion@libero.it

---------------------------------------------------------------------------}
interface

uses crt;
type vid=array [1..2000]of word;

     coop=record
     xs,xd,ya,yb:byte;end;

     win=object
      constructor init;
      procedure apri(xsa,yaa,xda,yba,t,s:byte);virtual;
      procedure chiudi;
      private
       p,pa:^coop;
      tp,x,y:^byte;
      video:^vid;
      destructor done;
      procedure controlla;
      procedure memorizza;
      procedure ripristina;
     end;

     wincornice=object(win)
      procedure apri(xsa,yaa,xda,yba,t,s:byte);virtual;
      private
      procedure controlla;
     end;

     wintitolo=object(win)
      procedure apri(xsa,yaa,xda,yba,t,s:byte);virtual;
      procedure titolo(st:string);
      private
      procedure controlla;
     end;

var mem:vid absolute $b800:$000;

{****************************************************}

implementation

constructor win.init;
 begin
 new(x);new(y);new(tp);new(p);new(pa);
 end;

procedure win.controlla;
 begin
 with pa^ do begin
 if xs<1 then xs:=1;
 if (xd<=xs) or(xd>80) then  xd:=80;
 if ya<1 then ya:=1;
 if (yb<=ya)or(yb>25) then yb:=25;
 end;
 end;

procedure wincornice.controlla;
 begin
 with pa^ do begin
 if xs<1 then xs:=1;
 if(xd<=xs+2)or(xd>80)then  xd:=80;
 if ya<1 then ya:=1;
 if(yb<=ya+2)or(yb>25)then yb:=25;
 end;
 end;

procedure wintitolo.controlla;
 begin
 with pa^ do begin
 if xs<1 then xs:=1;
 if(xd<=xs+2)or(xd>80)then  xd:=80;
 if ya<1 then ya:=1;
 if(yb<=ya+4)or(yb>25)then yb:=25;
 end;
 end;

procedure win.apri(xsa,yaa,xda,yba,t,s:byte);
 var l:byte;
 begin
 x^:=wherex;y^:=wherey;tp^:=textattr;
 with p^ do  begin
 xs:=lo( windmin);xd:=lo(windmax);ya:=hi(windmin);yb:=hi(windmax);end;
 with pa^ do begin
 xs:=xsa;xd:=xda;ya:=yaa;yb:=yba;end;
 controlla;
 memorizza;
 with pa^ do window(xs,ya,xd,yb);
 textcolor(t);textbackground(s);for l:=0 to (yba-yaa) do delline;
 end;

destructor win.done;
 begin
 dispose(x); dispose(y); dispose(tp);dispose(p);
 end;

procedure win.chiudi;
 begin
 ripristina;
 window(p^.xs+1,p^.ya+1,p^.xd+1,p^.yb+1);
 textattr:=tp^;
 gotoxy(x^,y^);
 done;
 end;

procedure wincornice.apri(xsa,yaa,xda,yba,t,s:byte);
 procedure riquadro;
 var l,i:byte;
 begin
  with pa^ do begin
  window(xs,ya,xd,yb);
  textcolor(t);textbackground(s);
  gotoxy(1,1);write('É');for l:=0 to (xd-xs-2) do write('Í');write('»');
  for l:=0 to (yb-ya-3)do
   begin write('º');
   for i:=0 to (xd-xs-2) do write(' ');
   write('º');end;
  write('È');for l:=0 to (xd-xs-2) do write('Í');write('¼');
  gotoxy(1,wherey-2);insline;write('º');
  for i:=0 to (xd-xs-2) do write(' ');write('º');
  window(xs+1,ya+1,xd-1,yb-1);
  end;
 end;

 begin
 x^:=wherex;y^:=wherey;tp^:=textattr;
 with p^ do  begin
 xs:=lo( windmin);xd:=lo (windmax);ya:=hi(windmin);yb:=hi(windmax);end;
 with pa^ do begin
 xs:=xsa;xd:=xda;ya:=yaa;yb:=yba;end;
 controlla;
 memorizza;
 riquadro;
end;

procedure wintitolo.apri(xsa,yaa,xda,yba,t,s:byte);
 procedure riquadro;
 var l,i:byte;
 begin
  with pa^ do begin
  window(xs,ya,xd,yb);
  textcolor(t);textbackground(s);
  gotoxy(1,1);write('É');for l:=0 to (xd-xs-2) do write('Í');write('»');
  write('º');for l:=0 to (xd-xs-2) do write(' ');write('º');
  write('Ì');for l:=0 to (xd-xs-2) do write('Í');write('¹');
  for l:=0 to (yb-ya-5)do
   begin write('º');
   for i:=0 to (xd-xs-2) do write(' ');
   write('º');end;
  write('È');for l:=0 to (xd-xs-2) do write('Í');write('¼');
  gotoxy(1,wherey-2);
  insline;write('º');for i:=0 to (xd-xs-2) do write(' ');write('º');
  window(xs+1,ya+3,xd-1,yb-1);
  end;
 end;
 begin
 x^:=wherex;y^:=wherey;tp^:=textattr;
 with p^ do  begin
 xs:=lo( windmin);xd:=lo (windmax);ya:=hi(windmin);yb:=hi(windmax);end;
 with pa^ do begin
 xs:=xsa;xd:=xda;ya:=yaa;yb:=yba;end;
 controlla;
 memorizza;
 riquadro;
 end;

procedure wintitolo.titolo(st:string);
 var xs,xd,ya,yb:byte;
 begin
 xs:=lo( windmin)+1;xd:=lo (windmax)+1;ya:=hi(windmin)+1;yb:=hi(windmax)+1;
 window(xs,ya-2,xd,ya-2);write(st);window(xs,ya,xd,yb);
 end;

procedure win.memorizza;
 var p1,p2:byte;
 begin
 with pa^ do begin
 getmem(video,(yb-ya+1)*(xd-xs+1)*2);
 for p1:=0 to yb-ya do begin
  for p2:=0 to xd-xs do begin
  video^[p1*(xd-xs+1)+p2+1]:=mem[80*(p1+ya-1)+p2+xs];
 end;end;
 end;
 end;

procedure win.ripristina;
 var p1,p2:byte;
 begin
 with pa^ do begin
 for p1:=0 to yb-ya do begin
  for p2:=0 to xd-xs do begin
  mem[80*(p1+ya-1)+p2+xs]:=video^[p1*(xd-xs+1)+p2+1];
  end;end;
 freemem(video,(yb-ya+1)*(xd-xs+1)*2);
 end;end;

end.