Category : Pascal Source Code
Archive   : STAYRES.ZIP
Filename : NWINDO.300

{**********************************************************************}
{ N W I N D O . I N C : New Windos Procedures }
{ }
{ Separate this into File NWINDO.300 }
{**********************************************************************}
{ Kloned and Kludged by Lane Ferris }
{ -- The Hunters Helper -- }
{ Original ideas by Michael A. Covington }
{ Requirements: IBM PC or close compatible. }
{----------------------------------------------------------------------}

Const
MaxWin = 4; { maximum number of Windows open at once }
InitDone :boolean = false ; { Initialization switch }

On = True ;
Off = False ;
VideoEnable = $08; { Video Signal Enable Bit }
Black :byte = 0; { Video Color Attributes }
Blue :byte = 1;
Green :byte = 2;
Cyan :byte = 3;
Red :byte = 4;
Magenta:byte = 5;
Yellow :byte = 6;
White :byte = 7;
Bright :byte = 8;
BackGround : byte = 16 ;

Type
Imagetype = array [1..4000] of char; { Screen Image in the heap }
WinDimtype = record
x1,y1,x2,y2: integer
end;

Screens = record { Save Screen Information }
Image: Imagetype; { Saved screen Image }
Dim: WinDimtype; { Saved Window Dimensions }
x,y: integer; { Saved cursor position }
end;


Var

Win: { Global variable package }
record
Dim: WinDimtype; { Current Window Dimensions }
Depth: integer;
Stack: array[1..maxWin] of ^Screens;

end;

Crtmode :byte absolute $0040:$0049;
Crtwidth :byte absolute $0040:$004A;
Monobuffer :Imagetype absolute $B000:$0000;
Colorbuffer :Imagetype absolute $B800:$0000;
CrtAdapter :integer absolute $0040:$0063; { Current Display Adapter }
VideoMode :byte absolute $0040:$0065; { Video Port Mode byte }
Video_Buffer:integer; { Record the current Video}
Attr :byte;
Switch :boolean;
Delta,
Xtemp,Ytemp :integer;

{------------------------------------------------------------------}
{ Get Absolute postion of Cursor into parameters x,y }
{------------------------------------------------------------------}
Procedure Get_Abs_Cursor (var x,y :integer);
Var
Active_Page : byte absolute $0040:$0062; { Current Video Page Index}
Crt_Pages : array[0..7] of integer absolute $0040:$0050 ;

Begin

X := Crt_Pages[active_page]; { Get Cursor Position }
Y := Hi(X)+1; { Y get Row }
X := Lo(X)+1; { X gets Col position }
End;
{----------------------------------------------------------------------}
{ L o w V i d e o : Set Low intensity on Screen }
{----------------------------------------------------------------------}
Procedure LowVideo; { Change to Low Video intensity }
Var
Byteval :byte;
Begin { keeping the textcolor. Not the }
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
TextColor(Byteval And $07); { Take Low nibble 0..15 }
End; { Low Video }
{----------------------------------------------------------------------}
{ N o r m V i d e o : Set Low intensity on Screen }
{----------------------------------------------------------------------}
Procedure NormVideo; { Change to Low Video intensity }
Var
Byteval :byte;
Begin { keeping the textcolor. Not the }
Get_Abs_Cursor(x,y) ; { compiler colors. }
Byteval := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
TextColor((Byteval mod 16) Or Bright); { Take Low nibble 0..15 }
End; { Low Video }
{------------------------------------------------------------------}
{ Turn the Video On/Off to avoid Read/Write snow }
{------------------------------------------------------------------}
Procedure Video (Switch:boolean);
Begin
If (Switch = Off) then
Port[CrtAdapter+4] := (VideoMode - VideoEnable)
else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
End;
{------------------------------------------------------------------}
{ InitWin Saves the Current (whole) Screen }
{------------------------------------------------------------------}
Procedure InitWin;
{ Records Initial Window Dimensions }
Begin

If CrtMode = 7 then
Video_Buffer := $B000 {Set Ptr to Monobuffer }
else Video_Buffer := $B800; { or Color Buffer }

