home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 September
/
Simtel20_Sept92.cdr
/
msdos
/
turbopas
/
wndw_msj.arc
/
WNDWMSJ2.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1988-11-19
|
10KB
|
318 lines
{From Micro/Systems Journal, Dec 88}
{Advanced windowing package -
by Stephen Randy Davis, 1988
This windowing package does not suffer from the single-tasking
limitations of many windowing packages. Specifically, these
windows may be scrolled independently, even windows that are
not currently on top.
}
{Toad Hall Tweaks:
Using PRED(int) instead of int - 1, SUCC(int) instead of int + 1
Using ShL 1 instead of *2
Writing back to Turbo 3.0 (replacing 'word' with INTEGER)
Changing test attributes to 'normal', 'underlined', and 'reverse'
for mono screens.
}
TYPE
datablock = ARRAY[0..1] OF INTEGER;
Str80 = STRING[80];
windowNodePtr = ^windowNode;
masktype = INTEGER; {TH}
windowNode = RECORD
signature : INTEGER;
deltaX,deltaY : INTEGER;
winX,winY : INTEGER;
color : INTEGER;
currentX,currentY : INTEGER;
priority,mask : masktype;
next : windowNodePtr;
dsize : INTEGER;
data : ^datablock;
END;
CONST
CGA = $B800; {offset of CGA/EGA}
MONO = $B000; {mono screen}
WINSIG = $1234;
VAR
head : windowNodePtr; {pointer to the window list}
screen : ARRAY[0..24] OF ARRAY[0..79] OF INTEGER
absolute mono:0; {currently set for mono}
accessrights : ARRAY[0..24] OF ARRAY[0..79] OF masktype;
{These procedures are required internally}
PROCEDURE Sig_Check(w : windowNodePtr; Msg : Str80);
{Check the node signature to make sure it's valid}
BEGIN
IF w^.signature <> WINSIG THEN BEGIN
Writeln('Signature Error: ', Msg);
Halt;
END;
END; {of Sig_Check}
PROCEDURE Window_Add(before, w : windowNodePtr);
{Add a window to the window list}
BEGIN
Sig_Check(w, 'Window Add W argument');
Sig_Check(before, 'Window Add Before argument');
w^.next := before^.next;
before^.next := w;
END; {of Window_Add}
PROCEDURE Window_Remove(w : windowNodePtr);
{Remove a window from the window list}
VAR pntr : windowNodePtr;
BEGIN
Sig_Check(w, 'WindowRemove W argument');
pntr := head;
WHILE pntr <> NIL DO BEGIN
IF pntr^.next = w
THEN pntr^.next := w^.next;
pntr := pntr^.next;
END;
END; {of Window_Remove}
FUNCTION _precedence (w : windowNodePtr) : masktype;
{Calculate the precedence of a window in the list}
VAR
pntr : windowNodePtr;
p : masktype;
BEGIN
IF w <> NIL THEN Sig_Check(w, 'Precedence W argument');
p := 0;
pntr := head^.next;
WHILE pntr <> w DO BEGIN
Sig_Check(pntr, 'Precedence chain traversal');
p := p OR pntr^.priority;
pntr := pntr^.next;
END;
_precedence := p;
END; {of _precedence}
PROCEDURE New_Mask(VAR w : windowNodePtr); {TH the VAR is mine}
{Calculate a mask for the current window node}
VAR
mask,bit : masktype;
{ pntr : windowNodePtr; unused}
BEGIN
mask := _precedence(NIL);
bit := 1;
WHILE (bit AND mask) <> 0 DO
bit := bit + bit;
IF bit <> 0 THEN BEGIN
w^.priority := bit;
w^.mask := NOT (mask OR bit);
END;
END; {of New_Mask}
PROCEDURE Set_Access(w : windowNodePtr);
{Add the current window to the access list}
VAR x,y : INTEGER; {TH}
BEGIN
Sig_Check(w, 'SetAccess window argument');
WITH w^ DO
FOR y := deltaY TO deltaY + PRED(winY) DO
FOR x := deltaX TO deltaX + PRED(winX) DO
accessrights [y][x] := accessrights [y][x] XOR priority;
END; {of Set_Access}
PROCEDURE Window_Paint (w : windowNodePtr);
{Paint the current window to the screen}
VAR x,y,offset : INTEGER; {TH}
wd,ht : INTEGER; {TH}
BEGIN
Sig_Check(w, 'WindowPaint window argument');
WITH w^ DO
FOR ht := 0 TO PRED(winY) DO BEGIN {TH}
y := deltaY + ht;
offset := ht * winX;
FOR wd := 0 TO PRED(winX) DO BEGIN {TH}
x := deltaX + wd;
IF (accessrights [y][x] AND mask) = 0
THEN screen [y][x] := w^.data^ [offset + wd];
END; {for}
END; {for}
END; {of Window_Paint}
PROCEDURE Restack;
{Restack the precedence of the windows in the list}
VAR pntr : windowNodePtr;
BEGIN
pntr := head^.next;
WHILE pntr <> NIL DO BEGIN
pntr^.mask := _precedence(pntr);
Window_Paint(pntr);
pntr := pntr^.next;
END; {while}
END; {of Restack}
PROCEDURE Window_Scroll(w : windowNodePtr; count : INTEGER);
{Scroll the current window by 'count' lines}
VAR index,offset,total : INTEGER; {TH}
BEGIN
WITH w^ DO
IF count > 0 THEN BEGIN
currentX := 0; {carriage return}
currentY := currentY + count; {line feed(s)}
IF currentY >= winY {if beyond window's end...}
THEN BEGIN {... scroll window's contents}
count := SUCC(currentY - winY); {TH}
currentY := PRED(winY); {TH}
offset := winX * count;
total := winX * (winY - count);
FOR index := 0 TO total DO
data^[index] := data^[index + offset];
FOR index := total TO PRED(total + offset) DO {TH}
data^[index] := color + INTEGER(' '); {TH}
END; {if scrolling}
END; {with}
Window_Paint(w);
END; {of Window_Scroll}
{User accessible functions are Window_Open, Window_Close, Window_Write,
and Window_Pop}
FUNCTION window_Open (x,y,width,height,attr : INTEGER) : windowNodePtr;
{Open a window of the given size and color}
VAR
w : windowNodePtr;
i, j : INTEGER; {TH}
BEGIN
NEW(w);
WITH w^ DO BEGIN
{Save data into window}
signature := WINSIG; {store signature field in first thing}
deltaX := x;
deltaY := y;
winX := width;
winY := height;
color := attr;
currentX := 0; {set cursor to beginning of window}
currentY := 0;
{store off the section of screen into the windownode}
dsize := (winY * winX) ShL 1; {TH}
GetMem(data,dsize);
{Calculate priority of current window}
New_Mask(w);
{Set the access list for this window}
Set_Access(w);
{Now add window to the linked list}
Window_Add(head,w);
{Finally, clear window and write it to the screen}
FOR i := 0 TO winY DO
FOR j := 0 to winX DO
data^[i * winX + j] := color;
WIndow_Paint(w);
END;
Window_Open := w; {return function result}
END; {of Window_Open}
PROCEDURE Window_Close(VAR w : windowNodePtr);
{Close and remove the window from the window list}
BEGIN
Window_Remove(w); {remove window from list}
Set_Access(w); {now remove its mask}
FreeMem(w^.data, w^.dsize); {free up its data memory}
Dispose(w); {and its node}
Restack; {repaint windows left}
w := NIL; {and return a NULL}
END; {of Window_Close}
PROCEDURE Window_Pop(before, w : windowNodePtr);
{Move the window 'w' after the window 'before' in the
window list.
}
BEGIN
Window_Remove(w); {remove the window}
Window_Add(before,w); {now reposition it}
Restack; {and redraw all windows}
END; {of Window_Pop}
PROCEDURE Window_Writeln(w : windowNodePtr; OutStr : Str80;
nlines : INTEGER); {TH}
{Write an ASCII string to the specified window}
VAR
i,vertoffset : INTEGER; {TH}
count : BYTE absolute OutStr;
BEGIN
WITH w^ DO BEGIN
vertoffset := currentY * winX;
FOR i := 1 TO count DO
IF currentX < winX THEN BEGIN
data^ [vertoffset + currentX] := color + INTEGER(Outstr[i]);
currentX := SUCC(currentX); {TH}
END;
END; {with}
Window_Scroll(w,nlines);
END; {of Window_Writeln}
PROCEDURE Exercise_W (w : windowNodePtr);
{Test code to write to and scroll the specified window}
VAR i : INTEGER;
BEGIN
FOR i := 1 TO 100 DO
Window_Writeln(w,'This''s just a string', SUCC(i MOD 3) ); {TH}
END; {of Exercise_W}
VAR
background,w1,w2,w3 : windowNodePtr;
x,y : INTEGER; {TH}
BEGIN {main}
{Initialization section}
New(head); {define a head structure}
head^.signature := WINSIG; {to point to the window list}
head^.next := NIL;
FOR y := 0 TO 24 DO {clear the accessrights}
FOR x := 0 TO 79 DO
accessrights[y][x] := 0;
background := Window_Open(0,0,80,25,$0700);
{Open a few overlapping windows and exercise them --
remove this to make this into an Advanced Window Unit}
w1 := window_Open(10,10,50,10,$7000); {1300H for CGA}
Exercise_W(w1);
w2 := window_Open(20,5,30,17,$0100); {4200H for CGA}
Exercise_W(w2);
w3 := window_Open(30,7,20,8,$0700); {2500H for CGA}
Exercise_W(w3);
Exercise_W(w1); {scroll background window}
{change the order of the windows}
Window_Pop(w1,w2); {pop window1 above window2}
Exercise_W(w1); {and scroll it again}
{remember to close the windows to remove this from the display}
Window_Close(w2);
Window_Close(w3);
Window_Close(w1);
END.
