language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/unsorted/miniwind.def
DEFINITION MODULE MiniWindows;
(****************************************************************)
(* *)
(* A simple implementation of screen windows. *)
(* *)
(* This is a special version, using the MiniKernel *)
(* demonstration kernel. It is designed solely for *)
(* demonstrations such as the SemaTest demo. *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 16 August 1992 *)
(* Status: SPECIAL VERSION *)
(* This is a version designed for the *)
(* SemaTest demo under TopSpeed. *)
(* *)
(****************************************************************)
(************************************************************************)
(* *)
(* REMARK: There are two versions of the basic 'write' procedure. *)
(* Procedure WriteChar treats every character as a printable character, *)
(* so it can write any character in the standard character set. This *)
(* is the output procedure recommended for general use. Control *)
(* operations are supplied by separate procedures such as WriteLn, *)
(* SetCursor, etc., so there is no need to resort to the BASIC *)
(* programmers' trick of writing long strings of obscure control codes. *)
(* But for people who can't break this bad habit, procedure Write is *)
(* supplied; this treats character codes 0..31 as control codes. *)
(* *)
(* Warning: I have not bothered to look after all the control codes, *)
(* just the ones I found a use for. Most of them print as a *)
(* two-character sequence ^<letter>. *)
(* *)
(************************************************************************)
(************************************************************************)
(* *)
(* NOTE ON CRITICAL SECTIONS: When using this module in a multitasking *)
(* environment, there are numerous critical sections because several *)
(* tasks may be using the same physical screen. These sections are *)
(* protected by semaphores. (For the case where we are not using the *)
(* multitasking kernel, there is a version of module Semaphores which *)
(* contains dummy procedures). The general philosophy is to assume *)
(* that critical section protection is needed for inter-window *)
(* conflicts, but that no protection is needed for operations on a *)
(* single window because the most common situation is that each window *)
(* is used by only one task. If there happen to be windows which are *)
(* shared by two or more tasks, the associated synchronization problems *)
(* must be resolved by the caller; they are not resolved in module *)
(* Windows, on the grounds that the extra overhead is not justified *)
(* just to support a case which rarely happens in practice. *)
(* *)
(************************************************************************)
CONST
MaxRowNumber = 24;
MaxColumnNumber = 79;
TYPE
Window; (* is private *)
Colour = (black, blue, green, cyan, red, magenta, brown, white,
darkgrey, lightblue, lightgreen, lightcyan, lightred,
lightmagenta, yellow, intensewhite);
(* Note: Any of these colours may be used as a foreground colour, *)
(* but in most applications only [black..white] are suitable as *)
(* background colours. The others may be used, but they can give *)
(* strange effects such as a blinking display. Use with care! *)
RowRange = [0..MaxRowNumber];
ColumnRange = [0..MaxColumnNumber];
FrameType = (noframe, simpleframe, doubleframe);
DividerType = (nodivider, simpledivider, doubledivider);
PROCEDURE OpenWindow (VAR (*OUT*) w: Window;
ForegroundColour, BackgroundColour: Colour;
firstline, lastline: RowRange;
firstcol, lastcol: ColumnRange;
FrameDesired: FrameType;
DividerDesired: DividerType);
(* Create a new window. Note that row and column numbers start *)
(* from 0. NOTE: If the window has a box drawn around it (the case *)
(* FrameDesired <> noframe), this subtracts from the space *)
(* available for text. *)
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. *)
PROCEDURE ChangeScrollingRegion (w: Window; firstline, lastline: RowRange);
(* Changes the scrolling region of window w to the new line *)
(* boundaries given, and sets the cursor of this window to the *)
(* start of the scrolling region. Row numbers are window-relative; *)
(* that is, line 0 is the top line of the window (which is where *)
(* the border is, unless you have no border). *)
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. *)
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). *)
PROCEDURE ShiftWindow (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. *)
PROCEDURE CloseWindow (VAR (*INOUT*) w: Window);
(* Destroys the window. *)
PROCEDURE PutOnTop (w: Window);
(* Makes sure that window w is fully visible on the screen. Rarely *)
(* needed, since many window operations automatically put the *)
(* window being used on top. *)
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. *)
PROCEDURE SetCursor (w: Window; row: RowRange; column: ColumnRange);
(* Sets the cursor for window w to the given row and column. The *)
(* coordinates are window-relative; that is, they start at (0,0) at *)
(* the top left of the window. *)
PROCEDURE SaveCursor (w: Window; VAR (*OUT*) row, column: CARDINAL);
(* Returns the current cursor position. The coordinates are *)
(* window-relative; that is, they start at (0,0) at the top left of *)
(* the window. *)
PROCEDURE CursorLeft (w: Window);
(* Moves the window cursor one position left. If it falls off the *)
(* left edge of the window, it moves to the right edge in the same *)
(* row. *)
PROCEDURE CursorRight (w: Window);
(* Moves the window cursor one position right. If it falls off the *)
(* right edge of the window, it moves to the left edge in the same *)
(* row. *)
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. *)
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. *)
PROCEDURE ScrollUp (w: Window);
(* Scrolls the scrolling region of window w up by one row, filling *)
(* the vacated row with spaces. *)
PROCEDURE ScrollDown (w: Window);
(* Scrolls the scrolling region of window w down by one row, *)
(* filling the vacated row with spaces. *)
PROCEDURE WriteLn (w: Window);
(* Go to next line in window, scrolling if necessary. N.B. The *)
(* window does not scroll if you are not in the scrolling region *)
(* at the time of the WriteLn. *)
PROCEDURE WriteChar (w: Window; ch: CHAR);
(* Write one character. Control characters are not given special *)
(* treatment; they produce something visible just like any other *)
(* character. Wraps to the next line before writing if the write *)
(* would put us on or beyond the right border of w. *)
PROCEDURE Write (w: Window; ch: CHAR);
(* Like WriteChar, but codes in the range 0..31 are treated as *)
(* control characters. This procedure is not recommended for *)
(* general use, as it leads to obscure programs. (Instead, do the *)
(* control operations by direct calls to the cursor control *)
(* procedures which are also supplied in this module). It is *)
(* supplied mainly to help those who are used to the conventions of *)
(* the "standard" Modula-2 I/O modules such as InOut. *)
PROCEDURE WriteString (w: Window; text: ARRAY OF CHAR);
(* Write a string of characters, stopping at the first NUL *)
(* character or the end of the array, whichever comes first. *)
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. *)
PROCEDURE ReadChar (w: Window; VAR (*OUT*) ch: CHAR);
(* Read one character, and echo it. *)
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. *)
PROCEDURE ReadCharWithoutEcho (w: Window; VAR (*OUT*) ch: CHAR);
(* Read one character, but don't echo it. However, a blinking *)
(* cursor is still displayed to prompt for the character. (If you *)
(* don't want the blinking cursor, use procedure Keyboard.InKey). *)
PROCEDURE PressAnyKey (w: Window);
(* Types a "Press any key to continue" message. *)
PROCEDURE ReadString (w: Window; VAR (*OUT*) result: ARRAY OF CHAR);
(* Reads a character string, terminated by carriage return. *)
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 uses a *)
(* cursor movement key to move out of the displayed field. If the *)
(* user types Esc at any time, then we return with result[0] = Esc. *)
(* A carriage return or Esc as terminator is not returned to the *)
(* caller, but if the terminator is a cursor control key then it *)
(* it 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. *)
PROCEDURE ColourSwap (w: Window; row: RowRange; col: ColumnRange;
nchar: CARDINAL);
(* Sets a field of nchar characters, starting at (row,col), to *)
(* "reverse video" by swapping the foreground and background *)
(* colours. Notice that the process is reversible: you get back to *)
(* "normal video" by calling this procedure again. The location is *)
(* given in window-relative coordinates, not absolute screen *)
(* positions. NOTE: Do not assume that this procedure can wrap *)
(* around to a new line. It normally cannot. *)
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. *)
PROCEDURE EraseLine (w: Window; option: CARDINAL);
(* Erases some or all of the current line (but never the border). *)
(* The erased characters are replaced by space characters. The *)
(* window cursor is moved to the location of the first erased *)
(* character. If w is not the currently active window, the changes *)
(* will not be visible until w is on top again. 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. *)
END MiniWindows.