Category : Pascal Source Code
Archive   : NBACKUP.ZIP
Filename : WINDOWS.PAS
{ window management routines -- use GetMem and FreeMem to
maintain a stack of up to W_MaxWindows windows which may
be removed, leaving the underlying screen intact.
Written and submitted by Henry A. Groover
Compuserve 70741,417
GetScreen - low level window-saving routine
PutScreen - counterpart to GetScreen
OpenWindow - High level window open.
1. saves current text attribute & cursor position.
2. calculates dimensions of new window space needed -
Window size +
Border margin +
Border
and truncates dimensions if they exceed screen
dimensions (gotten from WindowStack [0])
3. increments WindowStackCurrent
4. calculates memory needed to save area
5. allocates WindowSave & stores dimensions & attr
6. saves window area
7. sets window to new window space needed
8. sets textattr to margin attribute & ClrScr;
9. draws border with specified border attribute
(clipping if necessary)
10. sets new window & attr & ClrScr (which also homes
the cursor)
CloseWindow - closes window initialized by OpenWindow.
1. restores window area
2. frees memory used for saving
3. decrements WindowStackCurrent
4. resets TextAttr & cursor position
DrawWindowBorder - draws border around current window
ChgWindow - activates specified window
MaxWindowNum - returns maximum window number (0 is default window)
}
Interface
Uses crt;
{$L getscreen }
Const
W_MaxWindows = 20;
Var
VideoBasePage
: pointer;
Procedure GetScreen (Var Source, Dest; X1,Y1,X2,Y2: word);
Procedure PutScreen (Var Source, Dest; X1,Y1,X2,Y2: word);
Procedure OpenWindow (WX1, WY1, WX2, WY2 : integer;
Margin, Mattr,
Battr, Wattr : byte);
Procedure CloseWindow;
Procedure DrawWindowBorder;
Procedure ChgWindow (Num: integer);
Function MaxWindowNum : integer;
Implementation
Type
WindowStack_type = record
WindowSave: pointer;
X1,Y1,X2,Y2,
NX1, NY1, NX2, NY2,
CurX, CurY,
Attr : byte;
end;
Var
WindowStack : array [0..W_MaxWindows] of WindowStack_type;
WindowStackCurrent
: integer;
Procedure GetScreen; External;
Procedure PutScreen; External;
Procedure DrawWindowBorder;
{ draw border around current window }
Var
I,Xmax,Ymax,Xmin,Ymin : integer;
begin
Xmax := Lo (WindMax) - Lo (WindMin) + 1;
Ymax := Hi (WindMax) - Hi (WindMin) + 1;
GotoXY (1,1); Write ('É');
For I := 2 to Xmax - 1 do Write ('Í');
Write ('»');
For I := 2 to Ymax - 1 do begin
GotoXY (1,I); Write ('º');
GotoXY (Xmax, I); Write ('º');
end;
GotoXY (1, Ymax); Write ('È');
For I := 2 to Xmax - 1 do Write ('Í');
Xmin := Lo (WindMin) + 1;
Ymin := Hi (WindMin) + 1;
Xmax := Lo (WindMax) + 1;
Ymax := Hi (WindMax) + 1;
Window (1,1,80,25);
GotoXY (Xmax, Ymax);
Write ('¼');
Window (Xmin, Ymin, Xmax, Ymax);
end;
Procedure OpenWindow;
Var
NSX1, NSY1,
NSX2, NSY2 : integer;
begin
If WindowStackCurrent < W_MaxWindows then begin
{ save current text attribute & cursor position. }
With WindowStack [WindowStackCurrent] do begin
CurX := WhereX;
CurY := WhereY;
Attr := TextAttr;
end;
{ calculate dimensions of new window space needed }
NSX1 := WX1 - Margin - 1; { space for border }
NSY1 := WY1 - Margin - 1;
NSX2 := WX2 + Margin + 1;
NSY2 := WY2 + Margin + 1;
{ truncate if no room }
If NSX1 <= 0 then
NSX1 := 1;
If NSY1 <= 0 then
NSY1 := 1;
With WindowStack [0] do begin
If NSX2 > X2 then
NSX2 := X2;
If NSY2 > Y2 then
NSY2 := Y2;
end;
{ increment WindowStackCurrent }
WindowStackCurrent := WindowStackCurrent + 1;
{ calculate memory needed to save area, allocate WindowSave,
store dimensions & attr, save window area }
With WindowStack [WindowStackCurrent] do begin
GetMem (WindowSave,
(NSX2 - NSX1 + 1) * (NSY2 - NSY1 + 1) * 2);
X1 := WX1; Y1 := WY1;
X2 := WX2; Y2 := WY2;
NX1:= NSX1; NY1:= NSY1;
NX2:= NSX2; NY2:= NSY2;
Attr := Wattr;
GetScreen (VideoBasePage^, WindowSave^,
NSX1, NSY1, NSX2, NSY2);
end;
{ set window to new window space needed }
Window (NSX1, NSY1, NSX2, NSY2);
{ set TextAttr to margin attribute & ClrScr }
TextAttr := Mattr;
ClrScr;
{ draw border with specified border attribute (clipping if necessary) }
TextAttr := Battr;
DrawWindowBorder;
{ set new window & attr & ClrScr (which also homes the cursor) }
Window (WX1, WY1, WX2, WY2);
TextAttr := Wattr;
ClrScr;
end; { haven't pushed too many windows }
end; { Procedure OpenWindow }
Procedure CloseWindow;
begin
If WindowStackCurrent > 0 then begin
With WindowStack [WindowStackCurrent] do begin
{ restore window area }
PutScreen (WindowSave^, VideoBasePage^,
NX1, NY1, NX2, NY2);
{ free memory used for saving }
FreeMem (WindowSave, (NX2 - NX1 + 1) * (NY2 - NY1 + 1) * 2);
end;
{ decrement WindowStackCurrent }
WindowStackCurrent := WindowStackCurrent - 1;
With WindowStack [WindowStackCurrent] do begin
{ reset TextAttr & cursor position }
TextAttr := Attr;
Window (X1, Y1, X2, Y2);
GotoXY (CurX, CurY);
end;
end; { of there was a window to pop }
end;
Procedure ChgWindow;
Var Temp: WindowStack_type;
begin
If (Num >= 0) and (Num < WindowStackCurrent) then
begin
Temp := WindowStack [WindowStackCurrent];
With Temp do begin
Attr := TextAttr;
CurX := WhereX;
CurY := WhereY;
end;
WindowStack [WindowStackCurrent] :=
WindowStack [Num];
WindowStack [Num] := Temp;
With WindowStack [WindowStackCurrent] do begin
{ reset TextAttr & cursor position }
TextAttr := Attr;
Window (X1, Y1, X2, Y2);
GotoXY (CurX, CurY);
end;
end;
end;
Function MaxWindowNum;
begin
MaxWindowNum := WindowStackCurrent;
end;
begin { initialize Windows unit }
FillChar (WindowStack, SizeOf(WindowStack), 0);
{ initialize all to nil }
WindowStackCurrent := 0;
{ current window = 0; no window open }
With WindowStack [WindowStackCurrent] do begin
{ initialize base window }
X1 := 1; Y1 := 1;
X2 := Lo (WindMax) + 1;
Y2 := Hi (WindMax) + 1;
{ this is superfluous since OpenWindow will save TextAttr before
opening the new window }
Attr := TextAttr;
end;
If LastMode = Mono then
VideoBasePage := Ptr ($B000, $0000)
else
VideoBasePage := Ptr ($B800, $0000);
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/