home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 June
/
SIMTEL_0692.cdr
/
msdos
/
turbopas
/
wndw40.arc
/
WNDW40-.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-12-12
|
25KB
|
545 lines
{ =========================================================================== }
{ Wndw40-.pas - unit for random-access, multi-level windows ver 4.0, 12-12-87 }
{ }
{ This file has a partial code listing for serial and random access, }
{ multi-level windows. It works on any IBM or compatible including PCjr, }
{ IBM 3270 PC, and the PS/2 systems, in any video mode. It uses QWIK40.TPU }
{ for fast screen writing on any video page. }
{ (c) James H. LeMay 1987 }
{ =========================================================================== }
{$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
UNIT Wndw;
INTERFACE
USES Crt,Qwik,WndwVars;
{ -- Basic Window Utilities -- }
function Attr (Foreground,Background: byte): byte;
procedure Qbox (Row,Col,Rows,Cols: byte; Wattr,Battr: integer;
BrdrSel: Borders);
procedure RestoreTurboWindow;
procedure InitWindow (Wattr: integer; ClearScr: boolean);
function HeapOK (NumOfBytes: word): boolean;
procedure SetWindowModes (SumOfAllModes: byte);
procedure MakeWindow (Row,Col,Rows,Cols: byte; Wattr,Battr: integer;
BrdrSel: Borders; WindowName: WindowNames);
procedure PartitionWindow (Partition: DirType; WindowRowOrCol: byte);
procedure PartitionCross (WindowRow, WindowCol: byte);
procedure RemoveWindow;
procedure TitleWindow (TopOrBottom,Justify: DirType; Title: string);
procedure ClearTitle (TopOrBottom: DirType);
procedure ClearWindow;
procedure ScrollWindow (RowBegin,RowEnd: byte; Dir: DirType);
{ -- Window management utilities -- }
procedure HideWindow;
procedure ShowWindow (WindowName: WindowNames);
procedure MoveWindow (Dir: DirType; NumOfChars: byte);
function GetLevelIndex (WindowName: WindowNames): byte;
procedure AccessWindow (WindowName: WindowNames);
IMPLEMENTATION
const
NoShadow = $00;
BothShadows = $0C; { ShadowLeft+ShadowRight }
FixedOrPermModes = $03; { FixedMode+PermMode }
{ =========================================================================== }
{ NAME: Attr ver 4.0, 12-12-87 }
{ DESCRIPTION: Converts Turbo color constants into an attribute and masks }
{ any accidental blink bit. However, the use of the new }
{ background colors constants in WNDWVARS.PAS is recommended }
{ in lieu of this function. }
{ PARAMETERS: ForeGround - Color of text foreground }
{ BackGround - Color of text background }
{ =========================================================================== }
function Attr; { (Foreground,Background: byte): byte; }
begin
Attr := ((BackGround shl 4) + ForeGround) and $7F;
end;
{ =========================================================================== }
{ NAME: RestoreTurboWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Restores the Turbo window, attribute, cursor location, }
{ and window identification for the top Level Index. }
{ =========================================================================== }
procedure RestoreTurboWindow;
begin
with TopWndwStat do
begin
TextAttr:=WSWattr; { Turbo's Attribute }
if VideoPage=0 then
if WSbrdr=NoBrdr then
window (WScol,WSrow,WScol2,WSrow2)
else window (succ(WScol),succ(WSrow),pred(WScol2),pred(WSrow2));
GotoRC (WSwhereR,WSwhereC);
end
end;
{ =========================================================================== }
{ NAME: InitWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Initializes the window variables. Run this routine first! }
{ PARAMETERS: }
{ Wattr - Starting window attribute (0-255) }
{ ClearScr - Set to true if you want the screen initially cleared }
{ =========================================================================== }
procedure InitWindow; { (Wattr: integer; ClearScr: boolean); }
begin
CheckSnow:=Qsnow;
LI:=0; { Current Level Index }
HLI:=MaxWndw+1; { Hidden window Level Index }
with TopWndwStat,Margins do { Set top level stats }
begin
WSrow := 1; WSWattr := Wattr;
WScol := 1; WSBattr := Wattr;
WSrows := CRTrows; WSbrdr := NoBrdr;
WScols := CRTcols; WSname := Window0;
WSrow2 := CRTrows; WSwhereR := 1;
WScol2 := CRTcols; WSwhereC := 1;
WSmodes := PermMode;
ULbytes := 0;
WndwStat[0] := TopWndwStat; { Save a copy }
LeftMargin := WScol;
RightMargin := WScol2;
TopMargin := WSrow;
BottomMargin := WSrow2;
WindowModes := 0;
case SystemID of
$FC,$F8: ZoomDelay:=18; { 80286 or 80386 machines }
else ZoomDelay:=12;
end;
RestoreTurboWindow;
if ClearScr then
Qfill (1,1,CRTrows,CRTcols,Wattr,' ');
end;
end;
{ =========================================================================== }
{ NAME: SetWindowModes ver 4.0, 12-12-87 }
{ DESCRIPTION: Checks and set the variable WindowModes. }
{ PARAMETERS: SumOfAllModes - A sum of all the modes added together. }
{ =========================================================================== }
procedure SetWindowModes; { (SumOfAllModes: byte); }
begin
{ -- Turn off HideMode -- }
WindowModes:=SumOfAllModes and ($FF-HideMode);
{ -- if both shadows, clear ShadowLeft -- }
if (WindowModes and BothShadows)=BothShadows then
WindowModes:=WindowModes-ShadowLeft;
end;
{ =========================================================================== }
{ NAME: HeapOK ver 4.0, 12-12-87 }
{ DESCRIPTION: Checks for enough memory on the heap used by MakeWindow. }
{ PARAMETERS: NumOfBytes - number of bytes needed on the heap }
{ =========================================================================== }
function HeapOK; { (NumOfBytes: word): boolean; }
begin
if maxavail<NumOfBytes then
begin
ProgrammingError (1);
HeapOK := false
end
else HeapOK := true
end;
{ =========================================================================== }
{ NAME: Qbox ver 4.0, 12-12-87 }
{ DESCRIPTION: Writes a window with optional border. }
{ PARAMETERS: See MakeWindow. }
{ =========================================================================== }
procedure Qbox; { (Row,Col,Rows,Cols: byte;
Wattr,Battr: integer; BrdrSel: Borders); }
var Row2,Col2: byte;
begin
if (Rows>=2) and (Cols>=2) then
begin
Row2:=pred(Row+Rows);
Col2:=pred(Col+Cols);
if BrdrSel<>NoBrdr then
with Brdr[BrdrSel] do
begin
Qwrite ( Row , Col ,Battr,TL);
Qfill ( Row ,succ(Col),1 ,Cols-2,Battr,TH);
Qwrite ( Row , Col2 ,Battr,TR);
Qfill (succ(Row), Col ,Rows-2,1 ,Battr,LV);
Qfill (succ(Row), Col2,Rows-2,1 ,Battr,RV);
Qwrite ( Row2, Col ,Battr,BL);
Qfill ( Row2,succ(Col),1 ,Cols-2,Battr,BH);
Qwrite ( Row2, Col2 ,Battr,BR);
Qfill (succ(Row),succ(Col),Rows-2,Cols-2,Wattr,' ')
end
else Qfill (Row,Col,Rows,Cols,Wattr,' ');
end;
end;
{ =========================================================================== }
{ NAME: ZoomQbox (Near procedure) ver 4.0, 12-12-87 }
{ DESCRIPTION: Creates zoom effect when producing a blank window. }
{ =========================================================================== }
procedure ZoomQbox;
var
r1,r2,ColRatio: byte;
c1,c2: integer;
begin
with TopWndwStat do
begin
r1 := WSrow + pred((WSrows shr 1));
r2 := WSrow2 - (WSrows shr 1);
c1 := WScol + pred((WScols shr 1));
c2 := WScol2 - (WScols shr 1);
ColRatio := succ(WScols div WSrows);
if ColRatio>4 then ColRatio:=4;
repeat
if r1>WSrow then r1:=pred(r1);
if r2<WSrow2 then r2:=succ(r2);
if c1>WScol then c1:=c1-ColRatio;
if c1<WScol then c1:=WScol;
if c2<WScol2 then c2:=c2+ColRatio;
if c2>WScol2 then c2:=WScol2;
Qbox (r1,c1,succ(r2-r1),succ(c2-c1),WSWattr,WSBattr,WSbrdr);
if not Qsnow then delay (ZoomDelay);
until (c2=WScol2) and (r2=WSrow2);
end;
end;
{ =========================================================================== }
{ NAME: MakeWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Creates a window on your screen. }
{ PARAMETERS: }
{ Row - First row (1 - Screen limit) }
{ Col - First column (1 - Screen limit) }
{ Rows - # of rows (1 - Screen limit) }
{ Cols - # of columns (1 - Screen limit) }
{ Wattr - Window attribute (-1 - 255) }
{ Battr - Border attribute (-1 - 255) }
{ BrdSel - Border selection (NoBrdr - UserBrdr2) }
{ WindowName - User assigned unique window identification name }
{ =========================================================================== }
procedure MakeWindow; { (Row,Col,Rows,Cols: byte; Wattr,Battr: integer;
BrdrSel: Borders; WindowName: WindowNames); }
var
r1,r2,c1,c2,ColRatio,ShadowDir: byte;
UnderlayBytes: word;
{}procedure ShadowFill (VertCol,HorizCol: byte);
{}begin
{} with TopWndwStat do
{} begin
{} Qfill (succ(WSrow) ,VertCol ,pred(WSrows), 2,black,' ');
{} Qfill (succ(WSrow2),HorizCol, 1,WScols,black,' ')
{} end
{}end;
begin
if LI=pred(HLI) then ProgrammingError(2)
else
begin
c1:=Col; c2:=Cols+2; r2:=succ(Rows); { Assume ShadowRight }
ShadowDir := WindowModes and BothShadows;
case ShadowDir of
ShadowLeft: c1:=Col-2;
NoShadow: begin c2:=Cols; r2:=Rows; end; { No shadow }
end;
UnderlayBytes := r2*c2 shl 1; { Memory size needed to store display }
{ Short-circuit boolean evaluation required on next line, because }
{ the heap should NOT be checked in PermMode or an error may result. }
if odd(WindowModes) or HeapOK(UnderlayBytes) then
begin
TopWndwStat.WSwhereR := WhereR; { Old absolute cursor coordinates }
TopWndwStat.WSwhereC := WhereC;
WndwStat[LI]:=TopWndwStat; { Save all stats }
inc(LI); { Go to next higher window level }
with TopWndwStat do
begin
{ Store all variables for this window }
WSrow := Row; WSname := WindowName;
WScol := Col; WSwhereR := succ(WSrow);
WSrows := Rows; WSwhereC := succ(WScol);
WScols := Cols; WSmodes := WindowModes;
WSrow2 := WSrow+pred(WSrows); ULcol := c1;
WScol2 := WScol+pred(WScols); ULcols := c2;
WSWattr := Wattr; ULrows := r2;
WSBattr := Battr; ULbytes := UnderlayBytes;
WSbrdr := BrdrSel;
if WSbrdr=NoBrdr then
begin
dec (WSwhereR);
dec (WSwhereC);
end;
if not odd(WSmodes) then
begin
GetMem (ULptr,ULbytes); { Reserve heap space }
QstoreToMem (WSrow,ULcol,ULrows,ULcols,ULptr^);
end;
if (WindowModes and ZoomMode)=ZoomMode then
ZoomQbox
else Qbox (WSrow,WScol,WSrows,WScols,Wattr,Battr,BrdrSel);
if ShadowDir>NoShadow then
if ShadowDir=ShadowLeft then
ShadowFill (WScol-2 ,WScol-2)
else ShadowFill (succ(WScol2),WScol+2);
end; { with }
WndwStat[LI]:=TopWndwStat; { Save a copy of the stats }
RestoreTurboWindow;
end; { OK }
end; { if LI }
end;
{ =========================================================================== }
{ NAME: PartitionWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Places a partition of the same type as the border }
{ PARAMETERS: Partition - Horiz or Vertical partition }
{ WindowRowOrCol - Location relative to the TP window }
{ =========================================================================== }
procedure PartitionWindow; { (Partition: DirType; WindowRowOrCol: byte);}
var Row,Col: byte;
begin
with TopWndwStat do
if WSbrdr<>NoBrdr then
with Brdr[WSbrdr] do
if Partition=Vertical then
begin
Col:=WScol+WindowRowOrCol;
Qwrite ( WSrow ,Col, WSBattr,PT);
Qfill (succ(WSrow),Col,WSrows-2,1,WSBattr,PV);
Qwrite ( WSrow2,Col, WSBattr,PB);
end
else
begin
Row:=WSrow+WindowRowOrCol;
Qwrite (Row, WScol , WSBattr,PL);
Qfill (Row,succ(WScol),1,WScols-2,WSBattr,PH);
Qwrite (Row, WScol2, WSBattr,PR);
end;
end;
{ =========================================================================== }
{ NAME: PartitionCross ver 4.0, 12-12-87 }
{ DESCRIPTION: Places a cross at the intersection of two partitions }
{ PARAMETERS: WindowRow,WindowCol - Location relative to the TP window }
{ =========================================================================== }
procedure PartitionCross; { (WindowRow, WindowCol: byte);}
begin
with TopWndwStat do
if WSbrdr<>NoBrdr then
Qwrite (WSrow+WindowRow,WScol+WindowCol,WSBattr,Brdr[WSbrdr].PC);
end;
{ =========================================================================== }
{ NAME: RemoveWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Removes the top level window from the screen. To get }
{ back to the original screen, there must be as many }
{ RemoveWindow(s) as there are MakeWindow(s). }
{ =========================================================================== }
procedure RemoveWindow;
begin
with TopWndwStat do
if odd(WSmodes) then ProgrammingError (3) { Tests for PermMode }
else
begin
QstoreToScr (WSrow,ULcol,ULrows,ULcols,ULptr^);
FreeMem (ULptr,ULbytes);
WndwStat[LI]:=TopWndwStat; { Save any changes }
dec (LI); { Go to next lower level }
TopWndwStat:=WndwStat[LI]; { Make a copy of the new stats }
RestoreTurboWindow;
end
end;
{ =========================================================================== }
{ NAME: TitleWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Places a title on the top or bottom border of a window. }
{ PARAMETERS: Justify - justification of the title }
{ Title - Optional title of the window }
{ =========================================================================== }
procedure TitleWindow; { (TopOrBottom,Justify: DirType; Title: string); }
var R: byte;
begin
with TopWndwStat do
begin
if TopOrBottom=Bottom then
R:=WSrow2
else R:=WSrow;
case Justify of
Left: Qwrite (R,WScol+2 ,-1,Title);
Right: Qwrite (R,WScol2-succ(length(Title)),-1,Title);
else QwriteC (R,WScol,WScol2 ,-1,Title);
end;
end;
end;
{ =========================================================================== }
{ NAME: ClearTitle ver 4.0, 12-12-87 }
{ DESCRIPTION: Clears the title on the top or bottom border of a window. }
{ PARAMETERS: TopOrBottom - All of the top or bottom line }
{ =========================================================================== }
procedure ClearTitle; { (TopOrBottom: DirType); }
var
Row: byte;
BrdrPart: char;
begin
with TopWndwStat do
begin
if TopOrBottom=Bottom then
Row:=WSrow2
else Row:=WSrow;
if WSbrdr=NoBrdr then
Qfill (Row,WScol,1,WScols,-1,' ')
else
begin
if TopOrBottom=Bottom then
BrdrPart:=Brdr[WSbrdr].BH
else BrdrPart:=Brdr[WSbrdr].TH;
Qfill (Row,succ(WScol),1,WScols-2,-1,BrdrPart);
end;
end;
end;
{ =========================================================================== }
{ NAME: ClearWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Same as ClrScr, but works on any video page. }
{ =========================================================================== }
procedure ClearWindow;
begin
with TopWndwStat do
if WSbrdr=NoBrdr then
begin
Qfill (WSrow,WScol,WSrows,WScols,WSWattr,' ');
GotoRC (WSrow,WScol);
end
else
begin
Qfill (succ(WSrow),succ(WScol),WSrows-2,WScols-2,WSWattr,' ');
GotoRC (succ(WSrow),succ(WScol));
end;
end;
{ =========================================================================== }
{ NAME: ScrollWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Scrolls a number of rows in a window. Using a little }
{ thought, you can see how this is better than the InsLine }
{ and DelLine procedures. Flicker-free and works on any page. }
{ PARAMETERS: RowBegin,RowEnd - Window relative rows to be affected }
{ Dir - 'Up' or 'Down' }
{ =========================================================================== }
procedure ScrollWindow; { (RowBegin,RowEnd: byte; Dir: DirType); }
var BrdrWidth,R,C,Rs,Cs: byte;
{}procedure Qscroll (MemRowBegin,ScrRowBegin,FillRow: byte);
{}var Temp: WordArrayPtrType;
{} TempBytes: word;
{}begin
{} TempBytes := Rs*Cs shl 1;
{} if HeapOK(TempBytes) then
{} begin
{} GetMem (Temp,TempBytes);
{} QstoreToMem (MemRowBegin,C,Rs,Cs,Temp^);
{} QstoreToScr (ScrRowBegin,C,Rs,Cs,Temp^);
{} Qfill (FillRow ,C, 1,Cs,TopWndwStat.WSWattr,' ');
{} FreeMem (Temp,TempBytes);
{} end
{}end;
begin
with TopWndwStat do
begin
if WSbrdr=NoBrdr then
BrdrWidth:=0
else BrdrWidth:=1;
R := WSrow+BrdrWidth+pred(RowBegin);
C := WScol+BrdrWidth;
Rs := RowEnd-RowBegin;
Cs := WScols-(BrdrWidth shl 1);
case Dir of
Up: Qscroll (succ(R), R ,R+Rs);
Down: Qscroll ( R ,succ(R),R );
end
end
end;
{ =========================================================================== }
{ NAME: HideWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Hides the top window on the screen and saves the }
{ contents for later display. }
{ =========================================================================== }
procedure HideWindow;
begin
end;
{ To conserve data space for windows that are hidden, the WndwStats are kept
from WndwStat[MaxWndw] down, while the windows displayed are kept from
WndwStat[1] up. So, when HideWindow is executed, the TopWndwStats are
move to the highest available index set by HLI (Hidden Level Index). In
addition, the Window that disappeared from the screen is kept where the
previous underlay was - ULptr^. }
{ =========================================================================== }
{ NAME: ShowWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Shows a hidden window on the screen as the new top window. }
{ PARAMETERS: WindowName - name of the window to be shown }
{ =========================================================================== }
procedure ShowWindow; { (WindowName: WindowNames); }
begin
end;
{ ShowWindow searches WndwStat[HLI] up for WindowName. If found, the stats
are move to WndwStat[LI] and TopWndwStat. The remaining hidden WndwStats
are reshuffled to close up the gap. There's no worry about overlap. }
{ =========================================================================== }
{ NAME: MoveWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Moves the top window on the screen. }
{ PARAMETERS: Dir - Up, Down, Left, or Right }
{ NumOfChars - Number of Cols or Rows to move over }
{ =========================================================================== }
procedure MoveWindow; { (Dir: DirType; NumOfChars: byte); }
begin
end;
{ MoveWindow not only allows any direction, but the number of characters to
move can also be specified. This allows a rate-controlled movement. In
addition, the movement is limited to the margins specified in the Margins
record which defaults to the screen limits. Shadows for movement on the
top level are completely supported. }
{ =========================================================================== }
{ NAME: GetLevelIndex ver 4.0, 12-12-87 }
{ DESCRIPTION: Scans WndwStats for first matching WindowName. LI and }
{ below are scanned first. Hidden windows from HLI up are }
{ scanned last. If no match is found, result is zero. }
{ PARAMETERS: WindowName - identification name of window to be found }
{ =========================================================================== }
function GetLevelIndex; { (WindowName: WindowNames): byte; }
var i: byte;
begin
i:=LI;
while ((i>0) and (WindowName<>WndwStat[i].WSname)) do
dec (i);
if (i=0) then
begin
i:=HLI;
while ((i<=MaxWndw) and (WindowName<>WndwStat[i].WSname)) do
inc (i);
end;
if i>MaxWndw then i:=0;
GetLevelIndex:=i;
end;
{ =========================================================================== }
{ NAME: AccessWindow ver 4.0, 12-12-87 }
{ DESCRIPTION: Accessess a window covered by other windows to become the }
{ the new top window. }
{ PARAMETERS: WindowName - identification name of window to be accessed }
{ =========================================================================== }
procedure AccessWindow; { (WindowName: WindowNames); }
begin
end;
{ AccessWindow pulls out any window underneath the top level window, and if
the window is hidden, AccessWindow will simply use the ShowWindow
procedure. The WndwStats and the heap memory are relocated and reshuffled.
If ZoomMode was set when the window was created with MakeWindow, it will
also be accessed with a zoom effect. If a shadow mode is set, that window
will appear correctly, but if a window between the accessed level and the
top level has a shadow, the gaps will not be correctly. Hopefully, you
will see that lots of shadows gets messy anyway. I would suggest that
you use a shadow only on the top level to give it that off-the-screen
appearance. }
END.