home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1990
/
02
/
canup.lst
< prev
next >
Wrap
File List
|
1989-12-26
|
12KB
|
426 lines
_PICK-A-NUMBER INTERFACES_
by Bob Canup
[LISTING ONE]
MODULE Mtest ;
FROM MENU IMPORT MenuType,Menu ;
FROM InOut IMPORT WriteString, WriteLn ;
PROCEDURE CLS ;
BEGIN
WriteString(CHR(12)) ;
END CLS ;
PROCEDURE Header ;
BEGIN
WriteLn ;
WriteLn ;
WriteLn ;
WriteLn ;
WriteString(' M A I L I N G L I S T M E N U') ;
WriteLn ;
WriteString(' (Press Esc key to leave progam)') ;
END Header ;
PROCEDURE EnterData ;
END EnterData ;
PROCEDURE PrintZip ;
END PrintZip ;
PROCEDURE Modify ;
END Modify ;
PROCEDURE DelData ;
END DelData ;
PROCEDURE Browse ;
END Browse ;
PROCEDURE Backup ;
END Backup ;
PROCEDURE PrintNZip ;
END PrintNZip ;
PROCEDURE Setup ;
END Setup ;
PROCEDURE test ;
VAR
test : MenuType ;
i : CARDINAL ;
BEGIN
LOOP
CLS ;
Header ;
test[0] := '1. Enter new mail list data.' ;
test[1] := '2. Print a Zip code sorted mail list.' ;
test[2] := '3. Change existing data.' ;
test[3] := '4. Delete a single address from the list.' ;
test[4] := '5. Browse through the existing data.' ;
test[5] := '6. Backup data.' ;
test[6] := '7. Print a mail list not sorted by ZIP.' ;
test[7] := '8. Perform other functions.' ;
i := Menu(test,8) ;
CASE i OF
0 : EXIT |
1 : EnterData |
2 : PrintZip |
3 : Modify |
4 : DelData |
5 : Browse |
6 : Backup |
7 : PrintNZip |
8 : Setup
END ; (* CASE *)
END ; (* LOOP *)
END test ;
BEGIN
test ;
END Mtest.
[LISTIN╟ TWO]
DEFINITION MODULE READA;
(* EscType determines whether an esc will exit a field. The values are:
Esc which allows an escape to exit a field.
NoEsc which prevents exit from a field on an escape char entry.
*)
FROM SYSTEM IMPORT AX,BX,CX,DX,BP,CODE,SETREG ;
FROM Terminal IMPORT Write ;
FROM InOut IMPORT EOL ;
EXPORT QUALIFIED Grab, ClearField, gotoxy, EscType ;
TYPE
EscType = (Esc,NoEsc) ;
PROCEDURE Grab(VAR String : ARRAY OF CHAR ; EscFlag :EscType) ;
PROCEDURE ClearField(VAR String : ARRAY OF CHAR ; Column,Row : CARDINAL);
PROCEDURE gotoxy(x,y : CARDINAL ) ;
END READA.
[LISTING THREE]
(***************************************************************************
Name: READA
Purpose: Usefull String routines
ClearField wipes out a data entry field on screen
Grab accepts characters up to length of length of string array
then refuses to accept any more chars until Enter is pressed.
gotoxy positions the cursor.
Entry: ClearField(VAR String: ARRAY OF CHAR ; Column,Row : CARDINAL)
Grab(VAR String:ARRAY OF CHAR ; EscFlag : EscType)
gotoxy(x,y : CARDINAL) x = column y = row.
Exit: ClearField - String is zeroed, cursor left at position Column,Row
Grab - String is filled in with user entered characters.
Global Variables used: Passed String array.
Revision number:
1.2 10/3/88 Escape type added to Grab.
1.1 11/30/87 Escape key exit for String 0.
1.0 11/8/87
****************************************************************************)
IMPLEMENTATION MODULE READA ;
FROM SYSTEM IMPORT AX,BX,CX,DX,BP,CODE,SETREG ;
FROM Terminal IMPORT Write, Read ;
FROM InOut IMPORT EOL ;
VAR
Index : CARDINAL ;
Ch : CHAR ;
PROCEDURE gotoxy(x,y : CARDINAL ) ;
VAR
a : CARDINAL ;
BEGIN
IF ( x >= 0) AND ( x <= 79) AND ( y >=0) AND ( y <=24) THEN
IF ( x # 79) OR (y # 24 )
THEN
CODE( 55H) ; (* PUSH BP *)
a := 200H ;
SETREG ( AX ,a ) ;
CODE( 50H ) ; (* PUSH AX *)
a := 0H ;
SETREG( BX , a) ;
CODE( 53H) ; (* PUSH BX *)
SETREG( DX,x + 256 * y) ;
CODE( 5BH ) ; (* POP BX *)
CODE( 58H ) ; (* POP AX *)
CODE( 0CDH,10H) ; (* INT 10H *)
CODE( 5DH ) ; (* POP BP *)
END ;
END ;
END gotoxy ;
PROCEDURE ClearField(VAR String : ARRAY OF CHAR ; Column,Row : CARDINAL) ;
(* This procedure wipes the appropriate field on the screen out *)
BEGIN
gotoxy(Column,Row) ; (* Position Cursor *)
FOR Index := 0 TO HIGH(String) DO
Write(' ') ;
END ; (* FOR *)
gotoxy(Column,Row) ; (* Reposition Cursor *)
END ClearField ;
PROCEDURE Grab(VAR String : ARRAY OF CHAR ; EscFlag : EscType ) ;
(* This procedure assumes that the cursor has already been moved to a position
either by a direct gotoxy call or by a call to ClearField *)
BEGIN
FOR Index := 0 TO HIGH(String) DO
String[Index] := CHR(0) ;
END ; (* FOR *)
Index := 0 ;
LOOP
Read(Ch) ;
IF Ch = EOL THEN EXIT END ;
IF EscFlag = Esc THEN
IF Ch = CHR(27) THEN
String[0] := Ch ;
EXIT ;
END ;
END ;
IF Ch = CHR(8) THEN
IF Index = 0 THEN
Write(CHR(7)) ; (* Honk at Barney *)
ELSE
Write(CHR(8)) ; (* BackSpace *)
Write(CHR(32)) ; (* Space *)
Write(CHR(8)) ; (* BackSpace *)
Index := Index - 1 ;
String[Index] := CHR(0) ;
END ; (* IF *)
ELSIF Ch < CHR(32) THEN
Write(CHR(7)) ; (* Honk at Barney *)
ELSE
IF Index = (HIGH(String) +1) THEN
Write(CHR(7)) ;
ELSE
String[Index] := Ch ;
Write(Ch) ;
Index := Index + 1 ;
END ; (* IF *)
END ; (* IF *)
END ; (* LOOP *)
END Grab ;
END READA .
[LISTIN╟ FOUR]
DEFINITION MODULE MENU ;
EXPORT QUALIFIED MenuType,Menu ;
TYPE MenuType = ARRAY[0..59],[0..79] OF CHAR ;
PROCEDURE Menu(VAR A : MenuType ; NumberOfMenuEntries : CARDINAL) :CARDINAL ;
END MENU.
[LISTING FIVE]
(**************************************************************************
Name: MENU
Purpose: Automatic screen layout, and response error checking for
Pick-a-number menus.
Entry: Menu(VAR A : MenuType ; NumberOfMenuEntries : CARDINAL): CARDINAL ;
Exit: Qualified acceptance of menu item or escape key.
Revision Number:
1.1 10/3/88 Escape key output changed to = 0
1.0 9/26/88
***************************************************************************)
IMPLEMENTATION MODULE MENU ;
FROM READA IMPORT gotoxy, Grab,EscType ;
FROM Strings IMPORT Length ;
FROM NumberConversion IMPORT StringToCard ;
FROM InOut IMPORT WriteString ;
PROCEDURE OneColumn(VAR A : MenuType ; i : CARDINAL) ;
VAR
j,k,l,m : CARDINAL ;
BEGIN
i := i - 1 ; (* Convert from one base to zero based *)
(* First we center the strings to be displayed vertically *)
j := (5 + ((15 - i) DIV 2)) ;
(* Now we center the strings horizontally *)
l := 0 ;
FOR m := 0 TO i DO
k := Length(A[m]) ;
IF (k > l) THEN l := k END ; (* get longest string length *)
END ; (* FOR *)
k := (40 -(l DIV 2)) ;
(* Now print the menu *)
FOR m := 0 TO i DO
gotoxy(k,(j+m)) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
END OneColumn ;
PROCEDURE TwoColumns(VAR A : MenuType ; i : CARDINAL) ;
VAR
j,k,l,m,n,o,p : CARDINAL ;
BEGIN
(* First we center the strings to be displayed vertically *)
i := i - 1 ; (* Convert from one base to zero based *)
n := i DIV 2 ;
j := (5 + ((15 - n) DIV 2)) ;
(* Now we center the strings horizontally *)
l := 0 ;
FOR m := 0 TO n-1 DO
k := Length(A[m]) ;
IF (k > l) THEN l := k END ; (* get longest string length *)
END ; (* FOR *)
k := (20 -(l DIV 2)) ;
(* Now set up the second column centered on position 60 *)
o := 0 ;
FOR m := n TO i DO
p := Length(A[m]) ;
IF (p > o) THEN o := p END ; (* get longest string length *)
END ; (* FOR *)
p := (60 -(o DIV 2)) ;
(* Now print the menu *)
FOR m := 0 TO n-1 DO
gotoxy(k,(j+m)) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
FOR m := n TO i DO
gotoxy(p,(j+m-(n))) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
END TwoColumns ;
PROCEDURE ThreeColumns(VAR A : MenuType ; i : CARDINAL) ;
VAR
j,k,l,m,n,o,p,q,r : CARDINAL ;
BEGIN
(* First we center the strings to be displayed vertically *)
i := i - 1 ; (* Convert from one base to zero based *)
n := i DIV 3 ;
j := i MOD 3 ;
IF j = 2 THEN INC(n) END ;
j := (5 + ((15 - n) DIV 2)) ;
(* Now we center the strings horizontally *)
l := 0 ;
FOR m := 0 TO n-1 DO
k := Length(A[m]) ;
IF (k > l) THEN l := k END ; (* get longest string length *)
END ; (* FOR *)
k := (20 -(l DIV 2)) ;
(* Now set up the second column centered on position 40 *)
o := 0 ;
FOR m := n TO (2*n)-1 DO
p := Length(A[m]) ;
IF (p > o) THEN o := p END ; (* get longest string length *)
END ; (* FOR *)
p := (40 -(o DIV 2)) ;
(* Now set up the third column centered on position 60 *)
q := 0 ;
FOR m := 2*n TO i DO
r := Length(A[m]) ;
IF (r > q) THEN q := r END ; (* get longest string length *)
END ; (* FOR *)
r := (60 -(q DIV 2)) ;
(* Now print the menu *)
FOR m := 0 TO n-1 DO
gotoxy(k,(j+m)) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
FOR m := n TO 2*n-1 DO
gotoxy(p,(j+m-n)) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
FOR m := 2*n TO i DO
gotoxy(r,(j+m-2*n)) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
END ThreeColumns ;
PROCEDURE FourColumns(VAR A : MenuType ; i : CARDINAL) ;
VAR
j,k,l,m,n,o,p,q,r,s,t : CARDINAL ;
BEGIN
(* First we center the strings to be displayed vertically *)
i := i - 1 ; (* Convert from one base to zero based *)
n := i DIV 4 ;
j := i MOD 4 ;
IF j = 3 THEN INC(n) END ;
j := (5 + ((15 - n) DIV 2)) ;
(* Now we center the strings horizontally *)
l := 0 ;
FOR m := 0 TO n-1 DO
k := Length(A[m]) ;
IF (k > l) THEN l := k END ; (* get longest string length *)
END ; (* FOR *)
k := (16 -(l DIV 2)) ;
(* Now set up the second column centered on position 40 *)
o := 0 ;
FOR m := n TO 2*n-1 DO
p := Length(A[m]) ;
IF (p > o) THEN o := p END ; (* get longest string length *)
END ; (* FOR *)
p := (32 -(o DIV 2)) ;
(* Now set up the third column centered on position 60 *)
q := 0 ;
FOR m := 2*n TO 3*n-1 DO
r := Length(A[m]) ;
IF (r > q) THEN q := r END ; (* get longest string length *)
END ; (* FOR *)
r := (48 -(q DIV 2)) ;
s := 0 ;
FOR m := 3*n TO i DO
t := Length(A[m]) ;
IF (t > s) THEN s := t END ; (* get longest string length *)
END ; (* FOR *)
t := (64 -(s DIV 2)) ;
(* Now print the menu *)
FOR m := 0 TO n-1 DO
gotoxy(k,(j+m)) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
FOR m := n TO 2*n-1 DO
gotoxy(p,(j+m-(n))) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
FOR m := 2*n TO 3*n-1 DO
gotoxy(r,(j+m-(2*n))) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
FOR m := 3*n TO i DO
gotoxy(t,(j+m-(3*n))) ; (* Position cursor to string position *)
WriteString(A[m]) ;
END ; (* FOR *)
END FourColumns ;
PROCEDURE Menu(VAR A : MenuType ; NumberOfMenuEntries : CARDINAL): CARDINAL ;
VAR
i,j,k,l : CARDINAL ;
input : ARRAY[0..1] OF CHAR ;
done : BOOLEAN ;
BEGIN
(* 'A' is actually an array of character strings ( an array of array of char)
Menu displays 'A' and waits for up to a two character response with a trailing
carriage return. Menu returns 100 if escape is pressed, otherwise returns
number entered by user as menu response.(0..60).
*)
i := NumberOfMenuEntries ;
IF (i <= 15 ) THEN OneColumn(A,i) END ;
IF ((i > 15) AND (i <= 30)) THEN TwoColumns(A,i) END ;
IF ((i > 30) AND (i <= 45 )) THEN ThreeColumns(A,i) END ;
IF (i > 45) THEN FourColumns(A,i) END ;
(* Allow a maximum of 15 items per column on displayed menu.*)
LOOP
gotoxy(5,24) ;
WriteString('Enter the number of your selection and press Enter key: ') ;
WriteString(CHR(08)) ;
WriteString(CHR(08)) ;
Grab(input,Esc) ;
(* If Esc is pressed instead of a number exit with an impossible value *)
IF (input[0] = CHR(27)) THEN RETURN 0 END ;
StringToCard(input,j,done) ;
(* Return only legal values of input *)
IF done THEN
IF (j > 0) AND ( j <=i) THEN RETURN j END ;
END ; (* IF *)
END ; (* LOOP *)
END Menu ;
END MENU .