language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/windows.mod
IMPLEMENTATION MODULE Windows;
(********************************************************)
(* *)
(* Text-mode screen windows. *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 27 February 1995 *)
(* Status: Working *)
(* *)
(* For further thought at some later stage: *)
(* - (maybe) extend the set of procedures *)
(* for which w^.access0p5 is locked. *)
(* *)
(********************************************************)
FROM SYSTEM IMPORT
(* proc *) ADR;
FROM Types IMPORT
(* proc *) FarPointer, FarCharPointer;
FROM LowLevel IMPORT
(* proc *) Far, MakePointer, FarAddOffset, Copy, FarCopy, CopyUp, IXOR;
FROM Storage1 IMPORT
(* proc *) ALLOCATE, DEALLOCATE;
FROM TerminationControl IMPORT
(* proc *) SetTerminationProcedure, TerminationMessage;
FROM TaskControl IMPORT
(* type *) Lock,
(* proc *) CreateTask, CreateLock, DestroyLock,
Obtain, Release, ReleaseAllLocks;
FROM Semaphores IMPORT
(* type *) Semaphore,
(* proc *) CreateSemaphore, DestroySemaphore, Wait, Signal;
FROM TextVideo IMPORT
(* proc *) VideoKind, SetTextPage, PositionCursor;
FROM Keyboard IMPORT
(* proc *) InKey, PutBack;
(************************************************************************)
(* If you want black-and-white operation even though your *)
(* display supports colour (e.g. for the case where the colours *)
(* are not very readable), set ForcedMonochrome to TRUE. *)
(* Otherwise, this module selects colour operation if it *)
(* thinks that the hardware can support it. *)
(************************************************************************)
CONST ForcedMonochrome = FALSE;
(************************************************************************)
CONST
BytesPerChar = 2; (* # bytes/char in video buffer *)
CharsPerRow = MaxColumnNumber + 1; (* characters per row *)
BytesPerRow = BytesPerChar*CharsPerRow;
buffersize = BytesPerRow * (MaxRowNumber+1);
(* size of window buffer *)
PageSize = 4096; (* offset to next display page *)
DefaultPage = 0;
DefaultTabs =
" T T T T T T T T T";
(************************************************************************)
TYPE
buffersubscript = [0..buffersize - 1];
extendedbuffersubscript = [0..buffersize + BytesPerRow - 1];
CloseHandlerList = POINTER TO CloseHandlerRecord;
CloseHandlerRecord = RECORD
next: CloseHandlerList;
proc: CloseHandlerProc;
END (*RECORD*);
PageChangeList = POINTER TO PageChangeRecord;
PageChangeRecord = RECORD
next: PageChangeList;
proc: PageChangeHandler;
END (*RECORD*);
Window = POINTER TO WindowData;
(****************************************************************)
(* *)
(* WindowData records are linked (by next and previous) as a *)
(* doubly linked list, to implement a stack of windows. *)
(* There is a separate stack for each display page. *)
(* Variable TopWindow[page] points to the top of this stack. *)
(* *)
(* The access0p5 lock is to control simultaneous access *)
(* to a single window by multiple tasks. This is a new *)
(* feature, so the protection is implemented for some but not *)
(* all operations at this stage. I'm still working on whether *)
(* access0p5 should be a Lock or a Semaphore. From the *)
(* viewpoint of the external caller it's better to make it a *)
(* Lock, but that creates problems during shutdown. *)
(* *)
(* CloseList points to a linked list of procedures to be *)
(* called when this window is closed. *)
(* *)
(* The row and column values stored in this record are actual *)
(* screen row and column, i.e. they are not window-relative. *)
(* *)
(* The ScreenPosition field is a subscript into the hardware *)
(* video buffer. It can be computed easily from the "page", *)
(* "row", and "column" fields, but it is more convenient to *)
(* keep this technically redundant variable. *)
(* *)
(* BufferBias is the difference between a byte location in the *)
(* window's buffer and the corresponding ScreenPosition value. *)
(* In the present version it's always equal to PageSize*page, *)
(* but I might want to change that in future. *)
(* *)
(* A window's InputWaiting flag is set when it is waiting for *)
(* a keyboard character. When the character arrives it is *)
(* stored in the InputChar field of this record, and we are *)
(* notified of this by a Release(CharAvailable). Because the *)
(* requests for input are not necessarily satisfied in a FIFO *)
(* order - because the input focus can change before the input *)
(* arrives - we need a separate semaphore and InputChar field *)
(* for each window, even though these fields remain unused for *)
(* most windows. *)
(* *)
(* A window with the "hidden" flag set is not part of the *)
(* stack of windows, and is not visible on the screen. *)
(* *)
(* The "obscured" field indicates whether this window is wholly *)
(* or partially obscured by another window on the screen. By *)
(* keeping track of this, we can avoid some unnecessary screen *)
(* refreshing. *)
(* *)
(* The "blockcursor" field specifies what kind of cursor to *)
(* display: a block cursor if TRUE, an underline cursor if *)
(* FALSE. Most of the time this is irrelevant, as we display *)
(* a cursor only during input, and even then we display it only *)
(* if the window's CursorWanted flag is TRUE. *)
(* *)
(* The "buffer" array holds a copy of what is supposed to be *)
(* transferred to the video buffer. *)
(* *)
(****************************************************************)
WindowData = RECORD
next, previous: Window;
access0p5: Semaphore;
CloseList: CloseHandlerList;
frame: FrameType; divider: DividerType;
tabstops: ARRAY ColumnRange OF CHAR;
ScrollRegion, DefaultScrollRegion: Rectangle;
page: DisplayPage;
FirstRow, LastRow, row: RowRange;
FirstColumn, LastColumn: ColumnRange;
column: [0..MAX(ColumnRange)+1];
ScreenPosition, BufferBias: CARDINAL;
foreground, background: Colour;
CurrentAttributes: CHAR;
InputChar: CHAR;
CharAvailable: Semaphore;
InputWaiting, hidden, obscured,
CursorWanted, blockcursor: BOOLEAN;
buffer: ARRAY buffersubscript OF CHAR;
END (*RECORD*);
(************************************************************************)
(* NOTE ON CRITICAL SECTION PROTECTION *)
(* The potential deadlock problems in this module are surprisingly *)
(* subtle, arising from the fact that a procedure incorporating one *)
(* form of critical section protection may call other procedures which *)
(* themselves contain critical section protection. To avoid these *)
(* problems, we use an ordered resource policy. Each critical section *)
(* protection semaphore is given a "level", which for clarity is shown *)
(* as the last character of its name. A piece of code is said to be *)
(* executing at level N if it is inside a critical section protected *)
(* by a semaphore whose level is N (and not inside a critical section *)
(* protected by any semaphore of any higher level). The rule which *)
(* avoids deadlock is: to lock a semaphore at level N, we must be *)
(* executing at a level < N. *)
(* For the purposes of this analysis, Locks and Semaphores are treated *)
(* as being equivalent. *)
(* *)
(* LATEST DEVELOPMENT *)
(* Because I'm adding a new semaphore, but haven't yet updated the *)
(* notation, a new level 0p5 (meaning 0.5) has been added. *)
(************************************************************************)
VAR
(* BlackAndWhite is true if we have a monochrome display. *)
BlackAndWhite: BOOLEAN;
(* ActivePage is the display page currently visible on the screen. *)
ActivePage: DisplayPage;
(* A list of procedures to call whenever the current display page *)
(* is changed, and a lock to control access to this list. *)
PageChangeProcs: PageChangeList;
PageChangeListAccess: Lock;
(* A semaphore to say that somebody wants some keyboard input. *)
InputRequest: Semaphore;
(* BlankRow is set up by the initialisation code as a row of space *)
(* characters. Note however that the attribute codes need to be *)
(* filled in before each use. *)
BlankRow: ARRAY [0..BytesPerRow-1] OF CHAR;
(* Access to BlankRow is a critical section, so we protect it with *)
(* a Lock. *)
BlankRowAccess1: Lock;
(* StackAccess2 is used to protect access to the shared data *)
(* structure which defines the stacks of windows. *)
StackAccess2: Lock;
(* TopWindow[p] is the current top of the stack of windows for *)
(* display on physical display page p. *)
TopWindow: ARRAY DisplayPage OF Window;
(* ScreenAccess3 is used to protect access to memory in segment *)
(* ScreenSeg, i.e. the memory belonging to the physical screen. *)
ScreenAccess3: Lock;
(* ScreenSeg is a segment selector for the hardware video buffer. *)
ScreenSeg: CARDINAL;
(* PhysicalCursor keeps track of the blinking screen cursor. The *)
(* CursorWindow field shows which window, if any, currently "owns" *)
(* the physical cursor. CursorVisible[page] shows whether the *)
(* cursor should be visible when "page" is the active display page. *)
(* Lock access4 is used to protect these variables and the hardware *)
(* operations of turning the cursor on and off. *)
(* For now, access4 also protects alterations to the active *)
(* display page. *)
PhysicalCursor: RECORD
access4: Lock;
CursorWindow: ARRAY DisplayPage OF Window;
CursorVisible: ARRAY DisplayPage OF BOOLEAN;
END (*RECORD*);
(************************************************************************)
(* TURNING THE SCREEN CURSOR ON AND OFF *)
(************************************************************************)
PROCEDURE CursorOff;
(* Turns the cursor off. Caller must be executing at level 4. *)
BEGIN
PositionCursor (FALSE, 0, FALSE);
END CursorOff;
(************************************************************************)
PROCEDURE CursorOn (position: CARDINAL; blockcursor: BOOLEAN);
(* Displays a blinking screen cursor at the specified position. *)
(* Caller must be executing at level 4. *)
BEGIN
PositionCursor (TRUE, position, blockcursor);
END CursorOn;
(************************************************************************)
PROCEDURE UpdatePhysicalCursor;
(* Turns the physical cursor on or off, as appropriate. Also *)
(* signals a new input request, if a window on the active page is *)
(* waiting for input, in case the input task has gone idle. *)
(* The caller must be running at level<4. *)
VAR w: Window;
BEGIN
WITH PhysicalCursor DO
Obtain (access4);
w := CursorWindow[ActivePage];
IF w <> NIL THEN
Signal (InputRequest);
END (*IF*);
IF CursorVisible[ActivePage] THEN
CursorOn (w^.ScreenPosition, w^.blockcursor);
ELSE
CursorOff;
END (*IF*);
Release (access4);
END (*WITH*);
END UpdatePhysicalCursor;
(************************************************************************)
(* HARDWARE DISPLAY PAGE CHANGES *)
(************************************************************************)
PROCEDURE SetActivePage (page: DisplayPage);
(* Changes the active display page. *)
VAR PCL: PageChangeList;
BEGIN
Obtain (PhysicalCursor.access4);
SetTextPage (VAL(SHORTCARD,page));
ActivePage := page;
Release (PhysicalCursor.access4);
(* Call the procedures which want notification of the change. *)
Obtain (PageChangeListAccess);
PCL := PageChangeProcs;
WHILE PCL <> NIL DO
PCL^.proc (page);
PCL := PCL^.next;
END (*WHILE*);
Release (PageChangeListAccess);
(* Turn the cursor off or on, as appropriate. *)
UpdatePhysicalCursor;
END SetActivePage;
(************************************************************************)
PROCEDURE RequestPageChangeNotification (Proc: PageChangeHandler);
(* Sets up Proc as a procedure to be called on a page change. *)
VAR PCL: PageChangeList;
BEGIN
NEW (PCL);
Obtain (PageChangeListAccess);
WITH PCL^ DO
next := PageChangeProcs;
proc := Proc;
END (*WITH*);
PageChangeProcs := PCL;
Release (PageChangeListAccess);
END RequestPageChangeNotification;
(************************************************************************)
PROCEDURE PageOf (w: Window): DisplayPage;
(* Returns the display page on which window w resides. *)
BEGIN
RETURN w^.page;
END PageOf;
(************************************************************************)
(* MANIPULATION OF THE STACK OF WINDOWS *)
(************************************************************************)
PROCEDURE UnLink (w: Window);
(* Removes w^ from the stack, but otherwise leaves it unchanged. *)
(* Caller must have locked StackAccess2. *)
BEGIN
WITH w^ DO
IF previous <> NIL THEN previous^.next := next END (*IF*);
IF next <> NIL THEN next^.previous := previous END (*IF*);
IF TopWindow[page] = w THEN TopWindow[page] := next END (*IF*);
previous := NIL; next := NIL;
END (*WITH*);
END UnLink;
(************************************************************************)
PROCEDURE IdentifyTopWindow (VAR (*OUT*) w: Window;
VAR (*INOUT*) row: RowRange;
VAR (*INOUT*) col: ColumnRange): BOOLEAN;
(* On entry w is unspecified and (row,col) describes a position on *)
(* the screen. On exit w is equal to the top window containing *)
(* this screen location, and (row,col) have been altered to be *)
(* window-relative coordinates. Exception: if there is no visible *)
(* window containing the given point, the function result is FALSE, *)
(* the returned w is NIL, and row and col are unchanged. *)
BEGIN
Obtain (StackAccess2);
w := TopWindow[ActivePage];
LOOP
IF w = NIL THEN EXIT(*LOOP*);
ELSIF (col >= w^.FirstColumn) AND (col <= w^.LastColumn)
AND (row >= w^.FirstRow) AND (row <= w^.LastRow) THEN
DEC (row, w^.FirstRow); DEC (col, w^.FirstColumn);
EXIT (*LOOP*);
ELSE
w := w^.next;
END (*IF*);
END (*LOOP*);
Release (StackAccess2);
RETURN w <> NIL;
END IdentifyTopWindow;
(************************************************************************)
PROCEDURE ComputeCursorWindow (page: DisplayPage);
(* Rechecks which window on this page should have the physical *)
(* screen cursor, and displays or turns off the cursor, as *)
(* appropriate, if a change is needed. This procedure should be *)
(* called whenever there is a chance that the input focus might *)
(* need to be shifted. *)
VAR w, wtop: Window; visible: BOOLEAN;
row: RowRange; col: ColumnRange;
BEGIN
(* Find the top window that's waiting for input. *)
Obtain (StackAccess2);
w := TopWindow[page];
LOOP
IF w = NIL THEN EXIT(*LOOP*) END(*IF*);
IF w^.InputWaiting THEN EXIT(*LOOP*) END(*IF*);
w := w^.next;
END (*LOOP*);
Release (StackAccess2);
(* Check whether the cursor should be visible. *)
IF w = NIL THEN
visible := FALSE;
ELSE
row := w^.row; col := w^.column;
visible := IdentifyTopWindow (wtop, row, col) AND (wtop = w);
END (*IF*);
(* Turn the cursor on or off, if necessary. *)
WITH PhysicalCursor DO
Obtain (access4);
IF (w = NIL) OR (CursorWindow[page] <> w) THEN
CursorWindow[page] := w;
CursorVisible[page] := visible AND w^.CursorWanted;
IF page = ActivePage THEN
IF CursorVisible[page] THEN
CursorOn (w^.ScreenPosition, w^.blockcursor);
ELSE
CursorOff;
END (*IF*);
END (*IF*);
END (*IF*);
Release (access4);
END (*WITH*);
END ComputeCursorWindow;
(************************************************************************)
(* SCREEN REFRESHING *)
(************************************************************************)
PROCEDURE PartialRefresh (w: Window; startrow, endrow: RowRange;
startcol, endcol: ColumnRange);
(* Re-draws the image of window w on the screen, in the area *)
(* bounded by the given absolute screen coordinates. The ranges *)
(* specified are inclusive limits. *)
(* Caller must be executing at level <3. *)
VAR i: RowRange;
offset: extendedbuffersubscript; count: CARDINAL;
BEGIN
WITH w^ DO
(* Work out the overlap between the region and the window. *)
IF FirstRow > startrow THEN startrow := FirstRow END (*IF*);
IF LastRow < endrow THEN endrow := LastRow END (*IF*);
IF FirstColumn > startcol THEN startcol := FirstColumn END (*IF*);
IF LastColumn < endcol THEN endcol := LastColumn END (*IF*);
(* Refresh that region, if it is nonempty. *)
IF (startrow <= endrow) AND (startcol <= endcol) THEN
offset := BytesPerRow*startrow + BytesPerChar*startcol;
count := BytesPerChar*(endcol - startcol + 1);
Obtain (ScreenAccess3);
FOR i := startrow TO endrow DO
FarCopy (Far(ADR(buffer[offset])),
MakePointer(ScreenSeg, offset+BufferBias), count);
INC (offset, BytesPerRow);
END (*FOR*);
Release (ScreenAccess3);
END (*IF*);
END (*WITH*);
END PartialRefresh;
(************************************************************************)
PROCEDURE Refresh (w: Window);
(* Re-draws the image of window w on the screen. *)
(* Caller must be executing at level <3. *)
VAR i: RowRange; offset: extendedbuffersubscript;
count: CARDINAL;
BEGIN
WITH w^ DO
offset := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
count := BytesPerChar*(LastColumn - FirstColumn + 1);
Obtain (ScreenAccess3);
FOR i := FirstRow TO LastRow DO
FarCopy (Far(ADR(buffer[offset])),
MakePointer(ScreenSeg, offset+BufferBias), count);
INC (offset, BytesPerRow);
END (*FOR*);
Release (ScreenAccess3);
obscured := FALSE;
END (*WITH*);
END Refresh;
(************************************************************************)
PROCEDURE ComputeCollisions (w: Window);
(* Updates the "obscured" field of all windows which are below this *)
(* one on the stack, and sets w^.obscured to FALSE. Also updates *)
(* the cursor visibility information, based on the assumption that *)
(* w is the window on top of its stack. *)
(* Caller must have locked StackAccess2. *)
(* Caller must be executing at level <4. *)
VAR left, right: ColumnRange;
top, bottom: RowRange;
w2: Window; p: DisplayPage;
BEGIN
(* Take note of the screen location of this window. *)
WITH w^ DO
obscured := FALSE;
left := FirstColumn; right := LastColumn;
top := FirstRow; bottom := LastRow;
w2 := next; p := page;
END (*WITH*);
(* Update the cursor visibility information. *)
WITH PhysicalCursor DO
Obtain (access4);
IF w^.InputWaiting THEN
CursorWindow[p] := w;
CursorVisible[p] := w^.CursorWanted;
ELSIF CursorVisible[p] THEN
WITH CursorWindow[p]^ DO
CursorVisible[p] := (row < top) OR (row > bottom)
OR (column < left) OR (column > right);
END (*WITH*);
END (*IF*);
Release (access4);
END (*WITH*);
(* Update the "obscured" information for all windows under *)
(* the current window. (For those which are already obscured *)
(* by some other window, no further check is needed.) *)
WHILE w2 <> NIL DO
WITH w2^ DO
IF NOT obscured THEN
obscured := (LastColumn >= left) AND (FirstColumn <= right)
AND (LastRow >= top) AND (FirstRow <= bottom);
END (*IF*);
END (*WITH*);
w2 := w2^.next;
END (*WHILE*);
END ComputeCollisions;
(************************************************************************)
PROCEDURE PutOnTopI (w: Window);
(* Makes w the top of stack, and refreshes its image on the screen. *)
(* This procedure does the same job as PutOnTop (see below), but *)
(* different entry assumptions. *)
(* The caller must have locked StackAccess2. *)
(* The caller must be executing at level 2. *)
BEGIN
UnLink (w);
IF TopWindow[w^.page] <> NIL THEN
TopWindow[w^.page]^.previous := w
END (*IF*);
w^.next := TopWindow[w^.page]; TopWindow[w^.page] := w;
Refresh (w); ComputeCollisions (w);
IF w^.page = ActivePage THEN
UpdatePhysicalCursor;
END (*IF*);
END PutOnTopI;
(************************************************************************)
PROCEDURE PutOnTop (w: Window);
(* Makes w the top of stack, and refreshes its image on the screen. *)
(* This also unhides w if it was hidden. *)
(* This is the externally callable version. *)
(* The caller must be executing at a level <0.5. *)
BEGIN
Wait (w^.access0p5);
Obtain (StackAccess2);
w^.hidden := FALSE;
IF TopWindow[w^.page] <> w THEN
PutOnTopI (w);
ELSIF w^.page = ActivePage THEN
UpdatePhysicalCursor;
END (*IF*);
Release (StackAccess2);
Signal (w^.access0p5);
END PutOnTop;
(************************************************************************)
PROCEDURE Repaint (page: DisplayPage; startrow, endrow: RowRange;
startcol, endcol: ColumnRange);
(* Repaints the specified (inclusive) rectangular region on the *)
(* screen, and sets the physical screen cursor as necessary. *)
(* The caller must be executing at level <1. *)
CONST NormalVideo = CHR(07H);
VAR i: RowRange;
offset: CARDINAL; count: buffersubscript;
p: Window;
BEGIN
(* First, clear the region. *)
Obtain (BlankRowAccess1);
FOR offset := 1 TO BytesPerRow-1 BY BytesPerChar DO
BlankRow[offset] := NormalVideo;
END (*FOR*);
offset := PageSize*page + BytesPerRow*startrow + BytesPerChar*startcol;
count := BytesPerChar*(endcol - startcol + 1);
Obtain (ScreenAccess3);
FOR i := startrow TO endrow DO
FarCopy (Far(ADR(BlankRow)),
MakePointer(ScreenSeg, offset), count);
INC (offset, BytesPerRow);
END (*FOR*);
Release (ScreenAccess3);
Release (BlankRowAccess1);
(* Now refresh all open windows (or, more precisely, the parts *)
(* of them which lie in the affected region). *)
Obtain (StackAccess2);
WITH PhysicalCursor DO
Obtain (access4);
CursorWindow[page] := NIL;
CursorVisible[page] := FALSE;
Release (access4);
END (*WITH*);
IF TopWindow[page] <> NIL THEN
p := TopWindow[page];
WHILE p^.next <> NIL DO p := p^.next END (*WHILE*);
REPEAT
PartialRefresh (p, startrow, endrow, startcol, endcol);
ComputeCollisions (p); p := p^.previous;
UNTIL p = NIL;
END (*IF*);
IF page = ActivePage THEN
UpdatePhysicalCursor;
END (*IF*);
Release (StackAccess2);
END Repaint;
(************************************************************************)
PROCEDURE RefreshDisplay;
(* Rewrites every open window. Should not normally be needed, but *)
(* available for use in cases the display is corrupted by, for *)
(* example, software which bypasses this module and writes directly *)
(* to the screen. *)
(* The caller must be executing at level <1. *)
VAR p: DisplayPage;
BEGIN
FOR p := 0 TO MAX(DisplayPage) DO
Repaint (p, 0, MAX(RowRange), 0, MAX(ColumnRange));
END (*FOR*);
END RefreshDisplay;
(************************************************************************)
PROCEDURE Hide (w: Window);
(* Makes this window invisible on the screen. It is still possible *)
(* to write to the window, but the output will not appear until *)
(* a PutOnTop(w) is executed. *)
(* The caller must be executing at level <0.5. *)
BEGIN
Wait (w^.access0p5);
Obtain (StackAccess2);
w^.hidden := TRUE;
UnLink (w);
Release (StackAccess2);
Signal (w^.access0p5);
(* Repaint the part of the screen which this window occupied. *)
WITH w^ DO
Repaint (page, FirstRow, LastRow, FirstColumn, LastColumn);
END (*WITH*);
END Hide;
(************************************************************************)
PROCEDURE PutOnPage (w: Window; p: DisplayPage);
(* Moves window w to another display page. The default is to put *)
(* every window on page 0 when it is first opened. To override *)
(* the default, call this procedure after opening the window. *)
VAR wasvisible: BOOLEAN;
BEGIN
wasvisible := NOT w^.hidden;
Hide (w);
WITH w^ DO
(* Change the page. *)
ScreenPosition := ScreenPosition + PageSize*(p - page);
page := p;
BufferBias := PageSize*page;
IF wasvisible THEN
hidden := FALSE; PutOnTop (w);
END(*IF*);
END (*WITH*);
END PutOnPage;
(************************************************************************)
(* SETTING THE SCROLLING REGION *)
(************************************************************************)
PROCEDURE InScrollingRegion (w: Window): BOOLEAN;
(* Returns TRUE iff the current cursor position of window w is *)
(* inside its scrolling region. *)
BEGIN
WITH w^ DO
WITH ScrollRegion DO
RETURN (row >= top) AND (row <= bottom)
AND (column >= left) AND (column <= right);
END (*WITH*);
END (*WITH*);
END InScrollingRegion;
(************************************************************************)
PROCEDURE ChangeScrollingRegion (w: Window; firstline, lastline: RowRange);
(* Changes the scrolling region of window w to the new line *)
(* boundaries given, and sets its cursor to the start of the new *)
(* scrolling region. The line numbers are window-relative. *)
VAR horizontal, vertical, leftT, rightT: CHAR;
j: ColumnRange; place: buffersubscript;
BEGIN
(* Although the user specifies window-relative line numbers, *)
(* we use screen-relative numbers internally. Adjust the *)
(* parameters to take this into account. *)
INC (firstline, w^.FirstRow);
INC (lastline, w^.FirstRow);
(* Work out what characters to use for the frame and divider. *)
horizontal := '─'; vertical := '│';
leftT := '├'; rightT := '┤';
WITH w^ DO
IF divider = doubledivider THEN
horizontal := '═';
END (*IF*);
IF frame = doubleframe THEN
vertical := '║';
IF divider = doubledivider THEN
leftT := '╠'; rightT := '╣';
ELSE
leftT := '╟'; rightT := '╢';
END (*IF*);
ELSIF divider = doubledivider THEN
leftT := '╞'; rightT := '╡';
END (*IF*);
(* Clean up the frame. *)
ScrollRegion := DefaultScrollRegion;
IF frame <> noframe THEN
(* Remove the left and right T belonging to the *)
(* old divider bars, if necessary. *)
IF ScrollRegion.top - 1 > FirstRow THEN
place := BytesPerRow*(ScrollRegion.top - 1)
+ BytesPerChar*FirstColumn;
buffer[place] := vertical;
buffer[place + BytesPerChar*(LastColumn - FirstColumn)]
:= vertical;
END (*IF*);
IF ScrollRegion.bottom + 1 < LastRow THEN
place := BytesPerRow*(ScrollRegion.bottom+1)
+ BytesPerChar*FirstColumn;
buffer[place] := vertical;
buffer[place + BytesPerChar*(LastColumn - FirstColumn)]
:= vertical;
END (*IF*);
END (*IF*);
(* Put in the new divider bars. *)
IF divider <> nodivider THEN
(* Put in the top horizontal bar. *)
IF firstline > FirstRow + 1 THEN
place := BytesPerRow*(firstline-1)
+ BytesPerChar*FirstColumn;
IF frame <> noframe THEN
buffer[place] := leftT; INC (place, BytesPerChar);
END (*IF*);
FOR j := ScrollRegion.left TO ScrollRegion.right DO
buffer[place] := horizontal; INC(place, BytesPerChar);
END (*FOR*);
IF frame <> noframe THEN
buffer[place] := rightT;
END (*IF*);
END (*IF*);
(* Put in the bottom horizontal bar. *)
IF lastline < LastRow - 1 THEN
place := BytesPerRow*(lastline+1)
+ BytesPerChar*FirstColumn;
IF frame <> noframe THEN
buffer[place] := leftT; INC (place, BytesPerChar);
END (*IF*);
FOR j := ScrollRegion.left TO ScrollRegion.right DO
buffer[place] := horizontal; INC(place, BytesPerChar);
END (*FOR*);
IF frame <> noframe THEN
buffer[place] := rightT;
END (*IF*);
END (*IF*);
END (*IF*);
(* Finally, update the scrolling region parameters. *)
WITH ScrollRegion DO
top := firstline; bottom := lastline;
END (*WITH*);
DefaultScrollRegion := ScrollRegion;
SetCursor (w, firstline - FirstRow,
ScrollRegion.left - FirstColumn);
Obtain (StackAccess2);
IF NOT (hidden OR obscured) THEN
Refresh (w);
END (*IF*);
Release (StackAccess2);
END (*WITH*);
END ChangeScrollingRegion;
(************************************************************************)
PROCEDURE NewScrollingRegion (w: Window; firstline, lastline: RowRange;
firstcolumn, lastcolumn: ColumnRange);
(* Changes the scrolling region of w to be the specified rectangle, *)
(* but unlike ChangeScrollingRegion this procedure does not redraw *)
(* the dividers. Furthermore the old scrolling region set by *)
(* ChangeScrollingRegion is remembered and may be restored by a *)
(* call to ResetScrollingRegion. *)
BEGIN
WITH w^ DO
WITH ScrollRegion DO
top := FirstRow+firstline; bottom := FirstRow+lastline;
left := FirstColumn+firstcolumn;
right := FirstColumn+lastcolumn;
END (*WITH*);
END (*WITH*);
END NewScrollingRegion;
(************************************************************************)
PROCEDURE ResetScrollingRegion (w: Window);
(* Changes the scrolling region of w back to what it was the last *)
(* time ChangeScrollingRegion was called. If ChangeScrollingRegion *)
(* was never called, the scrolling region goes back to being the *)
(* entire window minus the frame (if any). *)
BEGIN
w^.ScrollRegion := w^.DefaultScrollRegion;
END ResetScrollingRegion;
(************************************************************************)
(* OPENING A WINDOW *)
(************************************************************************)
PROCEDURE FillInFrame (w: Window);
(* Puts the box around the window into the window buffer. *)
VAR i: RowRange; j: ColumnRange;
corner: ARRAY [1..4] OF CHAR;
horizontal, vertical: CHAR;
place, offset: buffersubscript;
BEGIN
IF w^.frame = simpleframe THEN
corner[1] := '┌'; corner[2] := '┐';
corner[3] := '└'; corner[4] := '┘';
horizontal := '─'; vertical := '│';
ELSE
corner[1] := '╔'; corner[2] := '╗';
corner[3] := '╚'; corner[4] := '╝';
horizontal := '═'; vertical := '║';
END (*IF*);
WITH w^ DO
offset := BytesPerChar*(LastColumn - FirstColumn);
place := BytesPerRow*FirstRow + BytesPerChar*FirstColumn;
buffer[place] := corner[1];
buffer[place+offset] := corner[2];
INC (place, BytesPerRow);
FOR i := FirstRow + 1 TO LastRow - 1 DO
buffer[place] := vertical;
buffer[place+offset] := vertical;
INC (place, BytesPerRow);
END (*FOR*);
buffer[place] := corner[3];
buffer[place+offset] := corner[4];
offset := BytesPerRow*(LastRow - FirstRow);
FOR j := FirstColumn + 1 TO LastColumn - 1 DO
INC (place, BytesPerChar);
buffer[place-offset] := horizontal;
buffer[place] := horizontal;
END (*FOR*);
END (*WITH*);
END FillInFrame;
(************************************************************************)
PROCEDURE MakeMonochrome (VAR (*INOUT*) foreground, background: Colour);
(* Changes the two given colours to a suitable B/W combination. *)
BEGIN
IF (foreground = black) OR (foreground = darkgrey) THEN
background := white
ELSE
IF foreground > white THEN
foreground := intensewhite
ELSE
foreground := white;
END (*IF*);
background := black;
END (*IF*);
END MakeMonochrome;
(************************************************************************)
PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
ForegroundColour, BackgroundColour: Colour;
firstline, lastline: RowRange;
firstcol, lastcol: ColumnRange;
FrameDesired: FrameType;
DividerDesired: DividerType);
(* Creates a new window, and makes it the current window, filled *)
(* initially with space characters. *)
(* The caller must be executing at level <0.5. *)
VAR i: RowRange; j: ColumnRange; k: buffersubscript;
BEGIN
(* Create the new window, and fill in all its fields. *)
NEW (w);
WITH w^ DO
CreateSemaphore (access0p5, 0);
CloseList := NIL;
previous := NIL; next := NIL; blockcursor := FALSE;
page := DefaultPage; hidden := FALSE;
InputWaiting := FALSE; CursorWanted := FALSE;
CreateSemaphore (CharAvailable, 0);
foreground := ForegroundColour; background := BackgroundColour;
IF BlackAndWhite OR ForcedMonochrome THEN
MakeMonochrome (foreground, background);
END (*IF*);
CurrentAttributes := CHR(16*ORD(background) + ORD(foreground));
frame := FrameDesired; divider := DividerDesired;
FirstRow := firstline; LastRow := lastline;
FirstColumn := firstcol; LastColumn := lastcol;
tabstops := DefaultTabs;
IF frame <> noframe THEN
FOR j := MAX(ColumnRange) TO 1 BY -1 DO
tabstops[j] := tabstops[j-1];
END (*FOR*);
tabstops[0] := " ";
END (*IF*);
(* Set the window contents to all space characters. *)
Obtain (BlankRowAccess1);
FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
BlankRow[k] := CurrentAttributes;
END (*FOR*);
FOR i := 0 TO MaxRowNumber DO
Copy (ADR(BlankRow), ADR(buffer[i*BytesPerRow]), BytesPerRow);
END (*FOR*);
Release (BlankRowAccess1);
(* Set up a default scrolling region. *)
WITH ScrollRegion DO
top := FirstRow; bottom := LastRow;
left := FirstColumn; right := LastColumn;
END (*WITH*);
(* Make the frame. *)
IF frame <> noframe THEN
FillInFrame(w);
WITH ScrollRegion DO
INC (top); INC (left); DEC (bottom); DEC (right);
END (*WITH*);
END (*IF*);
DefaultScrollRegion := ScrollRegion;
row := ScrollRegion.top; column := ScrollRegion.left;
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
BufferBias := PageSize*page;
Signal (access0p5);
END (*WITH*);
(* Put the new window on top of the stack of active windows. *)
PutOnTop (w);
END OpenWindow;
(************************************************************************)
PROCEDURE OpenSimpleWindow (VAR (*OUT*) w: Window;
firstline, lastline: RowRange;
firstcol, lastcol: ColumnRange);
(* Identical to OpenWindow, except that you don't get any choice *)
(* about the colours or frame. The window is white-on-black with *)
(* a simple frame and no dividers for the scrolling region. This *)
(* version of OpenWindow is useful for those with monochrome *)
(* displays who don't want to be bothered with importing the types *)
(* Colour, FrameType, and DividerType. *)
BEGIN
OpenWindow (w, white, black, firstline, lastline,
firstcol, lastcol, simpleframe, nodivider);
END OpenSimpleWindow;
(************************************************************************)
(* CHANGING THE POSITION OF A WINDOW *)
(************************************************************************)
PROCEDURE ShiftWindowRel (w: Window; rowchange, columnchange: INTEGER);
(* Moves w on the screen. The second and third arguments may be *)
(* negative. The amount of move may be reduced to prevent a move *)
(* off the edge of the screen. *)
(* The caller must be executing at level <0.5. *)
VAR byteshift: INTEGER; wasvisible: BOOLEAN;
BEGIN
IF (rowchange <> 0) OR (columnchange <> 0) THEN
WITH w^ DO
(* Temporarily remove the window from the stack of windows. *)
wasvisible := NOT hidden; Hide(w);
Wait (access0p5);
(* Clip the shift amount to avoid going off the screen. *)
IF INTEGER(FirstRow)+rowchange < 0 THEN
rowchange := - INTEGER(FirstRow)
ELSIF INTEGER(LastRow)+rowchange > MaxRowNumber THEN
rowchange := MaxRowNumber - LastRow
END (*IF*);
IF INTEGER(FirstColumn)+columnchange < 0 THEN
columnchange := -INTEGER(FirstColumn)
ELSIF INTEGER(LastColumn)+columnchange > MaxColumnNumber THEN
columnchange := MaxColumnNumber - LastColumn
END (*IF*);
byteshift := BytesPerRow*rowchange + BytesPerChar*columnchange;
(* Shift the buffer contents. *)
IF byteshift < 0 THEN
Copy (ADR(buffer[-byteshift]), ADR(buffer[0]),
buffersize+byteshift)
ELSE
CopyUp (Far(ADR(buffer[0])), Far(ADR(buffer[byteshift])),
buffersize-byteshift)
END (*IF*);
(* Adjust the affected window parameters. *)
IF rowchange > 0 THEN
WITH ScrollRegion DO
INC (top, rowchange); INC (bottom, rowchange);
END (*WITH*);
WITH DefaultScrollRegion DO
INC (top, rowchange); INC (bottom, rowchange);
END (*WITH*);
INC (FirstRow, rowchange); INC (LastRow, rowchange);
INC (row, rowchange);
ELSE
rowchange := -rowchange;
WITH ScrollRegion DO
DEC (top, rowchange); DEC (bottom, rowchange);
END (*WITH*);
WITH DefaultScrollRegion DO
DEC (top, rowchange); DEC (bottom, rowchange);
END (*WITH*);
DEC (FirstRow, rowchange); DEC (LastRow, rowchange);
DEC (row, rowchange);
END (*IF*);
IF columnchange > 0 THEN
WITH ScrollRegion DO
INC (left, columnchange); INC (right, columnchange);
END (*WITH*);
WITH DefaultScrollRegion DO
INC (left, columnchange); INC (right, columnchange);
END (*WITH*);
INC (FirstColumn, columnchange);
INC (LastColumn, columnchange);
INC (column, columnchange);
ELSE
columnchange := -columnchange;
WITH ScrollRegion DO
DEC (left, columnchange); DEC (right, columnchange);
END (*WITH*);
WITH DefaultScrollRegion DO
DEC (left, columnchange); DEC (right, columnchange);
END (*WITH*);
DEC (FirstColumn, columnchange);
DEC (LastColumn, columnchange);
DEC (column, columnchange);
END (*IF*);
IF byteshift > 0 THEN
INC (ScreenPosition, byteshift);
ELSE
DEC (ScreenPosition, -byteshift);
END (*IF*);
Signal (access0p5);
(* Put w back onto the stack and onto the screen. *)
IF wasvisible THEN
hidden := FALSE; PutOnTop (w);
END (*IF*);
END (*WITH*);
END (*IF*);
END ShiftWindowRel;
(************************************************************************)
PROCEDURE ShiftWindowAbs (w: Window; top: RowRange; left: ColumnRange);
(* Like ShiftWindowRel, except that we directly specify the target *)
(* position of the top left corner in screen coordinates. *)
BEGIN
ShiftWindowRel (w, VAL(INTEGER,top)-VAL(INTEGER,w^.FirstRow),
VAL(INTEGER,left)-VAL(INTEGER,w^.FirstColumn));
END ShiftWindowAbs;
(************************************************************************)
PROCEDURE WindowLocation (w: Window): Rectangle;
(* Returns the current location of w on the screen. *)
VAR result: Rectangle;
BEGIN
WITH w^ DO
WITH result DO
top := FirstRow; bottom := LastRow;
left := FirstColumn; right := LastColumn;
END (*WITH*);
END (*WITH*);
RETURN result;
END WindowLocation;
(************************************************************************)
(* CLOSING A WINDOW *)
(************************************************************************)
PROCEDURE InstallCloseHandler (w: Window; P: CloseHandlerProc);
(* Sets up P as a procedure to be called when the window is closed. *)
(* It is legal to define multiple handlers for the same window. *)
VAR HLP: CloseHandlerList;
BEGIN
NEW (HLP);
WITH w^ DO
Wait (access0p5);
HLP^.next := CloseList;
HLP^.proc := P;
CloseList := HLP;
Signal (access0p5);
END (*WITH*);
END InstallCloseHandler;
(************************************************************************)
PROCEDURE CloseWindow (w: Window);
(* Reclaims the buffer space used for this window, and removes its *)
(* image on the screen. *)
(* The caller must be executing at level <0.5. *)
VAR p: CloseHandlerList;
BEGIN
Hide (w);
WITH w^ DO
Wait (access0p5);
WHILE CloseList <> NIL DO
p := CloseList^.next;
CloseList^.proc (w, w^.page);
DISPOSE (CloseList);
CloseList := p;
END (*WHILE*);
Signal (access0p5);
DestroySemaphore (access0p5);
END (*WITH*);
DISPOSE (w);
END CloseWindow;
(************************************************************************)
(* OPERATIONS ON CHARACTER ATTRIBUTES *)
(************************************************************************)
PROCEDURE SetColours (w: Window; r: RowRange; c: ColumnRange;
nchar: CARDINAL; fore, back: Colour);
(* Sets a field of nchar characters, starting at (row,col), to *)
(* the specified foreground and background colours. The location *)
(* is given in window-relative coordinates, not absolute screen *)
(* positions. NOTE: This procedure will not wrap around to a new *)
(* row. The caller must be executing at level <3. *)
VAR k, start: buffersubscript; attributes: CHAR;
BEGIN
attributes := CHR(16*ORD(back) + ORD(fore));
WITH w^ DO
start := BytesPerRow*(r+FirstRow)
+ BytesPerChar*(c+FirstColumn) + 1;
FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
buffer[k] := attributes;
END (*FOR*);
IF NOT hidden THEN
Obtain (StackAccess2);
IF obscured THEN PutOnTopI(w)
ELSE
Obtain (ScreenAccess3);
FarCopy (Far(ADR(buffer[start])),
MakePointer(ScreenSeg, start+BufferBias),
BytesPerChar*nchar);
Release (ScreenAccess3);
END (*IF obscured*);
Release (StackAccess2);
END (*IF NOT hidden*);
END (*WITH*);
END SetColours;
(************************************************************************)
PROCEDURE ColourSwap (w: Window; r: RowRange; c: ColumnRange;
nchar: CARDINAL);
(* Switches the foreground and background colours for nchar *)
(* characters, starting at location (r,c). The row and column *)
(* numbers are window-relative, not absolute screen coordinates. *)
(* This is our colour equivalent of the "reverse video" operation. *)
(* NOTE: This procedure will not wrap around to a new row. *)
(* The caller must be executing at level <3. *)
VAR k, start: buffersubscript; oldattribute: CARDINAL;
BEGIN
WITH w^ DO
start := BytesPerRow*(r+FirstRow)
+ BytesPerChar*(c+FirstColumn) + 1;
FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
oldattribute := ORD(buffer[k]);
buffer[k] := CHR (16*(oldattribute MOD 16)
+ (oldattribute DIV 16));
END (*FOR*);
IF NOT hidden THEN
Obtain (StackAccess2);
IF obscured THEN PutOnTopI(w)
ELSE
Obtain (ScreenAccess3);
FarCopy (Far(ADR(buffer[start])),
MakePointer(ScreenSeg, start+BufferBias),
BytesPerChar*nchar);
Release (ScreenAccess3);
END (*IF obscured*);
Release (StackAccess2);
END (*IF NOT hidden*);
END (*WITH*);
END ColourSwap;
(************************************************************************)
PROCEDURE Blink (w: Window; r: RowRange; c: ColumnRange; nchar: CARDINAL);
(* Toggles the blinking status - that is, turns blinking on if it *)
(* was off, and vice versa - for nchar characters, starting at *)
(* relative location (r,c) in window w. *)
(* NOTE: This procedure will not wrap around to a new row. *)
(* The caller must be executing at level <3. *)
VAR k, start: buffersubscript;
BEGIN
WITH w^ DO
start := BytesPerRow*(r+FirstRow)
+ BytesPerChar*(c+FirstColumn) + 1;
FOR k := start TO start+BytesPerChar*(nchar-1) BY BytesPerChar DO
buffer[k] := CHR (IXOR(ORD(buffer[k]), 80H));
END (*FOR*);
IF NOT hidden THEN
Obtain (StackAccess2);
IF obscured THEN PutOnTopI(w)
ELSE
INC (start, PageSize*page);
Obtain (ScreenAccess3);
FarCopy (Far(ADR(buffer[start])),
MakePointer(ScreenSeg, start),
BytesPerChar*nchar);
Release (ScreenAccess3);
END (*IF obscured*);
Release (StackAccess2);
END (*IF NOT hidden*);
END (*WITH*);
END Blink;
(************************************************************************)
(* CURSOR OPERATIONS *)
(************************************************************************)
PROCEDURE SetCursor (w: Window; r: RowRange; c: ColumnRange);
(* Sets the cursor for window w to relative row r, column c. *)
(* The caller must be executing at level <0.5. *)
BEGIN
WITH w^ DO
Wait (access0p5);
row := r + FirstRow; column := c + FirstColumn;
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
Signal (access0p5);
END (*WITH*);
END SetCursor;
(************************************************************************)
PROCEDURE SaveCursor (w: Window; VAR (*OUT*) r, c: CARDINAL);
(* Returns the current cursor position of window w. *)
BEGIN
WITH w^ DO
r := row - FirstRow; c := column - FirstColumn;
END (*WITH*);
END SaveCursor;
(************************************************************************)
PROCEDURE CursorLeft (w: Window);
(* Moves the window cursor one position left. If it falls off the *)
(* left edge of the window, move to the right edge in the same row. *)
BEGIN
WITH w^ DO
IF column = FirstColumn THEN
column := LastColumn;
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
ELSE
DEC (column); DEC (ScreenPosition, BytesPerChar);
END (*IF*);
END (*WITH*);
END CursorLeft;
(************************************************************************)
PROCEDURE CursorRight (w: Window);
(* Moves the window cursor one position right. If it falls off the *)
(* right edge of the window, move to the left edge in the same row. *)
BEGIN
WITH w^ DO
IF column = LastColumn THEN
column := FirstColumn;
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
ELSE
INC (column); INC (ScreenPosition, BytesPerChar);
END (*IF*);
END (*WITH*);
END CursorRight;
(************************************************************************)
PROCEDURE CursorUp (w: Window);
(* Moves the window cursor one position up. If it falls off the *)
(* top edge of the window, it moves to the bottom edge in the same *)
(* column. *)
BEGIN
WITH w^ DO
IF row = FirstRow THEN
row := LastRow;
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
ELSE
DEC (row); DEC (ScreenPosition, BytesPerRow);
END (*IF*);
END (*WITH*);
END CursorUp;
(************************************************************************)
PROCEDURE CursorDown (w: Window);
(* Moves the window cursor one position down. If it falls off the *)
(* bottom edge of the window, it moves to the top edge in the same *)
(* column. *)
BEGIN
WITH w^ DO
IF row = LastRow THEN
row := FirstRow;
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
ELSE
INC (row); INC (ScreenPosition, BytesPerRow);
END (*IF*);
END (*WITH*);
END CursorDown;
(************************************************************************)
PROCEDURE ScrollUpI (w: Window);
(* The version of ScrollUp (see below) for internal use. *)
(* The caller must be executing at level <1. *)
VAR rownum: RowRange; count: CARDINAL;
k: buffersubscript;
srcptr, destptr, pscreen: FarPointer;
BEGIN
WITH w^ DO
WITH ScrollRegion DO
k := BytesPerRow*top + BytesPerChar*left;
count := BytesPerChar*(right-left+1);
destptr := Far(ADR(buffer[k]));
pscreen := MakePointer(ScreenSeg, k+BufferBias);
(* Move the contents of the scrolling region up. *)
FOR rownum := top TO bottom-1 DO
srcptr := FarAddOffset (destptr, BytesPerRow);
FarCopy (srcptr, destptr, count);
IF NOT (obscured OR hidden) THEN
Obtain (ScreenAccess3);
FarCopy (destptr, pscreen, count);
Release (ScreenAccess3);
END (*IF*);
destptr := srcptr;
pscreen := FarAddOffset (pscreen, BytesPerRow);
END (*FOR*);
Obtain (BlankRowAccess1);
(* Fill in the attributes of BlankRow. *)
FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
BlankRow[k] := CurrentAttributes;
END (*FOR*);
(* Blank the bottom line of scrolling region. *)
FarCopy (Far(ADR(BlankRow)), destptr, count);
Release (BlankRowAccess1);
IF NOT (obscured OR hidden) THEN
Obtain (ScreenAccess3);
FarCopy (destptr, pscreen, count);
Release (ScreenAccess3);
END (*IF*);
END (*WITH*);
IF obscured AND NOT hidden THEN
Obtain (StackAccess2);
PutOnTopI(w);
Release (StackAccess2);
END (*IF*);
END (*WITH*);
END ScrollUpI;
(************************************************************************)
PROCEDURE ScrollUp (w: Window);
(* Scrolls window w up by one line, both on the screen and in its *)
(* buffer. The last row is filled with spaces. *)
(* The caller must be executing at level <0.5. *)
VAR k: buffersubscript;
BEGIN
Wait (w^.access0p5);
ScrollUpI (w);
Signal (w^.access0p5);
END ScrollUp;
(************************************************************************)
PROCEDURE ScrollDown (w: Window);
(* Scrolls window w down by one line, both on the screen and in its *)
(* buffer. The first row is filled with spaces. *)
(* The caller must be executing at level <0.5. *)
VAR k: buffersubscript;
BEGIN
WITH w^ DO
Wait (access0p5);
Obtain (BlankRowAccess1);
FOR k := 1 TO BytesPerRow-1 BY BytesPerChar DO
BlankRow[k] := CurrentAttributes;
END (*FOR*);
WITH ScrollRegion DO
k := BytesPerRow * top;
CopyUp (Far(ADR(buffer[k])), Far(ADR(buffer[k+BytesPerRow])),
BytesPerRow*(bottom-top));
Copy (ADR(BlankRow), ADR(buffer[k+BytesPerChar*left]),
BytesPerChar*(right-left+1));
END (*WITH*);
Release (BlankRowAccess1);
IF NOT hidden THEN
Obtain (StackAccess2);
IF obscured THEN PutOnTopI(w) ELSE Refresh (w);
END (*IF*);
Release (StackAccess2);
END (*IF*);
Signal (access0p5);
END (*WITH*);
END ScrollDown;
(************************************************************************)
(* MAIN OUTPUT ROUTINES *)
(************************************************************************)
PROCEDURE WriteLnI (w: Window);
(* The internal version of WriteLn (see below). *)
(* The caller must be executing at level <1. *)
BEGIN
WITH w^ DO
IF InScrollingRegion (w) THEN
column := ScrollRegion.left;
IF row = ScrollRegion.bottom THEN ScrollUpI (w)
ELSE INC (row);
END (*IF*);
ELSE
column := DefaultScrollRegion.left;
IF row >= LastRow THEN row := LastRow
ELSE INC (row);
END (*IF*);
END (*IF*);
ScreenPosition := PageSize*page + BytesPerRow*row
+ BytesPerChar*column;
END (*WITH*);
END WriteLnI;
(************************************************************************)
PROCEDURE WriteLn (w: Window);
(* Moves the cursor of window w to the start of the next row. If *)
(* we are already at the last row, the window scrolls up. *)
BEGIN
Wait (w^.access0p5);
WriteLnI (w);
Signal (w^.access0p5);
END WriteLn;
(************************************************************************)
PROCEDURE WriteChar (w: Window; ch: CHAR);
(* Writes one character to window w, and updates the cursor for *)
(* this window. As a side-effect, this window becomes the *)
(* currently active window if it was obscured. Wraps around to the *)
(* next line if we are about to run off the end of the current *)
(* line. This procedure does not recognise the concept of a *)
(* control character. Every possible value of ch produces *)
(* something readable on the screen. *)
(* The caller must be executing at level <0.5. *)
VAR place: CARDINAL; screenloc: FarCharPointer;
BEGIN
WITH w^ DO
Wait (access0p5);
(* Wrap to a new line if we about to leave the scrolling *)
(* region or if we are outside the legal writing region. *)
IF (column = ScrollRegion.right + 1)
OR (column > DefaultScrollRegion.right) THEN
DEC (column); WriteLnI (w);
END (*IF*);
place := ScreenPosition - BufferBias;
buffer[place] := ch;
buffer[place+1] := CurrentAttributes;
IF NOT hidden THEN
Obtain (StackAccess2);
IF obscured THEN PutOnTopI(w) END (*IF*);
Obtain (ScreenAccess3);
screenloc := MakePointer (ScreenSeg, ScreenPosition);
screenloc^ := ch;
screenloc := MakePointer (ScreenSeg, ScreenPosition+1);
screenloc^ := CurrentAttributes;
Release (ScreenAccess3);
Release (StackAccess2);
END (*IF NOT hidden*);
(* Note that the following statement may cause column to *)
(* go beyond the edge of the window; but this will be *)
(* picked up on the next call to WriteChar. We prefer not *)
(* to do a WriteLn just yet, because that could cause an *)
(* unintended scroll operation when writing to the bottom *)
(* right of the window. *)
INC (column); INC (ScreenPosition, BytesPerChar);
Signal (access0p5);
END (*WITH*);
END WriteChar;
(************************************************************************)
PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
(* Writes a sequence of characters, terminated either by NUL or by *)
(* the end of the array. *)
VAR j: CARDINAL;
BEGIN
j := 0;
LOOP
IF ORD (text[j]) = 0 THEN EXIT (*LOOP*) END (*IF*);
WriteChar (w, text[j]); INC (j);
IF j > HIGH (text) THEN EXIT (*LOOP*) END (*IF*);
END (*LOOP*);
END WriteString;
(************************************************************************)
PROCEDURE Write (w: Window; ch: CHAR);
(* A version of procedure WriteChar which looks after some of the *)
(* control characters. *)
BEGIN
IF ch >= " " THEN WriteChar (w, ch)
ELSIF ORD(ch) = 8 THEN (* backspace *)
CursorLeft(w)
ELSIF ORD(ch) = 9 THEN (* tab *)
WITH w^ DO
REPEAT
WriteChar (w, " ");
UNTIL (column=MAX(ColumnRange)) OR (tabstops[column]="T");
END (*WITH*);
ELSIF ORD(ch) = 10 THEN (* line feed - ignore *)
ELSIF ORD(ch) = 13 THEN (* carriage return *)
WriteLn(w)
ELSE (* other control character *)
WriteChar (w, "^"); WriteChar (w, CHR(ORD(ch)+64))
END (*IF*);
END Write;
(************************************************************************)
(* INPUT *)
(************************************************************************)
PROCEDURE ReadBack (w: Window; r: RowRange; c: ColumnRange): CHAR;
(* Returns the character which currently occupies relative location *)
(* (r,c) on the display of window w. *)
BEGIN
WITH w^ DO
RETURN buffer[BytesPerRow*(r+FirstRow)
+ BytesPerChar*(c+FirstColumn)];
END (*WITH*);
END ReadBack;
(************************************************************************)
PROCEDURE KeyTask;
(* Runs as a separate task, getting a character from the keyboard *)
(* as needed and making it available to the task which has input *)
(* focus. If no task has input focus, the character is returned *)
(* to the keyboard module. *)
VAR ch: CHAR; w: Window;
BEGIN
LOOP
Wait (InputRequest);
ch := InKey();
WITH PhysicalCursor DO
Obtain (access4);
w := CursorWindow[ActivePage];
CursorWindow[ActivePage] := NIL;
CursorVisible[ActivePage] := FALSE;
Release (access4);
END (*WITH*);
IF w = NIL THEN
PutBack(ch);
ELSE
WITH w^ DO
InputChar := ch;
InputWaiting := FALSE;
ComputeCursorWindow (ActivePage);
Signal (CharAvailable);
END (*WITH*);
END (*IF*);
END (*LOOP*);
END KeyTask;
(************************************************************************)
PROCEDURE GetKey (w: Window): CHAR;
(* Read one character, without any prompt to the user (unless the *)
(* caller has already set w^.CursorWanted to TRUE). The reason for *)
(* specifying a window parameter is to ensure that keyboard input *)
(* comes to us only when this window has input focus. *)
BEGIN
w^.InputWaiting := TRUE;
ComputeCursorWindow (w^.page);
Signal (InputRequest);
Wait (w^.CharAvailable);
RETURN w^.InputChar;
END GetKey;
(************************************************************************)
PROCEDURE ReadCharWithoutEcho (w: Window; VAR (*OUT*) ch: CHAR);
(* Read one character, with a blinking cursor in window w as a *)
(* prompt. *)
BEGIN
w^.CursorWanted := TRUE;
ch := GetKey (w);
w^.CursorWanted := FALSE;
END ReadCharWithoutEcho;
(************************************************************************)
PROCEDURE ReadChar (w: Window; VAR (*OUT*) ch: CHAR);
(* Like ReadCharWithoutEcho, but the input character is echoed. *)
BEGIN
ReadCharWithoutEcho (w, ch); Write (w, ch);
END ReadChar;
(************************************************************************)
PROCEDURE LookaheadChar (w: Window): CHAR;
(* Reads a character without consuming it. That is, the character *)
(* remains available to be read by ReadChar. This allows the *)
(* caller to check whether the character is really wanted. *)
VAR ch: CHAR;
BEGIN
ch := GetKey(w); PutBack (ch);
RETURN ch;
END LookaheadChar;
(************************************************************************)
PROCEDURE PressAnyKey (w: Window);
(* Types a "Press any key to continue" message. *)
VAR dummy: CHAR;
BEGIN
WriteLn (w);
WriteString (w, "Press any key to continue.");
ReadChar (w, dummy);
IF ORD(dummy) = 0 THEN ReadChar (w, dummy) END (*IF*);
EraseLine (w, 0); CursorUp(w);
END PressAnyKey;
(************************************************************************)
PROCEDURE ReadString (w: Window; VAR (*OUT*) result: ARRAY OF CHAR);
(* Reads a character string, terminated by carriage return. *)
VAR j: CARDINAL; ch: CHAR;
BEGIN
FOR j := 0 TO HIGH(result) DO
result[j] := " ";
END (*FOR*);
j := 0;
LOOP
ReadChar (w, ch);
IF ORD(ch) = 13 THEN
result[j] := CHR(0); EXIT(*LOOP*)
ELSIF ORD(ch) = 8 THEN (* backspace *)
IF j > 0 THEN
CursorLeft(w); WriteChar(w, " "); CursorLeft(w);
DEC (j);
END (*IF*);
ELSE
result[j] := ch;
IF j = HIGH(result) THEN EXIT(*LOOP*) END(*IF*);
INC (j);
END(*IF*);
END (*LOOP*);
END ReadString;
(************************************************************************)
PROCEDURE EditString (w: Window; VAR (*INOUT*) result: ARRAY OF CHAR;
fieldsize: CARDINAL);
(* Reads a character string, where a default result is supplied by *)
(* the caller. The final result is the state of the string at the *)
(* time where the keyboard user types a carriage return or Esc, or *)
(* uses a cursor movement key to move out of the displayed field. *)
(* The terminating character remains available, via Keyboard.InKey, *)
(* to the caller. At most fieldsize characters of the string can *)
(* be edited, and perhaps fewer if the result array is smaller or *)
(* if there is insufficient space in the window. *)
CONST Esc = CHR(01BH); Space = " ";
VAR place, k: CARDINAL; ch: CHAR; limit: ColumnRange;
SavedAttributes: CHAR;
startrow, startcolumn: CARDINAL;
InsertMode, SavedCursorType: BOOLEAN;
(********************************************************************)
PROCEDURE RewriteString ();
BEGIN
SetCursor (w, startrow, startcolumn);
WriteString (w, result);
SetCursor (w, startrow, startcolumn+place);
END RewriteString;
(********************************************************************)
PROCEDURE GoToEnd;
(* Puts the cursor just after the last non-blank character. *)
BEGIN
place := limit+1;
WHILE (place > 0) AND (result[place-1] = Space) DO
DEC (place);
END (*WHILE*);
SetCursor (w, startrow, startcolumn+place);
END GoToEnd;
(********************************************************************)
PROCEDURE HandleControlChar(): BOOLEAN;
(* Called after detecting the CHR(0) which means that a control *)
(* character has been typed. Performs the appropriate actions, *)
(* returns TRUE iff editing is finished. *)
BEGIN
ch := GetKey (w);
IF ch = "K" THEN (* cursor left *)
IF place = 0 THEN
PutBack(ch); PutBack(CHR(0));
RETURN TRUE;
END (*IF*);
CursorLeft(w); DEC (place);
ELSIF ch = "M" THEN (* cursor right *)
IF place > limit THEN
PutBack(ch); PutBack(CHR(0));
RETURN TRUE;
END (*IF*);
CursorRight(w); INC (place);
ELSIF (ch = "H") OR (ch = "P") THEN (* cursor up/down *)
PutBack(ch); PutBack(CHR(0));
RETURN TRUE;
ELSIF ch = "G" THEN (* home *)
place := 0;
SetCursor (w, startrow, startcolumn);
ELSIF ch = "O" THEN (* end *)
GoToEnd;
ELSIF ch = "R" THEN (* insert *)
w^.blockcursor := InsertMode;
InsertMode := NOT InsertMode;
ELSIF ch = "S" THEN (* delete right *)
IF place <= limit THEN
FOR k := place TO limit-1 DO
result[k] := result[k+1];
END (*FOR*);
result[limit] := Space;
RewriteString ();
END (*IF*);
END (*IF*);
RETURN FALSE;
END HandleControlChar;
(********************************************************************)
BEGIN (* Body of EditString *)
SaveCursor (w, startrow, startcolumn);
SavedCursorType := w^.blockcursor;
InsertMode := FALSE; w^.blockcursor := TRUE;
(* Compute a limit which stops us from running off the window. *)
WITH w^ DO
IF InScrollingRegion(w) THEN
limit := ScrollRegion.right;
ELSE
limit := DefaultScrollRegion.right;
END (*IF*);
DEC (limit, FirstColumn + startcolumn);
SavedAttributes := CurrentAttributes;
END (*WITH*);
IF HIGH(result) < limit THEN
limit := HIGH(result);
END (*IF*);
IF fieldsize <= limit THEN
limit := fieldsize - 1;
END (*IF*);
(* Preprocessing: for a Nul-terminated string, remove the Nul *)
(* and pad out the string with spaces at the right. Otherwise *)
(* we get problems if, for example, the Nul is deleted. *)
place := 0;
LOOP
IF result[place] = CHR(0) THEN
FOR k := place TO limit DO
result[k] := Space;
END (*FOR*);
EXIT (*LOOP*);
END (*IF*);
IF place = limit THEN EXIT(*LOOP*) END(*IF*);
INC (place);
END (*LOOP*);
FOR k := limit+1 TO HIGH(result) DO
result[k] := CHR(0);
END (*FOR*);
(* Write the string, using reverse video. *)
WriteString (w, result);
ColourSwap (w, startrow, startcolumn, limit+1);
WITH w^ DO
CurrentAttributes := CHR(16*ORD(foreground) + ORD(background));
END (*WITH*);
place := 0;
SetCursor (w, startrow, startcolumn);
PutOnTop(w);
(* Now the main editing loop. *)
LOOP
ReadCharWithoutEcho (w, ch);
IF ORD(ch) = 0 THEN (* control char *)
IF HandleControlChar() THEN
EXIT (*LOOP*);
END (*IF*);
ELSIF (ch = Esc) OR (ORD(ch) = 13) THEN (* Esc or Return *)
PutBack(ch); EXIT(*LOOP*);
ELSIF ORD(ch) = 8 THEN (* delete left *)
IF place > 0 THEN
DEC (place);
FOR k := place TO limit-1 DO
result[k] := result[k+1];
END (*FOR*);
result[limit] := Space;
RewriteString ();
END (*IF*);
ELSIF place <= limit THEN (* any other char *)
IF InsertMode THEN
FOR k := limit TO place+1 BY -1 DO
result[k] := result[k-1];
END (*FOR*);
RewriteString ();
END (*IF*);
result[place] := ch; WriteChar (w, ch);
INC (place);
END(*IF*);
END (*LOOP*);
ColourSwap (w, startrow, startcolumn, limit+1);
w^.blockcursor := SavedCursorType;
w^.CurrentAttributes := SavedAttributes;
END EditString;
(************************************************************************)
PROCEDURE EditAborted (): BOOLEAN;
(* Checks the next keyboard input. Returns TRUE for Escape, FALSE *)
(* for anything else. Escape or Carriage Return are consumed, any *)
(* other character is returned to the Keyboard module. *)
CONST Esc = CHR(01BH); CR = CHR(0DH);
VAR ch: CHAR;
BEGIN
ch := InKey();
IF ch = Esc THEN RETURN TRUE
ELSIF ch = CR THEN RETURN FALSE
ELSE
PutBack(ch); RETURN FALSE;
END (*IF*);
END EditAborted;
(************************************************************************)
(* MISCELLANEOUS CONTROL OPERATIONS *)
(************************************************************************)
PROCEDURE EraseLine (w: Window; option: CARDINAL);
(* Replaces some or all of the current line, except for the border, *)
(* with space characters. The window cursor is moved to the *)
(* location of the first erased character. The options are: *)
(* 0 the whole of the line, except for the border *)
(* 1 from the current cursor position onwards *)
(* 2 from the start to just before the cursor *)
(* If we are inside a scrolling region, then only that part of the *)
(* line inside the scrolling region is affected. *)
VAR first, last: ColumnRange;
k, firstk, lastk: buffersubscript;
NewPosition: CARDINAL;
BEGIN
WITH w^ DO
IF InScrollingRegion(w) THEN
first := ScrollRegion.left; last := ScrollRegion.right;
ELSE
first := DefaultScrollRegion.left;
last := DefaultScrollRegion.right;
END (*IF*);
IF option = 1 THEN first := column
ELSIF option = 2 THEN last := column - 1
END (*IF*);
IF last >= first THEN
firstk := BytesPerRow*row + BytesPerChar*first;
lastk := BytesPerRow*row + BytesPerChar*last;
FOR k := firstk TO lastk BY BytesPerChar DO
buffer[k] := " "; buffer[k+1] := CurrentAttributes;
END (*FOR*);
Obtain (ScreenAccess3);
NewPosition := BufferBias + firstk;
IF NOT (hidden OR obscured) THEN
FarCopy (Far(ADR(buffer[firstk])),
MakePointer(ScreenSeg,NewPosition), lastk-firstk+2);
END (*IF*);
Release (ScreenAccess3);
column := first; ScreenPosition := NewPosition;
END (*IF*);
END (*WITH*);
END EraseLine;
(************************************************************************)
(* TERMINATION *)
(************************************************************************)
PROCEDURE CloseAllWindows;
(* Shutdown of this module is done in two phases. This procedure *)
(* is phase 2, executed after all interrupt handlers have been *)
(* de-installed. At this stage we can be confident that the only *)
(* possible task switches can be those triggered by an explicit *)
(* kernel call. *)
VAR w: Window; p: DisplayPage;
BEGIN
ReleaseAllLocks;
FOR p := 0 TO MAX(DisplayPage) DO
LOOP
w := TopWindow[p];
IF w = NIL THEN EXIT(*LOOP*) END(*IF*);
(* In phase 1 of the shutdown, we locked w^.access0p5. *)
(* We now want to permanently block any task which is *)
(* still waiting for the access. The easiest way to do *)
(* this is to destroy and re-create the semaphore. *)
DestroySemaphore (w^.access0p5);
CreateSemaphore (w^.access0p5, 1);
CloseWindow (w);
END (*LOOP*);
END (*FOR*);
END CloseAllWindows;
(************************************************************************)
PROCEDURE CleanUp;
(* Phase 1 of module termination. If termination was caused by an *)
(* error, displays the error and waits for the user to press a key. *)
(* In order to ensure that the error message is not obscured, we *)
(* freeze all windows. *)
VAR w: Window; p: DisplayPage;
message: ARRAY [0..57] OF CHAR;
BEGIN
(* Note that we cannot know which task is running the shutdown *)
(* code, or the point it was up to when termination was *)
(* triggered. To avoid potential deadlocks, we must throw *)
(* away any locks we are holding. *)
ReleaseAllLocks;
(* Lock all open windows. *)
FOR p := 0 TO MAX(DisplayPage) DO
Obtain (StackAccess2);
w := TopWindow[p];
Release (StackAccess2);
WHILE w <> NIL DO
Wait (w^.access0p5);
w := w^.next;
END (*WHILE*);
END (*FOR*);
(* For abnormal termination, write the error message, and wait *)
(* until the user has responded with a keystroke. *)
SetActivePage (0);
IF TerminationMessage(message) THEN
OpenSimpleWindow (w, 10, 13, 10, 69);
WriteString (w, message);
PressAnyKey (w);
CloseWindow (w);
END (*IF*);
(* Enable phase 2 of the shutdown. *)
SetTerminationProcedure (CloseAllWindows);
END CleanUp;
(************************************************************************)
(* INITIALISATION *)
(************************************************************************)
VAR j: buffersubscript; p: DisplayPage;
BEGIN
FOR j := 0 TO HIGH(BlankRow) DO
BlankRow[j] := " ";
END (*FOR*);
CreateLock (BlankRowAccess1);
FOR p := 0 TO MAX(DisplayPage) DO
TopWindow[p] := NIL;
PhysicalCursor.CursorWindow[p] := NIL;
PhysicalCursor.CursorVisible[p] := FALSE;
END (*FOR*);
CreateLock (StackAccess2);
VideoKind (ScreenSeg, BlackAndWhite);
CreateLock (ScreenAccess3);
CreateLock (PhysicalCursor.access4);
CreateSemaphore (InputRequest, 0);
CreateTask (KeyTask, 5, "keyboard/windows");
SetTerminationProcedure (CleanUp);
PageChangeProcs := NIL;
CreateLock (PageChangeListAccess);
(* Blank the screen, to erase otherwise annoying background stuff *)
(* left by other programs. *)
SetActivePage (DefaultPage);
Repaint (DefaultPage, 0,MaxRowNumber,0,MaxColumnNumber);
END Windows.