Category : Files from Magazines
Archive   : TSR.ZIP
Filename : STAYWNDO.341

{**********************************************************************}
{ W I N D O . I N C }
{ "...but I dont do floors !" }
{**********************************************************************}
{ Kloned and Kludged by Lane Ferris }
{ -- The Hunters Helper -- }
{ Original Copyright 1984 by Michael A. Covington }
{ Modifications by Lynn Canning 9/25/85 }
{ 1) Foreground and Background colors added. }
{ Monochrome monitors are automatically set }
{ to white on black. }
{ 2) Multiple borders added. }
{ 3) TimeDelay procedure added. }
{ Requirements: IBM PC or close compatible. }
{----------------------------------------------------------------------}
{ To make a window on the screen, call the procedure }
{ MkWin(x1,y1,x2,y2,FG,BG,BD); }
{ The x and y coordinates define the window placement and are the }
{ same as the Turbo Pascal Window coordinates. }
{ The border parameters (BD) are 0 = No border }
{ 1 = Single line border }
{ 2 = Double line border }
{ 3 = Double Top/Bottom Single sides }
{ The foreground (FG) and background (BG) parameters are the same }
{ values as the corresponding Turbo Pascal values. }
{ }
{ The maximum number of windows open at one time is set at five }
{ (see MaxWin=5). This may be set to greater values if necessary. }
{ }
{ After the window is made, you must write the text desired from the }
{ calling program. Note that the usable text area is actually 1 }
{ position smaller than the window coordinates to allow for the border.}
{ Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24 }
{ after the border is created. When writing to the window in your }
{ calling program, the textcolor and backgroundcolor may be changed as }
{ desired by using the standard Turbo Pascal commands. }
{ }
{ To return to the previous screen or window, call the procedure }
{ RmWin; }
{ }
{ The TimeDelay procedure is invoked from your calling program. It }
{ is similar to the Turbo Pascal DELAY except DELAY is based on clock }
{ speed whereas TimeDelay is based on the actual clock. This means }
{ that the delay will be the same duration on all systems no matter }
{ what the clock speed. }
{ The procedure could be used for an error condition as follows: }
{ MkWin - make an error message window }
{ Writeln - write error message to window }
{ TimeDelay(5) - leave window on screen 5 seconds }
{ RmWin - remove error window }
{ cont processing }
{----------------------------------------------------------------------}

Const

InitDone :boolean = false ; { Initialization switch }

On = True ;
Off = False ;
VideoEnable = $08; { Video Signal Enable Bit }
Bright = 8; { Bright Text bit}
Mono = 7; {MonoChrome Mode}

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;
{ MaxWin should be included in your program }
{ and it should be the number of windows saved }
{ at one time }
{ It should be in the const section of your program }
Stack: array[1..MaxWin] of ^Screens;

end;

