language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/menus.mod
IMPLEMENTATION MODULE Menus;
(****************************************************************)
(* *)
(* Displays menus on screen, allows terminal user to *)
(* select from them. *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 21 February 1995 *)
(* Status: OK *)
(* *)
(****************************************************************)
FROM Storage1 IMPORT
(* proc *) ALLOCATE, DEALLOCATE;
FROM TaskControl IMPORT
(* type *) Lock,
(* proc *) CreateLock, Obtain, Release;
FROM Keyboard IMPORT
(* proc *) PutBack, StuffKeyboardBuffer;
FROM Windows IMPORT
(* const*) MaxColumnNumber,
(* type *) Window, FrameType, DividerType,
(* proc *) OpenWindow, CloseWindow, ChangeScrollingRegion,
GetKey, WriteChar, WriteString, SetColours, Blink,
SetCursor, SaveCursor, ScrollUp, ScrollDown, EraseLine,
NewScrollingRegion, ResetScrollingRegion;
FROM TextLines IMPORT
(* type *) LineType,
(* proc *) Box, HLine;
FROM Mouse IMPORT
(* type *) Buttons, ButtonSet,
(* proc *) MouseAvailable, HideMouseCursor, ShowMouseCursor;
FROM UserInterface IMPORT
(* type *) UIWindow, Capability, CapabilitySet,
(* proc *) AllowMouseControl, AddActiveRegion;
(************************************************************************)
CONST
gap = 1; (* space between menu columns *)
ClickIndicator = CHR(1); (* special code to indicate mouse click *)
LeftOnly = ButtonSet{LeftButton};
Esc = CHR(01BH); (* keyboard Escape character *)
NilWindow = Window(NIL);
TYPE
(* An ItemBuffer record holds the text for the screen display of *)
(* one menu item. The "selpos" field shows which character acts *)
(* as the selection character. *)
ItemBuffer = RECORD
selpos: CARDINAL;
text: ItemText;
END (*RECORD*);
CONST
MaxItems = MAX(CARDINAL) DIV SIZE(ItemBuffer);
TYPE
ItemNo = [0..MaxItems];
(* The following declaration uses a large upper subscript bound *)
(* because Modula-2 provides no way of declaring a variable-length *)
(* array (except as a procedure parameter). The correct array size *)
(* will be established on a call to ALLOCATE. *)
TextPointer = POINTER TO ARRAY [1..MaxItems] OF ItemBuffer;
Menu = POINTER TO MenuDetails;
(********************************************************************)
(* *)
(* The fields in a MenuDetails record have the following meaning: *)
(* *)
(* win The window used to display this menu *)
(* on the screen *)
(* foreground, The colours to use when displaying the menu *)
(* background, *)
(* selchar, *)
(* highforeground, *)
(* highbackground *)
(* ScreenPosition The row and column numbers which will be *)
(* occupied by the menu on the screen. This *)
(* includes space for the border and title, if *)
(* present. The space taken by the menu itself, *)
(* not including border and title, is given by *)
(* the LocationInWindow record - see below. *)
(* heading The text to display in the menu header *)
(* NoOfItems Number of menu items *)
(* ItemsPerColumn Number of items allocated to each column *)
(* NoOfColumns Number of columns of menu items *)
(* hstep The increment in item number resulting from *)
(* one "cursor right" operation. *)
(* vstep The increment in item number resulting from *)
(* one "cursor down" operation. Note that hstep *)
(* and vstep depend on whether the items are *)
(* numbered horizontally or vertically, and that *)
(* in turn depends on whether we have a short fat *)
(* display or a tall thin one. *)
(* LocationInWindow: The location of the menu itself, relative to *)
(* the window in which it is displayed, and not *)
(* counting the space taken by borders or a *)
(* header. The top left character is at location *)
(* (firstrow,firstcol), the menu takes 'height' *)
(* screen lines and is 'width' characters wide. *)
(* To fit the text exactly into this space, we *)
(* would need *)
(* NoOfItems = height*NoOfColumns *)
(* If NoOfItems is smaller than this, the menu *)
(* will be displayed with some blank areas. If *)
(* it is larger, the menu scrolls. *)
(* ColumnWidth The number of characters of TextPtr^[j] which *)
(* will be written on the screen. Approximately *)
(* equal to LocationInWindow.width/NoOfColumns. *)
(* ShowTitle Says whether to display a menu title. *)
(* ShowBorder Says whether to put a border around the menu. *)
(* CloseAfterSelection If TRUE, specifies that the menu window *)
(* will be closed on return from SelectFromMenu. *)
(* PutBackExitKey If TRUE, the keystroke that caused a return *)
(* from SelectFromMenu remains available to the *)
(* caller. If FALSE, that key is consumed. *)
(* FastSelect If TRUE, user can select a menu item without *)
(* having to confirm with Enter or Space. *)
(* MouseControl If TRUE, user can move the menu with the mouse. *)
(* offL, offR, What to do when the user tries to run off the *)
(* offT, offB left/right/top/bottom edge of the menu. *)
(* CurrentItemNo The item number currently selected. *)
(* row The current menu row selected. Note that row=1 *)
(* means the top row of items displayed; this is *)
(* not necessarily the top row of the entire menu *)
(* since some items may have scrolled off the top.*)
(* column The current menu column selected. *)
(* ExtraAtTop The number of rows which have disappeared off *)
(* the top of the display. *)
(* ExtraAtBottom The number of rows which have disappeared off *)
(* the bottom of the display. *)
(* RanOffEdge Set if a cursor movement ran us off the edge *)
(* of the menu. *)
(* TextPtr^[j] The text to display for menu item j. *)
(* *)
(********************************************************************)
MenuDetails =
RECORD
(* The screen window. *)
win: Window;
foreground, background, selchar,
highforeground, highbackground: Colour;
ScreenPosition:
RECORD
firstrow, lastrow: RowRange;
firstcol, lastcol: ColumnRange;
END (*RECORD*);
heading: ItemText;
(* The layout of the menu within its window, determined *)
(* at the time that the menu is created. *)
NoOfItems: ItemNo;
ItemsPerColumn: ItemNo;
NoOfColumns: MenuColumn;
(* Further layout details, determined at the time we *)
(* discover how much space the menu will be given on *)
(* the screen. *)
hstep, vstep: CARDINAL;
LocationInWindow:
RECORD
firstrow, firstcol: CARDINAL;
height, width: CARDINAL;
END (*RECORD*);
ColumnWidth: ColumnRange;
(* Options. *)
ShowTitle, ShowBorder, CloseAfterSelection,
PutBackExitKey, FastSelect, MouseControl: BOOLEAN;
offL, offR, offT, offB: OffEdgeOption;
(* Information about the current state of the menu. *)
CurrentItemNo: ItemNo;
row: RowRange;
column: MenuColumn;
ExtraAtTop, ExtraAtBottom: CARDINAL;
RanOffEdge: BOOLEAN;
(* Pointer to the text of the menu items. *)
TextPtr: TextPointer;
END (*RECORD*);
(************************************************************************)
VAR
(* The following record contains the details of the last mouse *)
(* click. Because users can't move a mouse very fast, we don't *)
(* bother to keep a queue of clicks, we just record the last seen. *)
(* In the event that a click arrives before the last has been *)
(* consumed, the earlier click is lost. I haven't yet seen an *)
(* application where that has been a major problem. *)
LastMouseClick: RECORD
access: Lock;
win: Window;
X: ColumnRange; Y: RowRange;
valid: BOOLEAN;
END (*RECORD*);
(************************************************************************)
(* MISCELLANEOUS UTILITIES *)
(************************************************************************)
PROCEDURE Setselpos (VAR (*INOUT*) item: ItemBuffer);
(* Looks for a "\" in the item text, adjusts item.selpos if found. *)
VAR j, k, high: CARDINAL;
BEGIN
j := 0; high := HIGH(item.text);
LOOP
IF (j > high) OR (ORD(item.text[j]) = 0) THEN
EXIT (*LOOP*);
ELSIF item.text[j] = "\" THEN
item.selpos := j;
FOR k := j TO high-1 DO
item.text[k] := item.text[k+1];
END (*FOR*);
item.text[high] := CHR(0);
EXIT (*LOOP*);
ELSE
INC (j);
END (*IF*);
END (*LOOP*);
END Setselpos;
(************************************************************************)
PROCEDURE resize (VAR (*INOUT*) text: ItemText; size: CARDINAL);
(* Makes text equal to the given size, by space filling on the *)
(* right and inserting a Nul to terminate the text. *)
VAR j: CARDINAL;
BEGIN
j := 0;
WHILE (j < size) AND (ORD(text[j]) <> 0) DO
INC(j);
END (*WHILE*);
WHILE j < size DO text[j] := " "; INC(j) END (*WHILE*);
IF j <= MaxColumnNumber THEN text[j] := CHR(0) END (*IF*);
END resize;
(************************************************************************)
(* CREATING A MENU *)
(************************************************************************)
PROCEDURE CreateMenu (VAR (*OUT*) M: Menu; columns: MenuColumn;
VAR (*IN*) Messages: ARRAY OF ItemText;
NumberOfItems: CARDINAL);
(* Introduces a menu into the system, but does not display it yet. *)
VAR j, count: CARDINAL;
BEGIN
NEW (M);
WITH M^ DO
win := NilWindow;
NoOfColumns := columns;
(* Store the header text, with space fill. *)
heading := Messages[0];
resize (heading, MaxColumnNumber);
(* Work out how many menu items there are. *)
count := NumberOfItems;
IF (count = 0) OR (count > HIGH (Messages)) THEN
count := HIGH (Messages);
END (*IF*);
NoOfItems := count;
ItemsPerColumn := (count + NoOfColumns - 1) DIV NoOfColumns;
CurrentItemNo := 1;
(* Store the item text. *)
ALLOCATE (TextPtr, NoOfItems*SIZE(ItemBuffer));
FOR j := 1 TO NoOfItems DO
WITH TextPtr^[j] DO
selpos := 0;
text := Messages[j];
END (*WITH*);
Setselpos (TextPtr^[j]);
END (*FOR*);
(* Set default options. *)
ShowTitle := TRUE; ShowBorder := TRUE;
CloseAfterSelection := TRUE; PutBackExitKey := FALSE;
FastSelect := FALSE; MouseControl := MouseAvailable();
offL := stick; offR := stick; offT := stick; offB := stick;
END (*WITH*);
(* Give the menu a default initial position, size, and colour. *)
PositionMenu (M, 0, 10, 0, MaxColumnNumber);
MenuColours (M, blue, white, black, cyan, red);
END CreateMenu;
(************************************************************************)
PROCEDURE MenuColours (M: Menu; fore, back, hfore, hback, select: Colour);
(* Set the colours for the screen display of the menu. The colours *)
(* fore and back are used as the normal foreground and background *)
(* colours, and the highlighted menu item is displayed in colours *)
(* hfore, hback. The "select" colour is for highlighting the *)
(* selection character. *)
BEGIN
WITH M^ DO
foreground := fore; background := back;
highforeground := hfore; highbackground := hback;
selchar := select;
END (*WITH*);
END MenuColours;
(************************************************************************)
PROCEDURE SetOptions (M: Menu; options: MO);
(* See the MenuOption declaration for the possible options. *)
BEGIN
WITH M^ DO
IF MTitle IN options THEN ShowTitle := TRUE END (*IF*);
IF MNoTitle IN options THEN ShowTitle := FALSE END (*IF*);
IF MBorder IN options THEN ShowBorder := TRUE END (*IF*);
IF MNoBorder IN options THEN ShowBorder := FALSE END (*IF*);
IF MClose IN options THEN CloseAfterSelection := TRUE END (*IF*);
IF MNoClose IN options THEN CloseAfterSelection := FALSE END (*IF*);
IF MKeyBack IN options THEN PutBackExitKey := TRUE END (*IF*);
IF MNoKeyBack IN options THEN PutBackExitKey := FALSE END (*IF*);
IF MFastSelect IN options THEN FastSelect := TRUE END (*IF*);
IF MNoFastSelect IN options THEN FastSelect := FALSE END (*IF*);
IF MMouse IN options THEN MouseControl := MouseAvailable() END (*IF*);
IF MNoMouse IN options THEN MouseControl := FALSE END (*IF*);
END (*WITH*);
END SetOptions;
(************************************************************************)
PROCEDURE OffEdge (M: Menu; top, bottom, left, right: OffEdgeOption);
(* Sets the menu behaviour when the user runs the cursor off the *)
(* edge of the menu. There is one parameter for each edge of the *)
(* menu. *)
(* See the OffEdgeOption type declaration for the possible options. *)
BEGIN
WITH M^ DO
offT := top; offB := bottom;
offL := left; offR := right;
END (*WITH*);
END OffEdge;
(************************************************************************)
(* POSITIONING A MENU *)
(************************************************************************)
PROCEDURE SetRelativeLocation (M: Menu; row1, col1, rows, columns: CARDINAL);
(* Gives initial values to M^.LocationInWindow and M^.ColumnWidth, *)
(* and resizes the item text to the space available. Also sets *)
(* M^.hstep and M^.vstep, based on the following criterion: if the *)
(* display will be wider than it is tall then we use row major *)
(* ordering (hstep = 1), whereas for tall narrow menus we use *)
(* column major ordering (vstep = 1). This distinction is actually *)
(* irrelevant to the caller, but it affects the appearance of the *)
(* menu, and the decision taken here seems to give a result which *)
(* someone reading the screen would consider intuitively logical. *)
VAR j: ItemNo;
BEGIN
WITH M^ DO
WITH LocationInWindow DO
firstrow := row1; firstcol := col1;
height := rows; width := columns;
IF ItemsPerColumn <= height THEN
height := ItemsPerColumn;
END (*IF*);
IF NoOfColumns > height THEN
hstep := 1; vstep := NoOfColumns;
ELSE
hstep := ItemsPerColumn; vstep := 1;
END (*IF*);
END (*WITH*);
resize (heading, columns);
ColumnWidth := (columns - (NoOfColumns-1)*gap) DIV NoOfColumns;
FOR j := 1 TO NoOfItems DO
resize (TextPtr^[j].text, ColumnWidth);
END (*FOR*);
END (*WITH*);
END SetRelativeLocation;
(************************************************************************)
PROCEDURE PositionMenu (M: Menu; startline, endline: RowRange;
leftcol, rightcol: ColumnRange);
(* Sets the screen location of the window which will hold the menu. *)
VAR row1, col1, height, width: CARDINAL;
BEGIN
WITH M^ DO
(* Work out the space available on the screen. *)
WITH ScreenPosition DO
firstrow := startline; lastrow := endline;
firstcol := leftcol; lastcol := rightcol;
END (*WITH*);
(* How much of this space is used for the actual menu? *)
row1 := 0; col1 := 0;
height := endline - startline + 1;
width := rightcol - leftcol + 1;
IF ShowBorder THEN
INC (row1); INC(col1);
DEC (height, 2); DEC (width, 2);
END(*IF*);
IF ShowTitle THEN
INC (row1,2); DEC (height, 2);
END(*IF*);
SetRelativeLocation (M, row1, col1, height, width);
END (*WITH*);
END PositionMenu;
(************************************************************************)
(* CLOSING A MENU *)
(************************************************************************)
PROCEDURE DestroyMenu (M: Menu);
(* Removes a menu from the system, freeing up the space it used. *)
BEGIN
WITH M^ DO
IF (win <> NilWindow) AND CloseAfterSelection THEN
CloseWindow (win);
END (*IF*);
DEALLOCATE (TextPtr, NoOfItems*SIZE(ItemBuffer));
END (*WITH*);
DISPOSE (M);
END DestroyMenu;
(************************************************************************)
(* SCREEN DISPLAY *)
(************************************************************************)
PROCEDURE NewColours (M: Menu; fore, back, select: Colour);
(* Changes the foreground and background colours of the current *)
(* menu item. The "select" colour is for highlighting the *)
(* selection character. *)
BEGIN
IF MouseAvailable() THEN HideMouseCursor END (*IF*);
WITH M^ DO
SetColours (win, LocationInWindow.firstrow+row-1,
(column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol,
ColumnWidth, fore, back);
IF CurrentItemNo <= NoOfItems THEN
SetColours (win, LocationInWindow.firstrow+row-1,
(column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol
+ TextPtr^[CurrentItemNo].selpos,
1, select, back);
END (*IF*);
END (*WITH*);
IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
END NewColours;
(************************************************************************)
PROCEDURE Highlight (M: Menu);
(* Highlights the current menu item. *)
BEGIN
NewColours (M, M^.highforeground, M^.highbackground, M^.selchar);
END Highlight;
(************************************************************************)
PROCEDURE Unhighlight (M: Menu);
(* Removes any highlighting from the current menu item. *)
BEGIN
NewColours (M, M^.foreground, M^.background, M^.selchar);
END Unhighlight;
(************************************************************************)
PROCEDURE RefreshRow (M: Menu);
(* Refreshes the current menu row. *)
VAR screenrow: RowRange; j: ColumnRange; savecurrent: ItemNo;
savecolumn: CARDINAL;
BEGIN
WITH M^ DO
savecurrent := CurrentItemNo; savecolumn := column;
WITH LocationInWindow DO
screenrow := firstrow + row - 1;
j := LocationInWindow.firstcol;
END (*WITH*);
SetCursor (win, screenrow, j); EraseLine (win, 1);
column := 1;
CurrentItemNo := 1 + vstep*(row + ExtraAtTop - 1);
LOOP
WriteString (win, TextPtr^[CurrentItemNo].text);
Unhighlight (M);
IF (column = NoOfColumns)
OR (CurrentItemNo+hstep > NoOfItems) THEN
EXIT (*LOOP*);
END (*IF*);
INC (column);
INC (CurrentItemNo, hstep); INC (j, ColumnWidth + gap);
SetCursor (win, screenrow, j);
END (*LOOP*);
column := savecolumn; CurrentItemNo := savecurrent;
END (*WITH*);
END RefreshRow;
(************************************************************************)
PROCEDURE DisplayMOREatTop (M: Menu);
BEGIN
WITH M^ DO
IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
WITH LocationInWindow DO
SetCursor (win, firstrow-1, firstcol+width-6);
END (*WITH*);
WriteString (win, "*MORE*");
END (*IF*);
END (*WITH*);
END DisplayMOREatTop;
(************************************************************************)
PROCEDURE RemoveMOREatTop (M: Menu);
CONST DoubleBar = '═'; SingleBar = '─';
VAR j: [1..6]; bar: CHAR;
BEGIN
WITH M^ DO
IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
WITH LocationInWindow DO
SetCursor (win, firstrow-1, firstcol+width-6);
END (*WITH*);
IF ShowTitle THEN bar := DoubleBar
ELSE bar := SingleBar
END (*IF*);
FOR j := 1 TO 6 DO
WriteChar (win, bar);
END (*FOR*);
END (*IF*);
END (*WITH*);
END RemoveMOREatTop;
(************************************************************************)
PROCEDURE DisplayMOREatBottom (M: Menu);
BEGIN
WITH M^ DO
IF ShowBorder THEN
WITH LocationInWindow DO
SetCursor (win, firstrow+height, firstcol+width-6);
END (*WITH*);
WriteString (win, "*MORE*");
END (*IF*);
END (*WITH*);
END DisplayMOREatBottom;
(************************************************************************)
PROCEDURE RemoveMOREatBottom (M: Menu);
CONST HorizontalBar = '─';
VAR j: [1..6];
BEGIN
WITH M^ DO
IF ShowBorder THEN
WITH LocationInWindow DO
SetCursor (win, firstrow+height, firstcol+width-6);
END (*WITH*);
FOR j := 1 TO 6 DO
WriteChar (win, HorizontalBar);
END (*FOR*);
END (*IF*);
END (*WITH*);
END RemoveMOREatBottom;
(************************************************************************)
PROCEDURE BlinkCurrent (M: Menu);
(* Toggles the blinking state of the current menu item. *)
BEGIN
WITH M^ DO
Blink (win, LocationInWindow.firstrow+row-1,
(column-1)*(ColumnWidth+gap) + LocationInWindow.firstcol,
ColumnWidth);
END (*WITH*);
END BlinkCurrent;
(************************************************************************)
(* CURSOR MOVEMENTS *)
(************************************************************************)
PROCEDURE DownARow (M: Menu); FORWARD;
(************************************************************************)
PROCEDURE UpARow (M: Menu);
(* Moves to the next item up, if present. Scrolls if necessary. *)
BEGIN
WITH M^ DO
IF row > 1 THEN
DEC (row); DEC (CurrentItemNo, vstep);
ELSIF ExtraAtTop > 0 THEN
DEC (CurrentItemNo, vstep);
ScrollDown (win);
DEC (ExtraAtTop); INC (ExtraAtBottom);
RefreshRow (M);
IF MouseAvailable() THEN HideMouseCursor END (*IF*);
IF ExtraAtTop = 0 THEN RemoveMOREatTop(M) END (*IF*);
IF ExtraAtBottom = 1 THEN DisplayMOREatBottom(M) END(*IF*);
IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
ELSE
CASE offT OF
| stick: (* no action needed*) ;
| wrap: WHILE (row < LocationInWindow.height)
OR (ExtraAtBottom > 0) DO
DownARow(M);
END (*WHILE*);
| escape: CurrentItemNo := 0; RanOffEdge := TRUE;
| return: RanOffEdge := TRUE;
END (*CASE*);
END (*IF*);
END (*WITH*);
END UpARow;
(************************************************************************)
PROCEDURE DownARow (M: Menu);
(* Moves to the next item down, if present. Scrolls if necessary. *)
BEGIN
WITH M^ DO
IF row < LocationInWindow.height THEN
INC (row); INC (CurrentItemNo, vstep);
ELSIF ExtraAtBottom > 0 THEN
INC (CurrentItemNo, vstep); ScrollUp (win);
INC (ExtraAtTop); DEC (ExtraAtBottom);
RefreshRow (M);
IF MouseAvailable() THEN HideMouseCursor END (*IF*);
IF ExtraAtTop = 1 THEN DisplayMOREatTop(M) END (*IF*);
IF ExtraAtBottom = 0 THEN RemoveMOREatBottom(M) END (*IF*);
IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
ELSE
CASE offB OF
| stick: (* no action needed*) ;
| wrap: WHILE (row > 1) OR (ExtraAtTop > 0) DO
UpARow (M);
END (*WHILE*);
| escape: CurrentItemNo := 0; RanOffEdge := TRUE;
| return: RanOffEdge := TRUE;
END (*CASE*);
END (*IF*);
END (*WITH*);
END DownARow;
(************************************************************************)
PROCEDURE MoveRight (M: Menu);
(* Moves to the next item right, if present. *)
BEGIN
WITH M^ DO
IF column < NoOfColumns THEN
INC (column); INC (CurrentItemNo, hstep);
ELSE
CASE offR OF
| stick: (* no action needed*) ;
| wrap: DEC (CurrentItemNo, hstep*(column-1));
column := 1;
| escape: CurrentItemNo := 0; RanOffEdge := TRUE;
| return: RanOffEdge := TRUE;
END (*CASE*);
END (*IF*);
END (*WITH*);
END MoveRight;
(************************************************************************)
PROCEDURE MoveLeft (M: Menu);
(* Moves to the next item left, if present. *)
BEGIN
WITH M^ DO
IF column > 1 THEN
DEC (column); DEC (CurrentItemNo, hstep);
ELSE
CASE offL OF
| stick: (* no action needed*) ;
| wrap: INC (CurrentItemNo, hstep*(NoOfColumns-1));
column := NoOfColumns;
| escape: CurrentItemNo := 0; RanOffEdge := TRUE;
| return: RanOffEdge := TRUE;
END (*CASE*);
END (*IF*);
END (*WITH*);
END MoveLeft;
(************************************************************************)
PROCEDURE GotoItem (M: Menu; newitem: ItemNo);
(* Moves to the menu item whose number is specified. We move a row *)
(* at a time, rather than taking one big leap, since this is less *)
(* disconcerting to the user. *)
BEGIN
WITH M^ DO
IF newitem <> CurrentItemNo THEN
IF vstep = 1 THEN (* we are using column major order *)
column := ((newitem-1) DIV hstep) + 1;
ELSE (* we are using row major order *)
column := ((newitem-1) MOD vstep) + 1;
END (*IF*);
CurrentItemNo := (column-1)*hstep
+ (ExtraAtTop+row-1)*vstep + 1;
WHILE CurrentItemNo > newitem DO UpARow(M) END (*WHILE*);
WHILE CurrentItemNo < newitem DO DownARow(M) END (*WHILE*);
END (*IF*);
END (*WITH*);
END GotoItem;
(************************************************************************)
PROCEDURE RepositionTo (M: Menu; searchchar: CHAR): BOOLEAN;
(* Finds the next menu item whose selection character matches *)
(* selchar, and adjusts the display appropriately. Returns TRUE if *)
(* searchchar was actually found; otherwise the current menu item *)
(* doesn't change and the function result is FALSE. *)
VAR j: ItemNo; found: BOOLEAN;
BEGIN
WITH M^ DO
j := CurrentItemNo;
REPEAT
IF j >= NoOfItems THEN j := 1
ELSE INC (j)
END (*IF*);
WITH TextPtr^[j] DO
found := CAP(text[selpos]) = searchchar;
END (*WITH*);
UNTIL found OR (j = CurrentItemNo);
END (*WITH*);
GotoItem (M, j);
RETURN found;
END RepositionTo;
(************************************************************************)
PROCEDURE HandleFunctionKey (M: Menu; VAR (*INOUT*) option: CHAR);
(* Deals with the case where the user typed a function key - i.e. *)
(* any key which produces a two-code sequence where the first code *)
(* is CHR(0). On entry, the CHR(0) has already been read. *)
VAR count: CARDINAL;
BEGIN
WITH M^ DO
option := GetKey(win);
IF option = "H" THEN UpARow(M) (* cursor up *)
ELSIF option = "P" THEN DownARow(M) (* cursor down *)
ELSIF option = "M" THEN MoveRight(M) (* cursor right *)
ELSIF option = "K" THEN MoveLeft(M) (* cursor left *)
ELSIF option = "G" THEN (* home *)
GotoItem (M, 1);
ELSIF option = "O" THEN (* end *)
GotoItem (M, NoOfColumns*ItemsPerColumn);
GotoItem (M, NoOfItems);
ELSIF option = "I" THEN (* page up *)
IF row = 1 THEN
IF ExtraAtTop > 0 THEN
count := LocationInWindow.height;
REPEAT
UpARow(M); DEC (count);
UNTIL (count=0) OR (ExtraAtTop=0);
END (*IF*)
ELSE
WHILE row > 1 DO UpARow(M) END (*WHILE*)
END (*IF*)
ELSIF option = "Q" THEN (* page down *)
IF row = LocationInWindow.height THEN
IF ExtraAtBottom > 0 THEN
count := LocationInWindow.height;
REPEAT
DownARow(M); DEC (count);
UNTIL (count=0) OR (ExtraAtBottom=0);
END (*IF*)
ELSE
WHILE row < LocationInWindow.height DO
DownARow(M);
END (*WHILE*)
END (*IF*)
END (*IF*);
END (*WITH*);
END HandleFunctionKey;
(************************************************************************)
(* DEALING WITH MOUSE CLICKS *)
(************************************************************************)
PROCEDURE SelectItemAt (M: Menu; r: RowRange; c: ColumnRange);
VAR NewItemNo: ItemNo; OnAnItem: BOOLEAN;
BEGIN
WITH M^ DO
WITH LocationInWindow DO
DEC (r, firstrow); DEC (c, firstcol);
END (*WITH*);
OnAnItem := c MOD (ColumnWidth+gap) < ColumnWidth;
c := c DIV (ColumnWidth+gap);
IF c >= NoOfColumns THEN OnAnItem := FALSE END(*IF*);
IF OnAnItem THEN
(* We have now reduced (r,c) to be the coordinates of *)
(* an item in the visible part of the array, with (0,0) *)
(* corresponding to the top left position. *)
NewItemNo := c*hstep + (ExtraAtTop+r)*vstep + 1;
(* The first click on an item simply means that we *)
(* should go to that item; a second click on the same *)
(* item means that we should accept it as the result. *)
(* If the FastSelect option is enabled, the first click *)
(* will select the item as the result. *)
IF FastSelect OR (NewItemNo = CurrentItemNo) THEN
PutBack (" ");
END (*IF*);
HideMouseCursor;
GotoItem (M, NewItemNo);
ShowMouseCursor;
END (*IF*);
END (*WITH*);
END SelectItemAt;
(************************************************************************)
PROCEDURE InterpretMouseClick (M: Menu);
(* This procedure is called when we know that a mouse click has *)
(* been detected and its details stored in LastMouseClick. This *)
(* procedure checks whether the click is relevant to menu M, and *)
(* takes the appropriate action if so. *)
VAR OK: BOOLEAN; row: RowRange; column: ColumnRange;
BEGIN
WITH LastMouseClick DO
Obtain (access);
OK := valid AND (win = M^.win);
IF OK THEN
column := X; row := Y;
END (*IF*);
valid := FALSE;
Release (access);
END (*WITH*);
IF OK THEN
SelectItemAt (M, row, column);
END (*IF*);
END InterpretMouseClick;
(************************************************************************)
PROCEDURE RecordClick (w: Window; row: RowRange; col: ColumnRange);
(* This procedure is called asynchronously as the result of a mouse *)
(* click. The parameters tell us which window was clicked on, and *)
(* where in that window the click occurred, but they don't tell us *)
(* which menu is involved. Rather than work that out here, we *)
(* stuff a special character into the keyboard. Procedure *)
(* MakeTheSelection will pick up that special character and from *)
(* that deduce that it needs to look at the LastMouseClick data. *)
BEGIN
WITH LastMouseClick DO
Obtain (access);
win := w;
X := col; Y := row;
valid := TRUE;
Release (access);
StuffKeyboardBuffer (ClickIndicator);
END (*WITH*);
END RecordClick;
(************************************************************************)
PROCEDURE ClickOnTop (w: Window; row: RowRange; col: ColumnRange);
(* This procedure is triggered by a mouse click on the window *)
(* divider. We turn this into a "cursor up" command. *)
BEGIN
StuffKeyboardBuffer (CHR(0));
StuffKeyboardBuffer ("H");
END ClickOnTop;
(************************************************************************)
PROCEDURE ClickOnTopMORE (w: Window; row: RowRange; col: ColumnRange);
(* This procedure is triggered by a mouse click on the top *MORE* *)
(* indicator. We turn this into a "page up" command. *)
BEGIN
StuffKeyboardBuffer (CHR(0));
StuffKeyboardBuffer ("I");
END ClickOnTopMORE;
(************************************************************************)
PROCEDURE ClickOnBottom (w: Window; row: RowRange; col: ColumnRange);
(* This procedure is triggered by a mouse click on the bottom *)
(* of the window frame. We turn this into a "cursor down" command. *)
BEGIN
StuffKeyboardBuffer (CHR(0));
StuffKeyboardBuffer ("P");
END ClickOnBottom;
(************************************************************************)
PROCEDURE ClickOnBottomMORE (w: Window; row: RowRange; col: ColumnRange);
(* This procedure is triggered by a mouse click on the bottom *)
(* *MORE* indicator. We turn this into a "page down" command. *)
BEGIN
StuffKeyboardBuffer (CHR(0));
StuffKeyboardBuffer ("Q");
END ClickOnBottomMORE;
(************************************************************************)
(* SCREEN DISPLAY *)
(************************************************************************)
PROCEDURE OpeningDisplay (M: Menu; initialvalue: CARDINAL);
(* Sets up the initial state of the display of M. It is assumed *)
(* that window M^.win is already open and that the position of the *)
(* menu has already been set. It is also assumed that the border *)
(* and title, if needed, have already been displayed. *)
VAR j: RowRange;
BEGIN
WITH M^ DO
IF (initialvalue = 0) OR (initialvalue > NoOfItems) THEN
initialvalue := 1;
END (*IF*);
RanOffEdge := FALSE;
CurrentItemNo := 1; column := 1; ExtraAtTop := 0;
ExtraAtBottom := ItemsPerColumn - LocationInWindow.height;
FOR j := 1 TO LocationInWindow.height DO
row := j; RefreshRow (M);
END (*FOR*);
row := 1;
IF (ExtraAtBottom > 0) THEN
IF MouseAvailable() THEN HideMouseCursor END (*IF*);
DisplayMOREatBottom (M);
IF MouseAvailable() THEN ShowMouseCursor END (*IF*);
END (*IF*);
END (*WITH*);
GotoItem (M, initialvalue);
END OpeningDisplay;
(************************************************************************)
PROCEDURE DisplayMenu (w: Window; M: Menu;
rows, columns, initialvalue: CARDINAL);
(* Displays menu M at the current cursor position in window w, *)
(* with initialvalue specifying a field to highlight. *)
VAR row1, col1: CARDINAL;
BEGIN
SaveCursor (w, row1, col1);
WITH M^ DO
win := w;
IF ShowBorder THEN
Box (w, row1, col1, columns-1, rows-1, single);
INC (row1); INC (col1);
DEC (rows, 2); DEC (columns, 2);
END (*IF*);
IF ShowTitle THEN
INC (row1, 2); DEC (rows, 2);
IF ShowBorder THEN
HLine (w, row1-1, col1-1, col1+columns, double);
ELSE
HLine (w, row1-1, col1, col1+columns-1, double);
END (*IF*);
END (*IF*);
SetRelativeLocation (M, row1, col1, rows, columns);
IF ShowTitle THEN
SetCursor (w, row1-2, col1); WriteString (w, heading);
END (*IF*);
END (*WITH*);
NewScrollingRegion (w, row1, row1+rows-1, col1, col1+columns-1);
OpeningDisplay (M, initialvalue);
Highlight (M); ResetScrollingRegion (w);
END DisplayMenu;
(************************************************************************)
(* MAKING A SELECTION FROM A MENU *)
(************************************************************************)
PROCEDURE MakeTheSelection (M: Menu);
(* Allows the keyboard user to alter the state of menu M by use of *)
(* the cursor control keys, or by typing the initial letter of a *)
(* menu item. Returns when Space or Enter is typed, also returns *)
(* with M^.CurrentItem=0 if Esc is typed. In Special Mode only, *)
(* also returns if a cursor movement key would run us off the edge *)
(* of the menu. (In Normal Mode, any attempt to run off the edge *)
(* is ignored.) In addition, in Special Mode the final key typed *)
(* remains available (e.g. by InKey()) to the caller. *)
TYPE CHARSET = SET OF CHAR;
CONST CR = CHR(0DH);
VAR option: CHAR;
BEGIN
WITH M^ DO
RanOffEdge := FALSE;
LOOP
Highlight (M);
option := GetKey (M^.win);
Unhighlight (M);
IF option = ClickIndicator THEN
InterpretMouseClick(M);
ELSIF option = " " THEN EXIT(*LOOP*)
ELSIF option = CR THEN EXIT (*LOOP*)
ELSIF option = Esc THEN
CurrentItemNo := 0; EXIT (*LOOP*)
ELSIF option IN CHARSET{"0".."9", "A".."Z", "a".."z"} THEN
IF RepositionTo(M, CAP(option)) AND FastSelect THEN
EXIT (*LOOP*);
END (*IF*);
ELSIF option = CHR(0) THEN
HandleFunctionKey (M, option);
IF RanOffEdge THEN
IF PutBackExitKey THEN
PutBack (option); option := CHR(0);
END (*IF*);
EXIT (*LOOP*);
END (*IF*);
END (*IF*);
END (*LOOP*);
IF PutBackExitKey THEN
PutBack (option);
END (*IF*);
IF CurrentItemNo > NoOfItems THEN
CurrentItemNo := 0;
END (*IF*);
END (*WITH*);
END MakeTheSelection;
(************************************************************************)
PROCEDURE SelectFromMenu (M: Menu): CARDINAL;
(* Displays menu M on the screen, allows terminal user to use *)
(* cursor keys to move about the menu and the ENTER key to select *)
(* an item. (The space bar is also accepted, as an alternative to *)
(* the ENTER key, to select an item). An item may also be selected *)
(* by typing its initial letter, followed by space or ENTER. *)
(* Returns the number of the item which was selected. *)
(* (Item numbers start from 1). An answer of 0 indicates that the *)
(* user typed the ESC key to return without selecting anything. *)
(* Remark: it is possible with the cursor keys to "select" a *)
(* nonexistent item at the bottom of the last column. The result *)
(* will be 0 in this case. Although this might appear to be a bug, *)
(* it is deliberate. I found by experiment that the more "logical" *)
(* approach of stopping the user from moving the cursor into a *)
(* blank region was a nuisance for the user. *)
VAR UIW: UIWindow; frame: FrameType;
capabilities: CapabilitySet; framesize: CARDINAL;
BEGIN
WITH M^ DO
(* Open the window, unless it's already open. *)
IF win = NilWindow THEN
framesize := 0;
IF MouseAvailable() THEN HideMouseCursor END(*IF*);
WITH ScreenPosition DO
IF ShowBorder THEN
frame := simpleframe; INC(framesize);
ELSE frame := noframe
END (*IF*);
OpenWindow (win, foreground, background,
firstrow, lastrow, firstcol, lastcol,
frame, doubledivider);
IF ShowTitle THEN
WriteString (win, heading);
ChangeScrollingRegion (win, 2+framesize,
lastrow-firstrow-framesize);
END (*IF*);
END (*WITH*);
IF MouseAvailable() THEN
IF ShowBorder AND MouseControl THEN
capabilities := CapabilitySet {wshow, wmove, wescape};
ELSE
capabilities := CapabilitySet {wshow};
END (*IF*);
UIW := AllowMouseControl (win, heading, capabilities);
WITH LocationInWindow DO
AddActiveRegion (UIW, firstrow, firstrow+height-1,
firstcol, firstcol+width-1,
LeftOnly, RecordClick);
IF ShowTitle OR (ShowBorder AND NOT MouseControl) THEN
AddActiveRegion (UIW, firstrow-1, firstrow-1,
firstcol, firstcol+width-7,
LeftOnly, ClickOnTop);
AddActiveRegion (UIW, firstrow-1, firstrow-1,
firstcol+width-6, firstcol+width-1,
LeftOnly, ClickOnTopMORE);
END (*IF*);
IF ShowBorder THEN
AddActiveRegion (UIW, firstrow+height, firstrow+height,
firstcol, firstcol+width-7,
LeftOnly, ClickOnBottom);
AddActiveRegion (UIW, firstrow+height, firstrow+height,
firstcol+width-6, firstcol+width-1,
LeftOnly, ClickOnBottomMORE);
END (*IF*);
END (*WITH*);
ShowMouseCursor;
END (*IF*);
OpeningDisplay (M, 1);
END (*IF*);
WITH LocationInWindow DO
NewScrollingRegion (win, firstrow, firstrow+height-1,
firstcol, firstcol+width-1);
END (*WITH*);
(* Window is now open, let the user make a selection. *)
MakeTheSelection (M);
IF CurrentItemNo > 0 THEN
Highlight (M);
END (*IF*);
ResetScrollingRegion (win);
(* Close the window, if appropriate. *)
IF CloseAfterSelection THEN
IF MouseAvailable() THEN HideMouseCursor END(*IF*);
CloseWindow (win); win := NilWindow;
IF MouseAvailable() THEN ShowMouseCursor END(*IF*);
END (*IF*);
RETURN CurrentItemNo;
END (*WITH*);
END SelectFromMenu;
(************************************************************************)
BEGIN
WITH LastMouseClick DO
CreateLock (access);
valid := FALSE;
END (*WITH*);
END Menus.