10 ! *********************************************************************
20 ! Example: Passwords
30 !
40 ! This program demonstrates the operation of the STRING input widget
50 ! by creating a password panel that prompts the user for a name and
60 ! password. The program asks you for a name and password before it
70 ! brings up the panel.
80 !
90 ! ************************************************************
100 !
110 CLEAR SCREEN
120 OPTION BASE 1
130 !
140 ! Goodname is a flag that says a valid name has been obtained and
150 ! a password should be input. Done indicates a valid name and
160 ! password have been input.
170 !
180 INTEGER Goodname,Done
190 Goodname=0
200 Done=0
210 !
220 ! Strings Used:
230 !
240 ! Name$: Stores user name for matching later
250 ! Pass$: Stores user password for matching later
260 ! Inval$: Input value from STRING widgets
270 ! B$: General-purpose buffer
280 !
290 DIM Name$[80],Pass$[80],Inval$[80],B$[80]
300 !
310 ! Get name and password
320 !
330 INPUT "Please Input Your Name:",Name$
340 INPUT "Please Input a Password:",Pass$
350 !
360 DISP "Building Panel, Please Wait"
370 !
380 ! Define colors
390 !
400 INTEGER Black,White,Red,Blue
410 Black=0
420 White=1
430 Red=2
440 Blue=6
450 !
460 ! Get display dimensions
470 !
480 INTEGER A(6),Nlines
490 REAL Dw,Dh,Vh
500 GESCAPE CRT,3;A(*) ! Get screen size
510 Dw=A(3)-A(1)+1
520 Dh=A(4)-A(2)+1
530 STATUS CRT,13;Nlines ! Get number of lines of text on display
540 Vh=Dh*(1-6/Nlines) ! Height of display above DISP line
550 !
560 REAL Px,Py,Pw,Ph,Ih,Iw
570 Pw=330 ! Main PANEL width
580 Ph=260 ! Main PANEL height
590 Px=(Dw-Pw)/2 ! Center PANEL along width
600 Py=(Vh-Ph)/2 ! Place above DISP line
610 !
620 ! Build main PANEL
630 !
640 ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0) ! Make invisible
650 CONTROL @Main;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
660 CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
670 CONTROL @Main;SET ("TITLE":" Example: Passwords")
680 CONTROL @Main;SET ("SYSTEM MENU":"Quit")
690 ON EVENT @Main,"SYSTEM MENU" GOTO Finis
700 !
710 ! Get inside dimensions of PANEL
720 !
730 STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
740 !
750 ! Set up dimensions for widgets
760 !
770 REAL Gapw,Gaph,Wh,Ww1,Ww2
780 REAL R1,R2,R3,R4,R5,C1,C2
790 !
800 ! Set dimensions for interior widgets
810 !
820 Gapw=Iw*.02 ! Horizontal gap
830 Gaph=Ih*.02 ! Vertical gap
840 !
850 Wh=Ih*.16 ! Height of all child widgets
860 Ww1=Iw*.70 ! Width of STRING widgets and their LABELs
870 Ww2=Iw-Gapw*2 ! Width of prompt LABEL
880 !
890 R1=Gaph ! Row position of LABEL for name-input STRING
900 R2=R1+Wh ! Row position of name-input STRING
910 R3=R2+Wh+Gaph ! Row position of LABEL for password-input STRING
920 R4=R3+Wh ! Row position of password-input STRING
930 R5=R4+Wh ! Bottom of password-input STRING
940 R6=((Ih-R5)-Wh)/2+R5 ! Row of prompt LABEL (centered at bottom)
950 !
960 C1=(Iw-Ww2)/2 ! Column position of prompt LABEL
970 C2=(Iw-Ww1)/2 ! Column position of STRINGs and their LABELs
980 !
990 ! Create LABEL for name-input STRING (no border, blends with PANEL)
1000 !
1010 ASSIGN @Lbl1 TO WIDGET "LABEL";PARENT @Main
1020 CONTROL @Lbl1;SET ("X":C2,"Y":R1,"WIDTH":Ww1,"HEIGHT":Wh)
1030 CONTROL @Lbl1;SET ("BORDER":0)
1040 CONTROL @Lbl1;SET ("FONT":"8 BY 16,BOLD")
1050 CONTROL @Lbl1;SET ("VALUE":" Enter your name:")
1060 !
1070 ! Create name-input STRING
1080 !
1090 ASSIGN @Str1 TO WIDGET "STRING";PARENT @Main
1100 CONTROL @Str1;SET ("X":C2,"Y":R2,"WIDTH":Ww1,"HEIGHT":Wh)
1110 CONTROL @Str1;SET ("BACKGROUND":Black,"PEN":Red)
1120 CONTROL @Str1;SET ("FONT":"8 BY 16")
1130 CONTROL @Str1;SET ("VALUE":"")
1140 !
1150 ! Create LABEL for password-input STRING
1160 !
1170 ASSIGN @Lbl2 TO WIDGET "LABEL";PARENT @Main
1180 CONTROL @Lbl2;SET ("X":C2,"Y":R3,"WIDTH":Ww1,"HEIGHT":Wh)
1190 CONTROL @Lbl2;SET ("BORDER":0)
1200 CONTROL @Lbl2;SET ("FONT":"8 BY 16,BOLD")
1210 CONTROL @Lbl2;SET ("VALUE":" Enter your password:")
1220 !
1230 ! Create STRING for password-input STRING. Both the background
1240 ! and font are black so the user cannot see what is typed in.
1250 ! A font type is not set, since it cannot be seen.
1260 !
1270 ASSIGN @Str2 TO WIDGET "STRING";PARENT @Main
1280 CONTROL @Str2;SET ("X":C2,"Y":R4,"WIDTH":Ww1,"HEIGHT":Wh)
1290 CONTROL @Str2;SET ("BACKGROUND":Black,"PEN":Red,"PASSWORD CHARACTER":"*")
1300 CONTROL @Str2;SET ("VALUE":"")
1310 !
1320 ! Create prompt LABEL
1330 !
1340 ASSIGN @Lbl3 TO WIDGET "LABEL";PARENT @Main
1350 CONTROL @Lbl3;SET ("X":C1,"Y":R6,"WIDTH":Ww2,"HEIGHT":Wh)
1360 CONTROL @Lbl3;SET ("FONT":"7 BY 14")
1370 CONTROL @Lbl3;SET ("BACKGROUND":Blue,"PEN":White)
1380 GOSUB Setprompt
1390 !
1400 ! Set up events. EVENTS are set up on the password STRING for both
1410 ! each KEYSTROKE and when Return is pressed, allowing a handler
1420 ! routine to generate a BEEP every time a key is pressed (for
1430 ! feedback, since you cannot see what you are typing) and allowing
1440 ! another handler routine to take the entire password when Return
1450 ! is pressed.
1460 !
1470 ON EVENT @Str1,"RETURN" GOSUB Getname
1480 ON EVENT @Str2,"RETURN" GOSUB Getpass
1490 !
1500 CLEAR SCREEN
1510 CONTROL @Main;SET ("VISIBLE":1)
1520 !
1530 ! Main loop, wait for event
1540 !
1550 LOOP
1560 IF Done=1 THEN Finis
1570 END LOOP
1580 !
1590 ! *********** End of Main Program *******************
1600 !
1610 ! This routine puts the standard prompt
1620 ! in the prompt LABEL
1630 !
1640 Setprompt: !
1650 B$="Please enter name, then password."
1660 GOSUB Setlabel
1670 RETURN
1680 !
1690 ! This routine puts a string passed to it through B$ in the
1700 ! prompt LABEL
1710 !
1720 Setlabel: !
1730 CONTROL @Lbl3;SET ("VALUE":B$)
1740 RETURN
1750 !
1760 ! This routine is invoked when Enter is pressed after inputting a
1770 ! name in the name-input STRING. First, it tests to see if a name
1780 ! has already been input. If so, it outputs a message and exits.
1790 !
1800 ! Otherwise, it checks the input value for a match with the password.
1810 ! If it does not match, it gives a warning message and sets Goodname
1820 ! to 0.
1830 !
1840 ! If it does match, it changes the prompt to ask for a password only.
1850 ! In either case, it clears the STRING.
1860 !
1870 Getname: !
1880 DISABLE
1890 STATUS @Str1;RETURN ("VALUE":Inval$)
1900 IF Goodname=1 THEN
1910 BEEP 2000,.01
1920 B$="Please enter password"
1930 GOSUB Setlabel
1940 ELSE
1950 IF Inval$<>Name$ THEN
1960 BEEP 2000,.1
1970 B$="Invalid name"
1980 GOSUB Setlabel
1990 GOSUB Setprompt
2000 Goodname=0
2010 ELSE
2020 B$="Name accepted, please enter password."
2030 GOSUB Setlabel
2040 Goodname=1
2050 END IF
2060 END IF
2070 CONTROL @Str1;SET ("VALUE":"")
2080 ENABLE
2090 RETURN
2100 !
2110 ! This routine checks for a valid password. First, it checks
2120 ! to see if the user has provided a valid name. If not, it beeps
2130 ! and tells the user to input a valid name.
2140 !
2150 ! Otherwise, it tries to match the input string against the password.
2160 ! If no match, it tells the user and returns. If it matches, it also
2170 ! tells the user and sets a flag to tell the main routine it is done.
2180 !
2190 Getpass: !
2200 DISABLE
2210 IF Goodname=0 THEN
2220 BEEP 2000,.01
2230 B$="Please input your name first."
2240 GOSUB Setlabel
2250 WAIT 2
2260 GOSUB Setprompt
2270 ELSE
2280 STATUS @Str2;RETURN ("VALUE":Inval$)
2290 IF Inval$<>Pass$ THEN
2300 BEEP 2000,.01
2310 B$="Invalid password, try again."
2320 GOSUB Setlabel
2330 CONTROL @Str2;SET ("VALUE":"")
2340 ELSE
2350 B$="Welcome to the club!"
2360 GOSUB Setlabel
2370 WAIT 10
2380 Done=1
2390 END IF
2400 END IF
2410 ENABLE
2420 RETURN
2430 !
2440 Finis: !
2450 ASSIGN @Panel TO * ! Delete PANEL widget
2460 END
