|
Back in our November 1987 issue, Kent demonstrated how to code pop-ups, pull-downs, and menu bars in Turbo C. Now he's back with an improved version for Turbo Pascal.
July 01, 1988
URL:http://www.drdobbs.com/architecture-and-design/structured-programming/184407973
In the November 1987 issue of DDJ, I did a feature article describing an architecture for pop-ups, pulldowns, and menu bars in Turbo C. Since then both Turbo C and Turbo Pascal have undergone major overhauls, particularly in the area of display management, and my architecture has changed accordingly. As a result, it's time to revisit the subject and give you an update, this time using Turbo Pascal 4.0.
Conceptually, the methodology borrows heavily from object-oriented programming. That is, it provides a couple of data structures for describing pop-ups and menu bars, and some procedures for manipulating them. The result, implemented in a Pascal unit, is a simple yet effective way of constructing friendly user interfaces. Just plug in the unit with a USES statement, then put the objects to work.
The productivity gains obtained from this architecture are by no means trivial. A few weeks ago, I wrote a complete stock market analysis program with five pull-down menus and who knows how many pop-up boxes in just three days of spare time. The visual prototype all the menus and pop-ups and what not-took only a couple of hours. Packaged routines for the user interface left me free to concentrate on the internal workings of the program. This is important, since the user interface in PC applications typically demands more than 50 percent of the code. Anything that reduces this burden is by definition a productivity enhancement, so here goes.
The architecture rests on two basic data structures that I call popRec and menuRec, which are near the top of Listing One. They describe a pop-up and a menu bar, respectively. A certain synergy exists between the two, but we can treat them separately. Let's deal first with pop-ups.
There is no difference between a pull-down menu and a pop-up dialog or message box. A pull-down menu is simply a pop-up positioned so that it appears to hang down from the menu bar selection above. Both objects have fixed dimensions, borders, color attributes, and usually text contents. The only difference is the way you treat them-for example, moving a menu's highlight bar in response to keystrokeswhich you can handle procedurally. Consequently, we'll refer to them from now on with the collective term pop-up, which effectively describes their nature.
A pop-up is a visual object that appears when needed and vanishes when it's no longer needed, restoring the area it overlaid during its brief existence. A screen write is destructive, so if you want to undo the damage it does, you have to save the image before flashing up the popup. Then, to make the pop-up disappear, you simply copy the saved image back into the video buffer.
This implies, of course, that you know where the video buffer is. POPUPS.PAS declares the pointer VideoBuffer. The initialization code (at the end of the unit) determines the memory address of display memory based on the current video mode and initializes the pointer. The unit assumes that the machine has an IBM-standard adapter (MDA, CGA, EGA, or VGA). You can make it more versatile by extending the possibilities to other adapters, such as the Hercules. The November 1987 issue of DDJ, pages 3/-35 provide signatures for doing this.
Once you know where the video buffer is, it's a simple matter to save and restore it. To save: Allocate a heap node of the appropriate size and move that number of bytes from the video buffer to the heap node.
For text on an IBM-standard adapter, the display size is 4096 bytes. To make the pop-up disappear and restore the overlaid area: Move data back to the video buffer from the heap node and release the heap space.
The popShow and popErase procedures in POPUPS.PAS perform these operations automatically.
In a world characterized by pop-ups, you frequently operate within a hierarchy. For example, you pull down a menu, then pop up a dialog box, then display a message window. These objects must be removed in the proper sequence, which suggests a LIFO stack containing images. POPUPS.PAS doesn't provide a mechanism for managing the hierarchy; that's your responsibility. However, each popRec structure contains a placeholder---the save field for storing the heap address of the previous image. PopShow loads this field when it saves the current image before altering the display. PopErase uses it to restore the old image, then releases the heap space and resets the pointer field to NIL.
Your responsibility, then, is to make sure that a sequence of popErase calls retreats in the opposite order from the series of popShow calls that created the present display configuration. This ensures that the display is not corrupted. Example:
The retreat thus occurs in LIFO order.
The popRec structure consists of three sections. The first ten fields are a descriptor list for the pop-up: its location/dimensions, border style, and color scheme. The next two fields are pointers to the optional fixed-text contents and the heap node. The final five fields are for state information saved by popShow and used by popErase to restore the display to its previous condition.
One of the key elements of this approach is, for each pop-up, to define a popRec structure as a typed constant. It's only necessary to initialize the descriptor list. Here's an example for an object called MyPop:
This pop-up appears between coordinates 10, 5 and 25, 10, has a double-score border, and uses the colors shown. The remaining fields are set by default to zero (NIL for pointers). All that remains to complete the description of the pop-up is to set the text contents pointer.
You can't initialize a pointer field at declaration, since addresses aren't known until run time. Therefore, if MyPop contains fixed text, you have to include a pointer assignment statement early in the program in order to complete the initialization of the structure. Say the fixed-text content is "This is MyPop." You can either assign the text to a variable string, or declare a string-typed constant, then put a pointer to it into MyPop. A typed constant is better because it conserves memory. Example:
When you execute popShow (MyPop), the pop-up appears with the text in the top row, with one blank between the border and the first character.
Now let's say MyPop is a pulldown menu with the selections Open, New, Close, and Quit, each on its own line. You can specify this list as follows:
The tilde character [~] is the element separator, defined as the constant SEP in POPUPS.PAS. The popWrite procedure (nested within popShow and thus not externally callable) moves to the second column of the next row when it encounters a tilde within a string.
You can also use Writeln( ) statements, as well as cursor control statements such as Gotoxy, to output to the active pop-up. (The "active popup" is the one most recently placed on the display.) The region inside the border is a clipped window whose upper-left corner is at coordinates 1, 1. its physical dimensions are (right-left-I) columns and (bottom-top-1( rows. For example, if top = 10 and bottom = 20, then the window has nine rows numbered 1.. 9. While a pop-up is active, screen writes remain within its borders, wrapping at the right edge and scrolling the contents at the bottom.
The unit also furnishes popCenter, which writes a string that's centered on the indicated row. This routine verifies that the target popup is currently visible and that the row is within the window; it doesn't verity that the target is active. For this reason, it's important that you not write to a visible but inactive pop-up using popCenter; you'll corrupt the active object, which owns the current text window.
PopShow calls the Textbox procedure to outline the pop-up based on the object's style and border fields. The border field specifies the text foreground color for the outline. Style specifies one of three border types:
Textbox uses this value, which it receives as a parameter, to select the appropriate box-drawing character set from the typed constant array called Border. If style is 0, the routine merely returns without taking any action.
Popshow saves the current video state (window dimensions, foreground/background color, and cursor position), resets the window to the full screen and saves the display image, and then draws the border for the pop-up using the object descriptor list. It then sets the window to the area inside the border and issues a ClrScr to implement the new background color and get rid of any overlaid text. Finally, it calls popWrite to place any fixed text within the pop-up. PopErase reverses this process by restoring the previous screen image and its state, including the previously active window. This explains why you must enforce LIFO order in removing multiple pop-ups.
PopHilite and popNormal change the color scheme of a given row within the active pop-up. Initially a pop-up appears with the normal foreground/background colors specified in its descriptor list (the normal and normback fields). PopHilite changes the entire row to the highlight colors (hilite and hiback), and popNormal changes it back. The real work of these routines is done by the shared procedure popRewrite, which uses ROM BIOS calls to read each character in the row and write it back to the same location with the new color attributes.
PopHilite is useful any time for emphasizing fixed or variable text within a pop-up. The combination of popHilite and popNormal affect a movable lighted bar that indicates the current pull-down menu selection. Consider for example Example 1, this page.
In other words, when the downcursor key is pressed, you first restore the selected row to normal, then move to the next row and highlight it. Other keys-up-cursor, home, end, and so on-trigger similar sequences. This logic is illustrative and not complete; you also have to handle wrapping, as when the selected row is at the bottom of the menu and the user hits down-cursor. A sample program presented later illustrates the logic more fully.
Figure 1: Screen image after the popShow and showMenubar statements have been executed.
Figure 2: This snapshot shows most of the visual objects defined in POPDEMO.PAS. Note that the objects can overlay each other, and when they go away, the overlaid surface is automatically restored. Defining such visual environments is fairly simply using the tools in the POPUPS.PAS unit.
But first let's talk about menu bars. As implemented here, a menu bar is a distinctively colored list of selections arrayed across the screen or across a pop-up, usually, but not always, at the top. The top row of the Turbo Pascal environment is a typical example. When you select something from the menu bar, a pull-down menu might appear beneath it, allowing subselections in a tree-like fashion. Or a menu bar selection might be an "end node" such as the Run selection in the Turbo Pascal environment; it doesn't produce a pull-down menu, but instead initiates an action directly.
Like pop-ups, menu bars can be described and initialized with a data structure, In POPUPS.PAS, the structure is called menuRec. Its components are:
Row---The row (1..n) where the menu bar will appear within the window that contains it.
Interval---The spacing between first characters of the menu choices.
Fore---The text foreground color.
Back---The text background color.
Choice---A pointer to the string containing the menu choices.
It's necessary to calculate the interval manually, taking into account the number of items on the menu and the width of the containing window. The latter is usually the whole screen but it might be a pop-up that has its own menu bar. The formula is Interval = (W DIV I) + 1, where W is the total width and 1 is the number of items. Let's say you're planning to place a menu bar with three selections in a pop-up called Yourpop. YourPop begins at column 30 and ends at column 47. The width of the window, then, is 47 30 - 1 = 16, Therefore, you can estimate the spacing as Interval = (16 DlV 3) + 1 = 6.
Note the word estimate. The calculated interval might not work if the last selection is a long word. It takes some trial and error; you must adjust the interval to make the menu text fit the space without wrapping to the next row.
As in the case of a pop-up, you must specify the menu bar string separately. The same element separator applies. Say the menu bar contains the choices Show, Help, and Quit. You can define it as
Similarly, you can define the menu bar structure as a typed constant. Example:
Then, at run time (assuming YourPop has also been defined), do the following:
After the popShow and showMenubar statements execute, you have an object on the screen that looks something like Figure 1 (see page 125).
The synergy between menu bars and pull-downs occurs with respect to the interval. Define your pulldowns so that they hang under the related menu bar selections.
Again, this is a manual process in this architecture, and you might have to do some tweaking to get it right. A case in point is where the last menu bar selection is at column 70, but you need 12 columns for the pull-down. Obviously, you can't go to column 82 on an 80-column display, so you'll have to shift the last pop-up to the left,
The POPUPS.PAS unit also provides three other services commonly needed in interactive environments, Two are related: Curson and Cursoff, They turn the text cursor on and off, respectively. The Keystroke function returns a value derived from the user's operation of the keyboard.
Keystroke plays some games with values for the special extended keys. These encompass F1-F10, the cursor control and Home/End/PgUp/PgDn keys, and any Alt-key combination. All of these generate a 2-byte sequence, with the first being ASCII 0 and the second denoting which key was actually pressed. The problem is that the second byte might be a valid alphanumeric. For example, the Home key generates 0 and 71. It happens that 71 is also the ASCII value for uppercase G. If Keystroke returned only the second byte, your program would be unable to determine if the user pressed G or Home.
For this reason, Keystroke adds 128 to the second byte of any extended key and returns that value. The unit defines names for some of these keystroke values. You can easily expand the list for others. For example, F2-F10 return second bytes of 60 . . 68, which Keystroke maps to 188 . . 196.
The program POPDEMO.PAS in Listing Two is a fairly extensive demonstration of the user interface architecture. This program mns three tasks in different popups:
popShow (pulldown_1);
{Get a selection}
popShow (dialog_box);
{Conduct dialog}
popShow (error_message_box);
{Get a releasing keystroke, then retreat}
popErase (error_message_box);
popErase (dialog_box_1);
popErase (pulldown_1);
CONST MyPop : popRec = (
left:10;
{Location/dimensions}
top : 5;
right : 25;
bottom : 10;
style : 2;
(Double-score border)
normal : Cyan;
hilite : LightCyan;
normback : Blue;
hiback : LightBlue;
border : Black);
CONST MyPopText : string[13] = `This is MyPop';
BEGIN MyPop.contents := @MyPopText;
... {Do some stuff}
popShow (MyPop);
{Display MyPop}
... {Do more stuff}
popErase (MyPop);
{Make MyPop go away}
END.
CONST MyPopText : string[] = `Opens New~Close~Quit';
0 = No border
1 = Single-score
2 = Double-score
Example 1: PopHilite is useful for emphasizing fixed or variable text within a pop-up.
SelectedRow:=1;
popHilite (MyPop, SelectedRow);
REPEAT {Menu selection process}
UserKey: = Keystroke;
IF UserKey = DownCursor THEN BEGIN
popNormal (MyPop, SelectedRow);
INC (SelectedRos);
popHilite (MyPop, SelectedRow);
END
ELSE
. . .
UNTIL TerminatingCondition;
CONST YourPopMenubar: string[14] = `Shown Helps Quit';
CONST YourPopMenu : menuRec = (
Row : 1;
Interval : 6;
Fore : Black;
Back : LightGray);
BEGIN YourPopMenu choice = @YourPopMenubar;
... {Do some stuff}
popshow (YourPop);
showMenubar (YourPopMenu);
... {Act on the menu bar}
popErase (YourPop);
... {Do whatever}
END.
It has a menu bar and three pulldown menus. Navigation through the menu structure is accomplished by any combination of cursor keys, in~itial letters, and/or the Enter key. For example, if you're in the Demos menu and press either the left cursor key or T, you'll instantly move to the Thru menu. To exit the program, press either Enter or Q. If you press E from any menu, you ll return to the Demos menu. In Demos, if you want to see the business chart, press G or cursor to it and hit Enter. Figure 1 shows what you get on a color monitor if you take the All demos selection from the Run menu,
Most of the program's work is done in two places: the object initialization at the start and the DoMainMenu procedure. The initialization defines all the visual objects of the program. DoMainMenu acts on keystrokes and dispatches the appropriate pull-down. Note that each pull-down returns its terminating keystroke. DoMainMenu then uses this result to decide what to do next.
The architecture in POPUPS.PAS removes virtually all of the complexity in managing pop-ups, pulldowns, and menu bars. The only remaining complexity is in handling signals from the user; interpret numerous possibilities and act on them appropriately. this still requires considerable code. Unfortunately, this is too application-dependent to be easily reduced to abstract, general-purpose code.
Structured Programming by Kent Porter
[LISTING ONE]
Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.
UNIT popups;
(* Kent Porter, DDJ, July '88 issue *)
(* Support for pop-up windows and menu bars *)
(* Works with MDA, Compaq, CGA, EGA, VGA *)
(* Turbo Pascal 4.0 *)
INTERFACE
USES dos, crt;
(* These are names for common keystrokes *)
CONST F1 = #187; { Second byte plus 128 }
HomeKey = #199;
EndKey = #207;
PgUp = #201;
PgDn = #209;
UpCursor = #200;
DownCursor = #208;
LeftCursor = #203;
RiteCursor = #205;
Enter = #13;
(* These are structures used by the routines *)
CONST SEP = '~'; { Element separator in menu contents }
TYPE
strPtr = ^STRING;
popRec = RECORD
left, top, right, bottom, { Border locations }
style, { Border style }
normal, hilite, { Text attributes }
normback, hiback, border : INTEGER;
contents : strPtr; { Fixed text contents }
save : POINTER; { pointer to display save buffer }
oldMin, oldMax : WORD; { Previous window dimensions }
oldX, oldY : INTEGER; { previous cursor location }
oldColor : WORD; { previous fore/background colors }
END;
menuRec = RECORD
row, { row where bar appears }
interval, { cols between first chars }
fore, back : INTEGER; { fore/background colors }
choice : strPtr; { pointer to text contents }
END;
VAR VideoBuffer : POINTER; { Global pointer to text video buffer }
(* List of exported routines in this module *)
(* ---------------------------------------- *)
PROCEDURE textbox (left, top, right, bottom, style : INTEGER);
PROCEDURE popShow (VAR pop : popRec);
PROCEDURE popErase (VAR pop : popRec);
PROCEDURE popCenter (VAR pop : popRec; row : INTEGER; info : STRING);
PROCEDURE popHilite (VAR pop : popRec; row : INTEGER);
PROCEDURE popNormal (VAR pop : popRec; row : INTEGER);
PROCEDURE showMenubar (VAR spec : menuRec);
PROCEDURE cursOff;
PROCEDURE cursOn;
FUNCTION Keystroke : CHAR;
(* ---------------------------------------------------------------- *)
IMPLEMENTATION
{ Private identifiers }
CONST bufSize = 4096; { size of video buffer }
border : ARRAY [1..2, 0..5] OF CHAR = { box border chars }
(( #196, #179, #218, #191, #217, #192),
( #205, #186, #201, #187, #188, #200));
VAR egaByte : WORD ABSOLUTE $0040:$0087; { EGA eqpt byte }
reg : REGISTERS; { regs for low-level calls }
mode : WORD; { current video mode }
{ Routine bodies follow }
PROCEDURE textbox;
{ Draw textbox in indicated style, where:
0 = no border
1 = single score
2 = double score }
VAR r, c : INTEGER;
BEGIN
IF style IN [1..2] THEN BEGIN
{ Draw horizontals }
FOR c := (left+1) TO right DO BEGIN
Gotoxy (c, top); WRITE (border [style, 0]);
Gotoxy (c, bottom); WRITE (border [style, 0]);
END;
{ Draw verticals }
FOR r := (top+1) TO bottom DO BEGIN
Gotoxy (left, r); WRITE (border [style, 1]);
Gotoxy (right, r); WRITE (border [style, 1]);
END;
{ Draw corners }
Gotoxy (left, top); WRITE (border [style, 2]);
Gotoxy (right, top); WRITE (border [style, 3]);
Gotoxy (right, bottom); WRITE (border [style, 4]);
Gotoxy (left, bottom); WRITE (border [style, 5]);
END;
END; { of textbox }
(* -------------------------- *)
PROCEDURE popShow;
{ display popup described by passed structure }
PROCEDURE popWrite (VAR winText : STRING);
{ Local proc to write fixed popup contents, if any }
VAR p : INTEGER;
BEGIN
IF pop.contents <> NIL THEN BEGIN
GOTOXY (2, 1); { Always leave 1 leading space }
FOR p := 1 TO length (winText) DO
IF winText [p] <> SEP THEN
WRITE (winText [p])
ELSE
GOTOXY (2, whereY + 1); { Go to next row on separator }
END;
END; { of popWrite }
BEGIN { Body of popShow }
{ Get the current video state }
pop.oldMin := windMin + $0101;
pop.oldMax := windMax + $0101; { window dimensions }
pop.oldColor := textAttr; { current colors }
pop.oldX := whereX; pop.oldY := whereY; { cursor position }
Window (1, 1, 80, 25); { reset window to full screen }
{ Save the current screen }
GetMem (pop.save, bufSize); { allocate space for it }
Move (videoBuffer^, pop.save^, bufSize); { save screen }
{ Draw the border for the popup }
WITH pop DO BEGIN
Textcolor (border);
Textbackground (normback);
Textbox (left, top, right, bottom, style);
{ Open the window }
Textcolor (normal);
Window (left+1, top+1, right-1, bottom-1);
END; { of WITH }
{ Write fixed text }
ClrScr;
popWrite (pop.contents^);
END;
(* -------------------------- *)
PROCEDURE popErase;
{ Erase pop-up window, restoring overlaid image }
BEGIN
{ Make sure there's a saved image to restore }
IF pop.save <> NIL THEN BEGIN
window (1, 1, 80, 25);
{ Restore previous video state }
WITH pop DO BEGIN
Window (LO (oldMin), HI (oldMin),
LO (oldMax), HI (oldMax));
Textcolor (oldColor AND $0F);
TextBackground (oldColor SHR 4);
Gotoxy (pop.oldX, pop.oldY);
END;
{ Restore overlaid screen image }
Move (pop.save^, videoBuffer^, bufSize);
FreeMem (pop.save, bufSize);
pop.save := NIL;
END;
END;
(* -------------------------- *)
PROCEDURE popCenter;
{ Center string in window at specified row }
VAR col : INTEGER;
BEGIN
IF pop.save <> NIL THEN { pop-up is visible }
IF row < pop.bottom - pop.top THEN BEGIN { row is legal }
col := (pop.right - pop.left - Length (info)) DIV 2;
Gotoxy (col, row);
WRITE (info);
END;
END;
(* -------------------------- *)
PROCEDURE popRewrite (VAR pop : popRec; row : INTEGER; attrib : BYTE);
{ Local proc called by popHilite and popNormal }
{ Rewrites pop-up row with new character attribute }
VAR p, nchars : INTEGER;
BEGIN
IF pop.save <> NIL THEN { pop-up is visible }
IF row < pop.bottom - pop.top THEN BEGIN
nchars := pop.right - pop.left - 1; { Get width of row }
FOR p := 1 TO nchars DO BEGIN { For each char in row do.. }
Gotoxy (p, row); { goto char }
reg.ah := 8; { Get char }
reg.bh := 0;
intr (16, reg); { via ROM BIOS }
reg.ah := 9; { write back out with }
reg.bl := attrib; { hilite attribs }
reg.bh := 0;
reg.cx := 1;
intr (16, reg);
END;
END;
END;
(* -------------------------- *)
PROCEDURE popHilite;
{ Highlight text in specified pop-up row }
VAR attrib : BYTE;
x, y : INTEGER;
BEGIN
x := whereX; y := whereY; { Save cursor position }
Attrib := pop.hilite + (pop.hiback SHL 4); { Set text attributes }
popRewrite (pop, row, attrib); { Rewrite row }
gotoxy (x, y); { Restore cursor }
END;
(* -------------------------- *)
PROCEDURE popNormal;
{ Set text in pop-up row to normal attributes }
VAR attrib : BYTE;
x, y : INTEGER;
BEGIN
x := whereX; y := whereY;
Attrib := pop.normal + (pop.normback SHL 4);
popRewrite (pop, row, attrib);
gotoxy (x, y);
END;
PROCEDURE menuBar;
BEGIN
END;
(* -------------------------- *)
PROCEDURE showMenubar;
{ Place menu bar in current window }
VAR p, c, color, curX, curY : INTEGER;
x1, x2 : INTEGER;
BEGIN
{ Save video state information }
curX := whereX; curY := whereY;
color := TextAttr;
x1 := Lo (WindMin);
x2 := Lo (WindMax);
{ Set colors for menu }
TextColor (spec.fore);
TextBackground (spec.back);
gotoxy (1, spec.row);
WRITELN (' ');
{ Write out the bar background first }
Gotoxy (1, spec.row);
FOR p := x1 TO x2 DO
WRITE (' ');
{ Write the menubar text }
Gotoxy (1, spec.row); { First item location }
c := 1; { Item counter }
FOR p := 1 TO Length (spec.choice^) DO BEGIN { Char by char }
IF spec.choice^[p] <> SEP THEN { If not delim, }
WRITE (spec.choice^[p]) { write char }
ELSE BEGIN { else }
Gotoxy ((spec.interval * c) + 1, spec.row); { Go to next item }
INC (c); { Count items }
END
END;
{ Restore video state }
TextColor (color AND $0F);
TextBackground (color SHR 4);
Gotoxy (curX, curY);
END;
(* -------------------------- *)
PROCEDURE cursOff;
{ Turn off hardware cursor }
BEGIN
reg.ah := 3; { get current cursor shape }
reg.bh := 0; { NOTE: works in page 0 only }
Intr (16, reg);
reg.ch := reg.ch OR $20; { turn on bit 5 }
reg.ah := 1;
Intr (16, reg); { tell BIOS }
END;
(* -------------------------- *)
PROCEDURE cursOn;
{ Turn hardware cursor back on }
BEGIN
reg.ah := 3; { As above, except }
reg.bh := 0;
Intr (16, reg);
reg.ch := reg.ch AND $DF; { turn off bit 5 }
reg.ah := 1;
Intr (16, reg);
END;
(* -------------------------- *)
FUNCTION Keystroke;
{ Wait for a keystroke. If it's a special key (0+code), }
{ return the second byte + 128, else return upper case }
VAR ch : CHAR;
BEGIN
ch := UpCase (ReadKey); { Get keystroke }
IF ch = chr (0) THEN BEGIN { if a lead-in, then... }
ch := ReadKey; { get the second byte and }
ch := chr (ord (ch) + 128); { shift up by 128 }
END;
Keystroke := ch;
END;
(* ---------------------------------------------------------------- *)
{ INITIALIZATION CODE SETS ADDRESS OF VIDEO BUFFER }
Begin
Reg.ah := 15; { Get current video mode }
Intr (16, reg);
mode := reg.al;
IF (mode = 7) OR (mode = 2) THEN { Either MDA or Compaq MDA }
videoBuffer := ptr ($B000, $0000)
ELSE
videoBuffer := ptr ($B800, $0000); { else color buffer }
END. { of unit POPUPS.PAS }
[LISTING TWO]
Program popdemo;
(* Demonstrates use of POPUPS unit *)
USES crt, popups;
(* Define menubar *)
CONST MainMenu : menuRec = (
row : 1; interval : 26; fore : White; back : Green);
MainMenuText : string [14] = 'Demos~Run~Thru';
(* Define pull-down menus *)
DemoMenu : popRec = (
left : 1; top : 2; right : 14; bottom : 6; style : 1;
normal : LightGray; hilite : LightGray;
normback : Blue; hiback : Magenta; border : Cyan);
DemoMenuText : string [39] =
'Show file~Walk popup~Graphics';
RunMenu : popRec = (
left : 27; top : 2; right : 39; bottom : 5; style : 1;
normal : LightGray; hilite : LightGray;
normback : Blue; hiback : Magenta; border : Cyan);
RunMenuText : string [19] = 'All demos~Exit menu';
QuitMenu : popRec = (
left : 53; top : 2; right : 68; bottom : 5; style : 1;
normal : LightGray; hilite : LightGray;
normback : Blue; hiback : Magenta; border : Cyan);
QuitMenuText : string [22] = 'Quit program~Exit menu';
(* Define windows for demos *)
FileWindow : popRec = (
left : 2; top : 4; right : 75; bottom : 25; style : 2;
normal : Brown; hilite : 0;
normback : Black; hiback : 0; border : Yellow);
Walker : popRec = (
left : 66; top : 1; right : 80; bottom : 6; style : 2;
normal : Red; hilite : 0;
normback : LightGray; hiback : 0; border : Red);
WalkerText : string [46] =
'This pop-up~moves down~by changing~top, bottom';
SalesChart : popRec = (
left : 51; top : 9; right : 72; bottom : 22; style : 2;
normal : Cyan; hilite : 0;
normback : LightGray; hiback : 0; border : Red);
(* ------------------------ DEMO ROUTINES ------------------------- *)
PROCEDURE ShowFile;
{ List the source for this program in FileWindow }
{ Leave window open afterwards }
VAR ThisFile : TEXT;
Line : string [80];
BEGIN
popShow (FileWindow);
Assign (ThisFile, 'POPDEMO.PAS');
Reset (ThisFile);
WHILE NOT eof (ThisFile) DO BEGIN
Readln (ThisFile, line);
Writeln (Line);
END;
Close (ThisFile);
END;
(* -------------------------- *)
PROCEDURE WalkPopup;
{ Walk a pop-up down the right side of the display }
{ Moves by successively incrementing top and bottom }
VAR TopRow : INTEGER;
BEGIN
popShow (Walker);
FOR TopRow := 2 to 19 DO BEGIN
popErase (Walker);
Walker.top := TopRow;
Walker.bottom := TopRow + 5;
popShow (Walker);
END;
END;
(* -------------------------- *)
PROCEDURE TextChart;
{ Simulate a sales results chart using simple text graphics }
CONST block = #219;
PROCEDURE DrawBar (column, height : INTEGER);
VAR y : INTEGER;
BEGIN
FOR y := 10 DOWNTO (10 - height) DO BEGIN
Gotoxy (column, y);
Write (block);
END;
END;
BEGIN
popShow (SalesChart);
popCenter (SalesChart, 1, 'Sales Results');
TextColor (Green);
Gotoxy (2, 12); Write ('Projected');
DrawBar ( 2, 6);
DrawBar ( 7, 7);
DrawBar (12, 5);
DrawBar (17, 6);
TextColor (Red);
Gotoxy (14, 12); Write ('Actual');
DrawBar ( 4, 5);
DrawBar ( 9, 6);
DrawBar (14, 7);
DrawBar (19, 8);
END;
(* ----------------------- CONTROL ROUTINES ----------------------- *)
FUNCTION DemoResult : CHAR;
{ Pull down and act on Demos Menu }
VAR key, wait : CHAR;
pick : INTEGER;
exiting : BOOLEAN;
BEGIN
pick := 1;
exiting := FALSE;
popShow (DemoMenu);
popHilite (DemoMenu, 1);
REPEAT
{ Get menu selection }
key := Keystroke;
popNormal (DemoMenu, pick); { remove hilite bar }
CASE key OF
'S' : pick := 1;
'W' : pick := 2;
'G' : pick := 3;
DownCursor : BEGIN
Inc (pick);
IF pick > 3 THEN pick := 1; { Wrap to top row }
END;
UpCursor : BEGIN
Dec (pick);
IF pick = 0 THEN pick := 3; { Wrap to bottom }
END;
LeftCursor : exiting := TRUE;
RiteCursor : exiting := TRUE;
Enter : CASE pick OF { Selection by cursor + enter }
1: key := 'S';
2: key := 'W';
3: key := 'G';
END;
ELSE exiting := TRUE; { Pass back keystroke }
END;
popHilite (DemoMenu, pick); { hilite new pick }
{ Do demo if selected }
IF key IN ['S', 'W', 'G'] THEN BEGIN
CASE key OF
'S': BEGIN
ShowFile;
wait := ReadKey;
popErase (FileWindow);
END;
'W': BEGIN
WalkPopup;
wait := ReadKey;
popErase (Walker);
END;
'G': BEGIN
TextChart;
wait := ReadKey;
popErase (SalesChart);
END;
END;
END;
UNTIL exiting;
popErase (DemoMenu);
DemoResult := key;
END;
(* -------------------------- *)
FUNCTION RunResult : CHAR;
{ Pull down and act on Run Menu }
VAR key, wait : CHAR;
pick : INTEGER;
exiting : BOOLEAN;
BEGIN
pick := 1;
exiting := FALSE;
popShow (RunMenu);
popHilite (RunMenu, 1);
REPEAT
key := Keystroke; { remove hilite }
popNormal (RunMenu, pick);
CASE key OF
DownCursor : IF pick = 1 THEN pick := 2 ELSE pick := 1;
UpCursor : IF pick = 1 THEN pick := 2 ELSE pick := 1;
'E' : exiting := TRUE;
LeftCursor : exiting := TRUE;
RiteCursor : exiting := TRUE;
Enter : IF pick = 1 THEN key := 'A'
ELSE BEGIN
exiting := TRUE;
key := 'E';
END;
ELSE exiting := TRUE; { Pass back keystroke }
END;
popHilite (RunMenu, pick); { hilite new pick }
IF key = 'A' THEN BEGIN { Do all demos on 'A' }
ShowFile;
TextChart;
WalkPopup;
Wait := ReadKey; { Wait for keypress }
popErase (Walker); { Retreat thru popups }
popErase (SalesChart);
popErase (FileWindow);
END;
UNTIL exiting;
popErase (RunMenu);
RunResult := key;
END;
(* -------------------------- *)
FUNCTION QuitResult : CHAR;
{ Pull down and act on Quit Menu }
VAR key : CHAR;
pick : INTEGER;
exiting : BOOLEAN;
BEGIN
pick := 1;
exiting := FALSE;
popShow (QuitMenu);
popHilite (QuitMenu, 1);
REPEAT
key := Keystroke;
popNormal (QuitMenu, pick);
CASE key OF
DownCursor : IF pick = 1 THEN pick := 2 ELSE pick := 1;
UpCursor : IF pick = 1 THEN pick := 2 ELSE pick := 1;
'Q' : exiting := TRUE;
'E' : exiting := TRUE;
LeftCursor : exiting := TRUE;
RiteCursor : exiting := TRUE;
Enter : BEGIN
IF pick = 1 THEN key := 'Q' ELSE key := 'E';
exiting := TRUE;
END;
ELSE exiting := TRUE; { Pass back keystroke }
END;
popHilite (QuitMenu, pick);
UNTIL exiting;
popErase (QuitMenu);
QuitResult := key;
END;
(* -------------------------- *)
PROCEDURE DoMainMenu;
{ Manages pull-down menu selection }
TYPE MenuUp = (Demos, Run, Thru);
VAR quitting : BOOLEAN;
MMsel : MenuUp;
UserKey : CHAR;
BEGIN
Quitting := FALSE;
MMsel := Demos;
REPEAT
UserKey := chr (0);
{ Act on selected pulldown }
CASE MMsel OF
Demos : UserKey := DemoResult;
Run : UserKey := RunResult;
Thru : UserKey := QuitResult;
END;
{ Act on returned keystroke }
CASE UserKey OF
'E' : MMsel := Demos;
'D' : MMsel := Demos;
'R' : MMsel := Run;
'T' : MMsel := Thru;
'Q' : Quitting := TRUE;
LeftCursor: IF MMsel = Demos THEN
MMsel := Thru
ELSE
Dec (MMsel);
RiteCursor: IF MMsel = Thru THEN
MMsel := Demos
ELSE
Inc (MMsel);
END;
UNTIL quitting;
END;
(* ---------------------------------------------------------------- *)
BEGIN (*** Main program ***)
{ Initialize object text pointers }
MainMenu.choice := @MainMenuText;
DemoMenu.contents := @DemoMenuText;
RunMenu.contents := @RunMenuText;
QuitMenu.contents := @QuitMenuText;
Walker.contents := @WalkerText;
{ Set up screen and go }
ClrScr;
Cursoff;
showMenubar (MainMenu);
DoMainMenu;
{ Make sure cursor is on before quitting }
Curson;
ClrScr;
END.