[comp.lang.pascal] Source code for TP4 windows unit

caasi@sdsu.UUCP (07/13/88)

The following is source code for doing windows under Turbo Pascal 4.0
in a unit file and a main program for demonstrating its use.
No flames to me as I am not the author.

Disclaimer:  My employer's views do not reflect mine.

================== windows2 TP4 unit  (cut here) ======================

unit windows2;

interface

uses crt, dos, turbo3;

{  Turbo Pascal  removable window system       }

{  Requirements:   IBM PC or close compatible. }
{  Screen must be in text mode, on page 1,     }
{  either mono or color card.                  }

{  Call INITWIN before calling MKWIN or RMWIN. }

const maxwin = 5;              { maximum number of windows open at once   }

type  imagetype    = array [1..4096] of char;
      windimtype   = record
                        x1,y1,x2,y2:  integer
                     end;

var
   win:                        { Global variable package                 }
      record
         dim:     windimtype;  { Current window dimensions               }
         depth:   integer;
         stack:   array[1..maxwin] of
                     record
                        image:  imagetype;   { saved screen image        }
                        dim:    windimtype;  { saved window dimensions   }
                        x,y:    integer      { saved cursor position     }
                     end
      end;

   crtmode:       byte        absolute $0040:$0049;
   crtwidth:      byte        absolute $0040:$004A;
   monobuffer:    imagetype   absolute $B000:$0000;
   colorbuffer:   imagetype   absolute $B800:$0000;

procedure InitWin;       {   Records initial window dimensions    }
procedure BoxWin(x1,y1,x2,y2:  integer);
procedure MkWin(x1,y1,x2,y2:  integer);
procedure rmwin;

implementation

procedure InitWin;       {   Records initial window dimensions    }
begin
   with win.dim do
   begin
      x1 := 1;
      y1 := 1;
      x2 := crtwidth;
      y2 := 25
   end;
   win.depth := 0
end;

{ Draw a box, fill it with blanks, and make it the current     }
{ window.  Dimensions given are for the box; actual window is  }
{ one unit smaller in each direction.                          }
{ This routine can be used separately from the rest of the     }
{ removable window package.                                    }

procedure BoxWin(x1,y1,x2,y2:  integer);
var  x,y:  integer;
begin
   window(1,1,80,25);     {Top}
   GotoXY(x1,y1);
   write(chr(213));
   for x := x1+1 to x2-1 do write(chr(205));
   write(chr(184));

   for y := y1+1 to y2-1 do  {Sides}
   begin
      GotoXY(x1,y);
      write(chr(179),' ':x2-x1-1,chr(179))
   end;

   GotoXY(x1,y2);          {Bottom}
   write(chr(212));
   for x := x1+1 to x2-1 do write(chr(205));
   write(chr(190));

   window(x1+1,y1+1,x2-1,y2-1);     { Make it the current window  }
   GotoXY(1,1)
end;


{  Create a movable window   }

procedure MkWin(x1,y1,x2,y2:  integer);
begin
   with win do depth := depth+1;       { increment stack pointer  }
   if win.depth > maxwin then
   begin
      writeln(^G,' Windows nested too deep ');
      halt
   end;

                     {  Save contents of screen     }
   if crtmode = 7 then
      win.stack[win.depth].image := monobuffer
   else
      win.stack[win.depth].image := colorbuffer;

   win.stack[win.depth].dim := win.dim;
   win.stack[win.depth].x   := wherex;
   win.stack[win.depth].y   := wherey;

   { Create the window  }

   boxwin(x1,y1,x2,y2);
   win.dim.x1 := x1+1;
   win.dim.y1 := y1+1;    { Allow for margins   }
   win.dim.x2 := x2-1;
   win.dim.y2 := y2-1;
end;

  {  Remove the most recently created removable window    }
  {  Restore screen contents, window dimensions, and      }
  {  position of cursor.                                  }

procedure rmwin;
begin
   if crtmode = 7 then
      monobuffer := win.stack[win.depth].image
   else
      colorbuffer := win.stack[win.depth].image;
   with win do
   begin
      dim := stack[depth].dim;
      window(dim.x1,dim.y1,dim.x2,dim.y2);
      GotoXY(stack[depth].x,stack[depth].y);
      depth := depth -1
   end
end;

begin
end.

================== Main pascal demo program (cut here) =====================

program windowtest;

uses windows2, crt;

{  Test program for removable window package    }

var  i:  integer;
begin
   initwin;
   writeln('Now and every time the action stops,');
   writeln('press ENTER to continue');
   readln;
   clrscr;
   for i := 1 to 25 do writeln('    This is the original screen.');

   mkwin(3,3,50,18);
   for i := 1 to 15 do writeln('This is the first window....');
   readln;

   mkwin(10,5,70,20);
   for i := 1 to 15 do writeln('Second window....');
   readln;

   mkwin(15,15,45,23);
   writeln('Third window...');
   readln;

   mkwin(55,10,79,25);
   writeln('Fourth window....');
   readln;

   rmwin;    { remove fourth window  }
   readln;

   rmwin;    { remove third window   }
   writeln;
   writeln('We are back in the second window...');
   readln;

   rmwin;    { remove second window  }
   writeln;
   writeln('This is the first window again!');
   readln;

   rmwin;    { remove first window   }
   readln;

end.