10 ! *******************************************************************
20 ! Example: Menu System
30 !
40 ! This program demonstrates how to build a pulldown menu system.
50 ! It builds a panel with a menu and a printer widget to tell you
60 ! the menu entry you clicked.
70 !
80 ! ********************************************************************
90 !
100 INTEGER Black,White,Red,Yellow,Green,Blue,Cyan,Magenta
110 DATA 0,1,2,3,4,5,6,7
120 READ Black,White,Red,Yellow,Green,Blue,Cyan,Magenta
130 !
140 ! Define some variables:
150 !
160 ! S$: General-purpose string variable
170 ! M$(*): System menu elements
180 ! State: Gets state of MENU TOGGLE widgets
190 ! N: General-purpose INTEGER variable
200 ! D(*): Array to get hard-clip values
210 ! Dw,Dh: Display dimensions
220 ! X,Y: Location of main PANEL
230 ! Panelwidth, Panelheight: Dimensions for main PANEL
240 ! Prx,Pry,Prwidth,Prheight: Location & dimensions of main PANEL
250 ! Ih,Iw: Interior dimensions of PANEL
260 !
270 ! The main panel is set up so it automatically scales to the
280 ! entire display, except for the DISP, INPUT, and softkeys lines.
290 !
300 DIM S$[80],M$(0:2)[80]
310 INTEGER State,N,D(1:4)
320 INTEGER Dw,Dh,X,Y
330 INTEGER Panelwidth,Panelheight,Prx,Pry,Prwidth,Prheight,Iw,Ih
340 !
350 GESCAPE CRT,3;D(*)
360 Dw=D(3)-D(1)+1
370 Dh=D(4)-D(2)+1
380 Panelwidth=Dw*.75
390 Panelheight=Dh*.75
400 X=(Dw-Panelwidth)/2
410 Y=(Dh-Panelheight)/2
420 !
430 ! Create the PANEL widget
440 !
450 CLEAR SCREEN
460 ASSIGN @P TO WIDGET "PANEL";SET ("VISIBLE":0)
470 CONTROL @P;SET ("RESIZABLE":1)
480 CONTROL @P;SET ("X":X,"Y":Y,"WIDTH":Panelwidth,"HEIGHT":Panelheight)
490 CONTROL @P;SET ("TITLE":" Example: Menu System")
500 CONTROL @P;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
510 !
520 ! Create the PULLDOWN MENU widgets, using the PANEL widget as parent
530 !
540 S$="PullDown_1"
550 ASSIGN @Pd1 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
560 !
570 S$="PullDown_2"
580 ASSIGN @Pd2 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
590 !
600 S$="PullDown_3"
610 ASSIGN @Pd3 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
620 !
630 ! Now that the PULLDOWN MENU has been set up, get interior dimensions
640 ! of PANEL and set up PRINTER widget accordingly.
650 !
660 STATUS @P;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
670 Prx=Iw*.02
680 Pry=Ih*.02
690 Prwidth=Iw*.96
700 Prheight=Ih*.96
710 ASSIGN @Prn TO WIDGET "PRINTER";PARENT @P
720 CONTROL @Prn;SET ("X":Prx,"Y":Pry,"WIDTH":Prwidth,"HEIGHT":Prheight)
730 !
740 ! Create menu for "PullDown_2" (using @Pd2 as PARENT)
750 !
760 S$="Button_1"
770 ASSIGN @B21 TO WIDGET "MENU BUTTON";PARENT @Pd2,SET ("LABEL":S$)
780 !
790 S$="Button_2"
800 ASSIGN @B22 TO WIDGET "MENU BUTTON";PARENT @Pd2,SET ("LABEL":S$)
810 !
820 ! Create menu for "PullDown_3" (using @Pd3 as PARENT)
830 !
840 S$="Button_1"
850 ASSIGN @B31 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
860 !
870 S$="Button_2"
880 ASSIGN @B32 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
890 !
900 S$="Button_3"
910 ASSIGN @B33 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
920 !
930 ASSIGN @S34 TO WIDGET "MENU SEPARATOR";PARENT @Pd3
940 !
950 S$="Quit"
960 ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
970 !
980 ! Create menu for "PullDown_1" (using @Pd1 as PARENT)
990 !
1000 S$="Button_1"
1010 ASSIGN @B11 TO WIDGET "MENU BUTTON";PARENT @Pd1,SET ("LABEL":S$)
1020 !
1030 ! Add menu separator
1040 !
1050 ASSIGN @S12 TO WIDGET "MENU SEPARATOR";PARENT @Pd1
1060 !
1070 ! Add CASCADE MENU widgets to "PullDown_1" (using @Pd1 as PARENT)
1080 !
1090 S$="Cascade_1"
1100 ASSIGN @C13 TO WIDGET "CASCADE MENU";PARENT @Pd1,SET ("LABEL":S$)
1110 !
1120 S$="Cascade_2"
1130 ASSIGN @C14 TO WIDGET "CASCADE MENU";PARENT @Pd1,SET ("LABEL":S$)
1140 !
1150 ! Create menu for "Cascade_1" (using @C1 as PARENT)
1160 !
1170 S$="Item_1"
1180 ASSIGN @B131 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
1190 !
1200 S$="Item_2"
1210 ASSIGN @B132 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
1220 !
1230 S$="Item_3"
1240 ASSIGN @B133 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
1250 !
1260 ! Create menu for "Cascade_2" (using @C14 as PARENT)
1270 !
1280 S$="Toggle_1"
1290 ASSIGN @T141 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
1300 !
1310 S$="Toggle_2"
1320 ASSIGN @T142 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
1330 !
1340 S$="Toggle_3"
1350 ASSIGN @T143 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
1360 !
1370 ! Add "Cascade_3" as entry in "Cascade_2"
1380 !
1390 S$="Cascade_3"
1400 ASSIGN @C144 TO WIDGET "CASCADE MENU";PARENT @C14,SET ("LABEL":S$)
1410 !
1420 ! Populate menu for "Cascade_3"
1430 !
1440 S$="Toggle_1"
1450 ASSIGN @T1441 TO WIDGET "MENU TOGGLE";PARENT @C144,SET ("LABEL":S$)
1460 !
1470 S$="Button_1"
1480 ASSIGN @B1442 TO WIDGET "MENU BUTTON";PARENT @C144,SET ("LABEL":S$)
1490 !
1500 ! Create SYSTEM MENU
1510 !
1520 M$(0)="SysMenu1"
1530 M$(1)="SysMenu2"
1540 M$(2)="SysMenu3"
1550 CONTROL @P;SET ("SYSTEM MENU":M$(*))
1560 !
1570 CONTROL @P;SET ("VISIBLE":1)
1580 !
1590 ! Set up menu events
1600 !
1610 ON EVENT @B11,"ACTIVATED" GOSUB Button11
1620 ON EVENT @B21,"ACTIVATED" GOSUB Button21
1630 ON EVENT @B22,"ACTIVATED" GOSUB Button22
1640 ON EVENT @B31,"ACTIVATED" GOSUB Button31
1650 ON EVENT @B32,"ACTIVATED" GOSUB Button32
1660 ON EVENT @B33,"ACTIVATED" GOSUB Button33
1670 ON EVENT @B131,"ACTIVATED" GOSUB Button131
1680 ON EVENT @B132,"ACTIVATED" GOSUB Button132
1690 ON EVENT @B133,"ACTIVATED" GOSUB Button133
1700 ON EVENT @T141,"CHANGED" GOSUB Toggle141
1710 ON EVENT @T142,"CHANGED" GOSUB Toggle142
1720 ON EVENT @T143,"CHANGED" GOSUB Toggle143
1730 ON EVENT @T1441,"CHANGED" GOSUB Toggle1441
1740 ON EVENT @B1442,"ACTIVATED" GOSUB Button1442
1750 !
1760 ON EVENT @P,"SYSTEM MENU" GOSUB Sysmenu
1770 ON EVENT @Quit,"ACTIVATED" GOTO Finis
1780 !
1790 LOOP
1800 WAIT FOR EVENT
1810 END LOOP
1820 STOP
1830 !
1840 ! *************** End of Main Program **************************
1850 !
1860 ! The following routines are handlers for the various menu buttons.
1870 ! They print the menu item description to the PRINTER widget.
1880 !
1890 Button11: !
1900 S$="PullDown_1 / Button_1"
1910 CONTROL @Prn;SET ("APPEND TEXT":S$)
1920 RETURN
1930 !
1940 Button21: !
1950 S$="PullDown_2 / Button_1"
1960 CONTROL @Prn;SET ("APPEND TEXT":S$)
1970 RETURN
1980 !
1990 Button22: !
2000 S$="PullDown_2 / Button_2"
2010 CONTROL @Prn;SET ("APPEND TEXT":S$)
2020 RETURN
2030 !
2040 Button31: !
2050 S$="PullDown_3 / Button_1"
2060 CONTROL @Prn;SET ("APPEND TEXT":S$)
2070 RETURN
2080 !
2090 Button32: !
2100 S$="PullDown_3 / Button_2"
2110 CONTROL @Prn;SET ("APPEND TEXT":S$)
2120 RETURN
2130 !
2140 Button33: !
2150 S$="PullDown_3 / Button_3"
2160 CONTROL @Prn;SET ("APPEND TEXT":S$)
2170 RETURN
2180 !
2190 Button131: !
2200 S$="PullDown_1 / Cascade_1 / Item_1"
2210 CONTROL @Prn;SET ("APPEND TEXT":S$)
2220 RETURN
2230 !
2240 Button132: !
2250 S$="PullDown_1 / Cascade_1 / Item_2"
2260 CONTROL @Prn;SET ("APPEND TEXT":S$)
2270 RETURN
2280 !
2290 Button133: !
2300 S$="PullDown_1 / Cascade_1 / Item_3"
2310 CONTROL @Prn;SET ("APPEND TEXT":S$)
2320 RETURN
2330 !
2340 Toggle141: !
2350 S$="PullDown_1 / Cascade_2 / Toggle_1: "
2360 STATUS @T141;RETURN ("VALUE":State)
2370 CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
2380 RETURN
2390 !
2400 Toggle142: !
2410 S$="PullDown_1 / Cascade_2 / Toggle_2: "
2420 STATUS @T142;RETURN ("VALUE":State)
2430 CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
2440 RETURN
2450 !
2460 Toggle143: !
2470 S$="PullDown_1 / Cascade_2 / Toggle_3: "
2480 STATUS @T143;RETURN ("VALUE":State)
2490 CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
2500 RETURN
2510 !
2520 Toggle1441: !
2530 S$="PullDown_1 / Cascade_2 / Cascade_3 / Toggle_1: "
2540 STATUS @T1441;RETURN ("VALUE":State)
2550 CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
2560 RETURN
2570 !
2580 Button1442: !
2590 S$="PullDown_1 / Cascade_2 / Cascade_3 / Button_1"
2600 CONTROL @Prn;SET ("APPEND TEXT":S$)
2610 RETURN
2620 !
2630 Sysmenu: !
2640 STATUS @P;RETURN ("SYSTEM MENU EVENT":N)
2650 S$="SYSTEM MENU / SysMenu"&VAL$(N+1)
2660 CONTROL @Prn;SET ("APPEND TEXT":S$)
2670 RETURN
2680 !
2690 Finis: !
2700 ASSIGN @P TO * ! Delete PANEL widget
2710 END