with Win.Dim do
begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
Win.Depth:=0;
InitDone := True ; { Show initialization Done }
end;
{------------------------------------------------------------------}
{ BoxWin Draws a Box around the current Window }
{------------------------------------------------------------------}
procedure BoxWin(x1,y1,x2,y2:integer; Attr:byte);

{ Draws a box, fills it with blanks, and makes 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. }

var
x,y : integer;

begin
Window(1,1,80,25);
TextColor((Attr Mod 16) or Bright) ;
TextBackground(Attr Div 16);

{ Top }
gotoxy(x1,y1); { Windo Origin }
Write( chr(213) ); { Top Left Corner }
For x:=x1+1 to x2-1 do { Top Bar }
Write( chr(205));
Write( chr(184) ); { Top Right Corner

{ Sides }
for y:=y1+1 to y2-1 do
begin
gotoxy(x1,y); { Left Side Bar }
write( chr(179) );
gotoxy(X2,y) ; { Right Side Bar }
write( chr(179) );
end;

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

{ Make it the current Window }
Window(x1+1,y1+1,x2-1,y2-1);
gotoxy(1,1) ;
TextColor( Attr mod 16); { Take Low nibble 0..15 }
TextBackground ( Attr Div 16); { Take High nibble 0..9 }
ClrScr;
end;
{------------------------------------------------------------------}
{ MkWin Make a Window }
{------------------------------------------------------------------}
procedure MkWin(x1,y1,x2,y2 :integer; attr :byte);
{ Create a removable Window }

begin

If (InitDone = false) then { Initialize if not done yet }
InitWin;

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 }
{-------------------------------------}
Video(Off) ; { Turn off Video to avoid Snow }

With Win do
Begin
New(Stack[Depth]); { Allocate Current Screen to Heap }
If CrtMode = 7 then
Stack[Depth]^.Image := monobuffer { set pointer to it }
else
Stack[Depth]^.Image := colorbuffer ;
End ;

Video(On) ; { Turn the Video back on }

With Win do
Begin { Save Screen Dimentions }
Stack[Depth]^.Dim := Dim;
Stack[Win.Depth]^.x := wherex; { Save Cursor Position }
Stack[Win.Depth]^.y := wherey;
End ;

{ Validate the Window Placement}
If (X2 > 80) then { If off right of screen }
begin
Delta := (X2 - 80); { Overflow off right margin }
X1 := X1 - Delta ; { Move Left window edge }
X2 := X2 - Delta ; { Move Right edge on 80 }
end;
If (Y2 > 24) then { If off bottom screen }
begin
Delta := Y2 - 24; { Overflow off right margin }
Y1 := Y1 - Delta ; { Move Top edge up }
Y2 := Y2 - Delta ; { Move Bottom 24 }
end;
{ Create the Window New window }
BoxWin(x1,y1,x2,y2,Attr);
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 Window }
{------------------------------------------------------------------}
{ Remove the most recently created removable Window }
{ Restore screen contents, Window Dimensions, and }
{ position of cursor. }
Procedure RmWin;
Var
Tempbyte : byte;

Begin
Video(Off);

With Win do
Begin { Restore next Screen }
If crtmode = 7 then
monobuffer := Stack[Depth]^.Image
else
colorbuffer := Stack[Depth]^.Image;
Dispose(Stack[Depth]); { Remove Screen from Heap }

Video(On);

With Win do { Re-instate the Sub-Window }
Begin { Position the old cursor }
Dim := Stack[Depth]^.Dim;
Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
gotoxy(Stack[Depth]^.x,Stack[Depth]^.y);
end;

Get_Abs_Cursor(x,y) ; { New Cursor Position }
Tempbyte := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ];

TextColor( Tempbyte And $0F ); { Take Low nibble 0..15}
TextBackground ( Tempbyte Div 16); { Take High nibble 0..9 }
Depth := Depth - 1
end ;
end;
{------------------------------------------------------------------}
{ Da'Da'DatsAllFolks }
{------------------------------------------------------------------}