Crtmode :byte absolute $0040:$0049; {Crt Mode,Mono,Color,B&W..}
Crtwidth :byte absolute $0040:$004A; {Crt Mode Width, 40:80 .. }
Monobuffer :Imagetype absolute $B000:$0000; {Monochrome Adapter Memory}
Colorbuffer :Imagetype absolute $B800:$0000; {Color Adapter Memory }
CrtAdapter :integer absolute $0040:$0063; { Current Display Adapter }
VideoMode :byte absolute $0040:$0065; { Video Port Mode byte }
TurboCrtMode: byte absolute Dseg:6; {Turbo's Crt Mode byte }
Video_Buffer:integer; { Record the current Video}
Delta,
x,y :integer;

{------------------------------------------------------------------}
{ Delay for X seconds }
{------------------------------------------------------------------}

procedure TimeDelay (hold : integer);
type
RegRec = { The data to pass to DOS }
record
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
end;
var
regs:regrec;
ah, al, ch, cl, dh:byte;
sec :string[2];
result, secn, error, secn2, diff :integer;

begin
ah := $2c; {Get Time-Of-Day from DOS}
with regs do {Will give back Ch:hours }
{Cl:minutes,Dh:seconds }
ax := ah shl 8 + al; {Dl:hundreds }
intr($21,regs);

with regs do
str(dx shr 8:2, sec); {Get seconds }
{with leading null}
if (sec[1] = ' ') then
sec[1]:= '0';
val(sec, secn, error); {Conver seconds to integer}
repeat { stay in this loop until the time }
ah := $2c; { has expired }
with regs do
ax := ah shl 8 + al;
intr($21,regs); {Get current time-of-day}

with regs do {Normalize to Char}
str(dx shr 8:2, sec);
if (sec[1] = ' ') then
sec[1]:= '0';
val(sec, secn2, error); {Convert seconds to integer}
diff := secn2 - secn; {Number of elapsed seconds}
if diff < 0 then { we just went over the minute }
diff := diff + 60; { so add 60 seconds }
until diff > hold; { has our time expired yet }
end; { procedure TimeDelay }

{------------------------------------------------------------------}
{ 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;
{------------------------------------------------------------------}
{ 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

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, BD, FG, BG :integer);

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

var
I,
TB,SID,TLC,TRC,BLC,BRC :integer;

begin
if Crtmode = Mono then begin
FG := 7;
BG := 0;
end;

Window(x1,y1,x2,y2); {Make the Window}
TextColor(FG) ; {Set the colors}
TextBackground(BG);


Case BD of {Make Border characters}
0:; {No border option}
1:begin {Single line border option}
TB := 196; {Top Border}
SID := 179; {Side Border}
TLC := 218; {Top Left Corner}
TRC := 191; {Top Right Corner}
BLC := 192; {Bottom Left Corner}
BRC := 217; {Bottom Right Corner}
end;
2:begin {Double line border option}
TB := 205;
SID := 186;
TLC := 201; TRC := 187;
BLC := 200; BRC := 188;
end;
3:begin {Double Top/Bottom with single sides}
TB := 205; {"deary and dont spare the lace"}
SID := 179;
TLC := 213; TRC := 184;
BLC := 212; BRC := 190;
end;
End;{Case}

IF BD > 0 then begin { User want a border? }
{ Top }
gotoxy(1,1); { Window Origin }
Write( chr(TLC) ); { Top Left Corner }
For I:=2 to x2-x1 do { Top Bar }
Write( chr(TB));
Write( chr(TRC) ); { Top Right Corner

{ Sides }
for I:=2 to y2-y1 do
begin
gotoxy(1,I); { Left Side Bar }
write( chr(SID) );
gotoxy(x2-x1+1,I) ; { Right Side Bar }
write( chr(SID) );
end;

{ Bottom }
gotoxy(1,y2-y1+1); { Bottom Left Corner }
write( chr(BLC) );
for I:=2 to x2-x1 do { Bottom Bar }
write( chr(TB) );

{ Make it the current Window }
Window(x1+1,y1+1,x2-1,y2-1);
write( chr(BRC) ); { Bottom Right Corner }
end; {If BD > 0};

gotoxy(1,1) ;
TextColor( FG) ; { Take Low nibble 0..15 }
TextBackground (BG); { Take High nibble 0..9 }
ClrScr;
end;
{------------------------------------------------------------------}
{ MkWin Make a Window }
{------------------------------------------------------------------}
procedure MkWin(x1,y1,x2,y2, FG, BG, BD :integer);
{ Create a removable Window }

begin

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

TurboCrtMode := CrtMode; {Set Textmode w/o ClrScr}
If CrtMode = 7 then Video_Buffer := $B000 {Set Ptr to Monobuffer }
else Video_Buffer := $B800; {or Color Buffer }


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 }
{-------------------------------------}
With Win do
Begin
New(Stack[Depth]); { Allocate Current Screen to Heap }
Video( Off);

If CrtMode = 7 then
Stack[Depth]^.Image := monobuffer { set pointer to it }
else
Stack[Depth]^.Image := colorbuffer ;

Video( On);
End ;


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 }
If X1 > Delta then
X1 := X1 - Delta ; { Move Left window edge }
X2 := X2 - Delta ; { Move Right edge on 80 }
end;
If (Y2 > 25) then { If off bottom screen }
begin
Delta := Y2 - 25; { Overflow off right margin }
If Y1 > Delta then
Y1 := Y1 - Delta ; { Move Top edge up }
Y2 := Y2 - Delta ; { Move Bottom 24 }
end;
{ Create the New Window }

BoxWin(x1,y1,x2,y2,BD,FG,BG);
If BD >0 then begin {Shrink window within borders}
Win.Dim.x1 := x1+1;
Win.Dim.y1 := y1+1; { Allow for margins }
Win.Dim.x2 := x2-1;
Win.Dim.y2 := y2-1;
end;

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;
{------------------------------------------------------------------}