10 ! *********************************************************************
20 ! Example: Ice Cream Sundae
30 !
40 ! This program is an example of the use of the LIST widget.
50 ! It displays a panel that contains two LIST widgets -- one in which
60 ! the MULTISELECT attribute is not set, and another in which the
70 ! MULTISELECT attribute is set.
80 !
90 ! If MULTISELECT is not set (0), only one element can be selected
100 ! from the widget. If you click on a LIST widget in that mode and then
110 ! read it, you will get the number of the entry into the LIST.
120 !
130 ! If MULTISELECT is set (1), several elements can be selected from
140 ! the widget. You give the widget an array of a size that matches the
150 ! number of elements in the LIST. When you click on the LIST entries,
160 ! as they are selected their corresponding array entries are set to 1.
170 ! The unselected array entries are set to 0. (If you click again on a
180 ! selected entry, its array value is cleared back to 0.)
190 !
200 ! The MULTISELECT:0 LIST allows you to select a flavor of ice cream
210 ! while the MULTISELECT:1 LIST allows you to select all the toppings
220 ! you like. When you are done, you press the "GIMME!" button to get
230 ! your selection. (Actually, all you get when you press the button is
240 ! an INFORMATION DIALOG that tells you you are out of luck.)
250 !
260 ! *********************************************************************
270 !
280 CLEAR SCREEN
290 OPTION BASE 1
300 !
310 ! Set color values:
320 !
330 INTEGER Black,White,Red,Yellow,Green,Blue,Magenta
340 Black=0
350 White=1
360 Red=2
370 Yellow=3
380 Green=4
390 Blue=6
400 Magenta=7
410 !
420 ! Some variables:
430 !
440 ! Buffer$: Used to display values from MULTISELECT:1 list
450 ! Select(*): Gets status of selections from MULTISELECT list
460 ! A(*): Gets values from GESCAPE statement to find display size.
470 ! Nlines: Gets number of lines of text on display
480 ! N: General-purpose variable
490 !
500 DIM Buffer$[32]
510 INTEGER Select(9),A(6),Nlines,N
520 !
530 ! Get display resolution
540 !
550 REAL Dw,Dh,Vh
560 GESCAPE CRT,3;A(*)
570 Dw=A(3)-A(1)+1
580 Dh=A(4)-A(2)+1
590 STATUS CRT,13;Nlines
600 Vh=Dh*(1-6/Nlines)
610 !
620 ! Set up dimensions and location for main panel
630 !
640 REAL Pw,Ph,Px,Py,Iw,Ih
650 Pw=340
660 Ph=310
670 Px=(Dw-Pw)/2
680 Py=(Vh-Ph)/2
690 !
700 ! Set up the main panel
710 !
720 ASSIGN @P TO WIDGET "PANEL";SET ("VISIBLE":0)
730 CONTROL @P;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
740 CONTROL @P;SET ("TITLE":" Coyote's Ice Cream Emporium")
750 CONTROL @P;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
760 STATUS @P;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
770 !
780 ! The panel contains the two list widgets, with a title
790 ! LABEL and a value LABEL for both. There are also two
800 ! PUSHBUTTONs, one to "GIMME" your ice cream, and another
810 ! to exit the program. The following variables assign
820 ! assign sizes to these widgets and their locations in
830 ! the panel.
840 !
850 ! These assignments are arranged interdependently, so if
860 ! you change one the others are adjusted automatically.
870 !
880 REAL Gaph,Btnw,Lblh,Listw,Listh,C1,C2,R1,R2,R3,R4,R5
890 !
900 Gaph=Ih*.02 ! Vertical gap
910 Listw=Iw*.44 ! Width of LISTS (and corresponding LABELs)
920 Listh=Ih*.6 ! Height of LIST widgets
930 Btnw=Iw*.2 ! Width of the two buttons
940 Lblh=Ih*.1 ! Height of the four labels
950 !
960 C1=(Iw/2-Listw)/2 ! Column 1 is the location for the MULTISELECT:0 LIST
970 C2=(Iw/4)-Btnw/2 ! Column 2 is the location for the GIMME button
980 C3=Iw/2+C1 ! Column 3 is the location for the MULTISELECT:1 widget
990 C4=Iw/2+C2 ! Column 4 is the location of the EXIT button
1000 !
1010 R1=Gaph ! Row 1 is the location for the title LABELs
1020 R2=R1+Lblh+Gaph ! Row 2 is the location for the LIST widgets
1030 R3=R2+Listh+Gaph ! Row 3 is the location of the value LABELs
1040 R4=R3+Lblh ! Row 4 is the bottom of the value LABELs
1050 R5=R4+((Ih-R4)-Lblh)/2 ! Row 5 is location of the buttons
1060 !
1070 DIM Menu$(9)[20],Topping$(9)[20] ! Entry arrays for LIST widgets
1080 !
1090 ! Entry array for MULTISELECT:0 widget
1100 !
1110 Menu$(1)=" VANILLA"
1120 Menu$(2)=" CHOCOLATE"
1130 Menu$(3)=" STRAWBERRY"
1140 Menu$(4)=" NEAPOLITAN"
1150 Menu$(5)=" FUDGE RIPPLE"
1160 Menu$(6)=" HEATH BAR"
1170 Menu$(7)=" BUTTERFINGER"
1180 Menu$(8)=" MOCHA"
1190 Menu$(9)=" PEPPERMINT"
1200 !
1210 ! Entry array for MULTISELECT:1 widget
1220 !
1230 Topping$(1)=" NUTS"
1240 Topping$(2)=" BANANAS"
1250 Topping$(3)=" CHOCOLATE"
1260 Topping$(4)=" HOT FUDGE"
1270 Topping$(5)=" STRAWBERRIES"
1280 Topping$(6)=" WHIPPED CREAM"
1290 Topping$(7)=" SPRINKLES"
1300 Topping$(8)=" CHERRY"
1310 Topping$(9)=" BUTTERSCOTCH"
1320 !
1330 ! The following variables provide attributes for
1340 ! the INFORMATION dialog. Since you must declare
1350 ! everything for a dialog in the statement that
1360 ! creates it, it is convenient to define attributes
1370 ! by putting the attribute names in a string array
1380 ! and the values in a matching array. You can then
1390 ! use the arrays to set up the values in a dialog
1400 ! declaration without having to put everything on
1410 ! one line.
1420 !
1430 ! One thing to remember is that you can match your
1440 ! attribute array to a numeric or string value array -
1450 ! but you CANNOT mix the types in the value array.
1460 ! So, if you want to set attributes with numeric or
1470 ! string values, you must segregate the attributes
1480 ! into separate attribute arrays and then use them
1490 ! attribute arrays and then use them with the
1500 ! appropriate value arrays.
1510 !
1520 ! Since all the attributes but one invoked with the
1530 ! DIALOG command have numeric values, only one array
1540 ! is set up. (A font is set as well, but that is
1550 ! done in the DIALOG invocation itself.)
1560 !
1570 ! The X and Y origin of the DIALOG is relative to the
1580 ! 0,0 coordinate of the display, NOT to the parent
1590 ! widget. Declaring a dialog box with a parent has
1600 ! the effect that a user will not be able to click
1610 ! the parent widget back over the top of the DIALOG.
1620 !
1630 DIM Ds$(6)[12],Pr$[32],F$[16]
1640 DIM Dv(6)
1650 !
1660 Ds$(1)="WIDTH"
1670 Dv(1)=Pw*.75
1680 Ds$(2)="HEIGHT"
1690 Dv(2)=Ph*.65
1700 Ds$(3)="X"
1710 Dv(3)=Px+(Pw-Dv(1))/2
1720 Ds$(4)="Y"
1730 Dv(4)=Py+(Ph-Dv(2))/2
1740 Ds$(5)="BACKGROUND"
1750 Dv(5)=Blue
1760 Ds$(6)="PEN"
1770 Dv(6)=White
1780 Pr$="Sorry, all out!"
1790 F$="12 BY 14,BOLD"
1800 !
1810 ! Set up the label for the MULTISELECT:0 LIST. The border is
1820 ! turned off on the LABELs, so they will not look like buttons.
1830 !
1840 ASSIGN @Lbl1 TO WIDGET "LABEL";PARENT @P
1850 CONTROL @Lbl1;SET ("X":C1,"Y":R1,"WIDTH":Listw,"HEIGHT":Lblh)
1860 CONTROL @Lbl1;SET ("BACKGROUND":White,"PEN":Black)
1870 CONTROL @Lbl1;SET ("BORDER":0)
1880 CONTROL @Lbl1;SET ("FONT":"14 BY 14,BOLD")
1890 CONTROL @Lbl1;SET ("VALUE":"PICK YOUR FLAVOR:")
1900 !
1910 ! Set up the MULTISELECT:0 LIST
1920 !
1930 ASSIGN @L1 TO WIDGET "LIST";PARENT @P
1940 CONTROL @L1;SET ("FONT":"10 BY 16,BOLD")
1950 CONTROL @L1;SET ("X":C1,"Y":R2,"WIDTH":Listw,"HEIGHT":Listh)
1960 CONTROL @L1;SET ("BACKGROUND":White,"PEN":Blue)
1970 CONTROL @L1;SET ("ITEMS":Menu$(*))
1980 !
1990 ! Set up the MULTISELECT:0 value LABEL
2000 !
2010 ASSIGN @Lbl2 TO WIDGET "LABEL";PARENT @P
2020 CONTROL @Lbl2;SET ("X":C1,"Y":R3,"WIDTH":Listw,"HEIGHT":Lblh)
2030 CONTROL @Lbl2;SET ("BACKGROUND":White,"PEN":Blue)
2040 CONTROL @Lbl2;SET ("BORDER":0)
2050 CONTROL @Lbl2;SET ("FONT":"10 BY 16,BOLD")
2060 CONTROL @Lbl2;SET ("VALUE":"")
2070 !
2080 ! Set up the MULTISELECT:1 title LABEL
2090 !
2100 ASSIGN @Lbl3 TO WIDGET "LABEL";PARENT @P
2110 CONTROL @Lbl3;SET ("X":C3,"Y":R1,"WIDTH":Listw,"HEIGHT":Lblh)
2120 CONTROL @Lbl3;SET ("BACKGROUND":White,"PEN":Black)
2130 CONTROL @Lbl3;SET ("BORDER":0)
2140 CONTROL @Lbl3;SET ("FONT":"14 BY 14,BOLD")
2150 CONTROL @Lbl3;SET ("VALUE":"SELECT YOUR TOPPINGS:")
2160 !
2170 ! Set up the MULTISELECT:1 LIST
2180 !
2190 ASSIGN @L2 TO WIDGET "LIST";PARENT @P
2200 CONTROL @L2;SET ("FONT":"10 BY 16,BOLD")
2210 CONTROL @L2;SET ("X":C3,"Y":R2,"WIDTH":Listw,"HEIGHT":Listh)
2220 CONTROL @L2;SET ("BACKGROUND":White,"PEN":Blue)
2230 CONTROL @L2;SET ("ITEMS":Topping$(*))
2240 CONTROL @L2;SET ("MULTISELECT":1)
2250 !
2260 ! Set up the MULTISELECT:1 value LABEL
2270 !
2280 ASSIGN @Lbl4 TO WIDGET "LABEL";PARENT @P
2290 CONTROL @Lbl4;SET ("X":C3,"Y":R3,"WIDTH":Listw,"HEIGHT":Lblh)
2300 CONTROL @Lbl4;SET ("BACKGROUND":White,"PEN":Blue)
2310 CONTROL @Lbl4;SET ("BORDER":0)
2320 CONTROL @Lbl4;SET ("FONT":"10 BY 16, BOLD")
2330 CONTROL @Lbl4;SET ("VALUE":"0 0 0 0 0 0 0 0 0")
2340 !
2350 ! Set up the GIMME button
2360 !
2370 ASSIGN @B1 TO WIDGET "PUSHBUTTON";PARENT @P
2380 CONTROL @B1;SET ("X":C2,"Y":R5,"WIDTH":Btnw,"HEIGHT":Lblh)
2390 CONTROL @B1;SET ("BACKGROUND":Red,"PEN":Black)
2400 CONTROL @B1;SET ("FONT":"10 BY 12")
2410 CONTROL @B1;SET ("LABEL":"GIMME!")
2420 !
2430 ! Set up the EXIT button
2440 !
2450 ASSIGN @B2 TO WIDGET "PUSHBUTTON";PARENT @P
2460 CONTROL @B2;SET ("X":C4,"Y":R5,"WIDTH":Btnw,"HEIGHT":Lblh)
2470 CONTROL @B2;SET ("BACKGROUND":Green,"PEN":Black)
2480 CONTROL @B2;SET ("FONT":"10 BY 12")
2490 CONTROL @B2;SET ("LABEL":"EXIT")
2500 !
2510 ! Turn on the panel and show the widgets
2520 !
2530 CLEAR SCREEN
2540 CONTROL @P;SET ("VISIBLE":1)
2550 !
2560 ! Set events and wait for an event to happen
2570 !
2580 ON EVENT @L1,"SELECTION" GOSUB Onesel ! MULTISELECT:0 LIST select
2590 ON EVENT @L2,"SELECTION" GOSUB Multisel ! MULTISELECT:1 LIST select
2600 ON EVENT @B1,"ACTIVATED" GOSUB Icecream ! Click on GIMME button
2610 ON EVENT @B2,"ACTIVATED" GOTO Finis ! Click on EXIT button
2620 !
2630 LOOP
2640 WAIT FOR EVENT
2650 END LOOP
2660 !
2670 ! ********** End of Main Program **************************
2680 !
2690 ! This routine handles a mouse click on the MULTISELECT:0 LIST.
2700 ! list. This routine gets the SELECTION value from the LIST
2710 ! widget and then puts it into the corresponding value LABEL.
2720 !
2730 ! The SELECTION value is the index into the entry array. The
2740 ! index assumes a base array index of 0 even if OPTION BASE 1
2750 ! is set (as it is in this program). This means that if you
2760 ! selected the entry corresponding to array element 1, you
2770 ! would get a value back of 0.
2780 !
2790 Onesel:!
2800 STATUS @L1;RETURN ("SELECTION":N)
2810 CONTROL @Lbl2;SET ("VALUE":N)
2820 RETURN
2830 !
2840 ! This is the handler routine for the MULTISELECT:1 LIST.
2850 ! This routine gets the SELECTION array and then lists ALL
2860 ! the values in the array in the corresponding LABEL.
2870 ! The array entry will be 1 for a selected entry, and 0
2880 ! for an unselected entry.
2890 !
2900 Multisel:!
2910 STATUS @L2;RETURN ("SELECTION":Select(*))
2920 Buffer$=""
2930 FOR N=1 TO 9
2940 Buffer$=Buffer$&VAL$(Select(N))&" "
2950 NEXT N
2960 CONTROL @Lbl4;SET ("VALUE":Buffer$)
2970 RETURN
2980 !
2990 ! This is the handler for the GIMME button. It displays a
3000 ! a DIALOG and tells the user that he or she is out of luck.
3010 ! (It is for display only and for an example of using a
3020 ! DIALOG box.) A timeout is set so that the DIALOG
3030 ! disappears after 5 seconds if the user does nothing.
3040 !
3050 Icecream: !
3060 BEEP 10000,.01
3070 DIALOG "INFORMATION",Pr$;SET (Ds$(*):Dv(*),"FONT":F$),TIMEOUT 5
3080 RETURN
3090 !
3100 ! This code closes the main panel, clears the screen, and displays "DONE"
3110 !
3120 Finis:!
3130 ASSIGN @P TO * ! Closes widget
3140 CLEAR SCREEN
3150 DISP "DONE"
3160 END
|