10 ! *********************************************************************
20 ! Example: SLIDER Test
30 !
40 ! This program consists of a SLIDER and a LABEL in a PANEL with
50 ! a pulldown menu system. You set the SLIDER to a value, and the
60 ! LABEL shows the value.
70 !
80 ! ******************************************************************
90 !
100 ! Define colors
110 !
120 INTEGER Black,White,Red,Yellow,Green,Cyan,Blue,Magenta
130 DATA 0,1,2,3,4,5,6,7
140 READ Black,White,Red,Yellow,Green,Cyan,Blue,Magenta
150 !
160 ! Log and Direct are flags for LOGARITHMIC and DIRECT MOVE mode
170 ! settings. V is the value returned from the SLIDER.
180 !
190 INTEGER Log,Direct
200 REAL V
210 !
220 ! Variables for display handling
230 !
240 INTEGER Nlines,D(1:4),Dw,Dh,Iw,Ih,Gx,Gy ! Display size parameters
250 INTEGER Pw,Ph,Px,Py ! PANEL parameters
260 INTEGER Lx,Ly,Lw,Lh,Sx,Sy,Sw,Sh ! LABEL & SLIDER parameters
270 !
280 ! Get display size
290 !
300 STATUS CRT,13;Nlines
310 GESCAPE CRT,3;D(*)
320 Dw=D(3)-D(1)
330 Dh=(D(4)-D(2))*((Nlines-7)/Nlines)
340 !
350 ! Set main PANEL dimensions and origin
360 !
370 Pw=Dw*.35
380 Ph=Dh*.8
390 Px=(Dw-Pw)/2
400 Py=(Dh-Ph)/2
410 !
420 ! Build main PANEL
430 !
440 CLEAR SCREEN
450 ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
460 CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
470 CONTROL @Main;SET ("RESIZABLE":0,"MAXIMIZABLE":0)
480 CONTROL @Main;SET ("BACKGROUND":9,"TITLE":" Example: SLIDER Test")
490 !
500 ! Build menu
510 !
520 ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
530 CONTROL @Menu;SET ("LABEL":" Menu")
540 ASSIGN @Log TO WIDGET "MENU BUTTON";PARENT @Menu
550 CONTROL @Log;SET ("LABEL":" Set LOG mode")
560 Log=0
570 ASSIGN @Direct TO WIDGET "MENU BUTTON";PARENT @Menu
580 CONTROL @Direct;SET ("LABEL":" Set DIRECT MOVE")
590 Direct=0
600 ASSIGN @S1 TO WIDGET "MENU SEPARATOR";PARENT @Menu
610 ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
620 CONTROL @Quit;SET ("LABEL":" Quit")
630 !
640 ! PANEL done, get inside dimensions
650 !
660 STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
670 !
680 ! Set widget parameters
690 !
700 Gx=Iw*.1 ! Set gaps
710 Gy=Ih*.05
720 Lx=Gx ! Position & size LABEL
730 Ly=Gy
740 Lw=Iw*.4
750 Lh=Iw*.2
760 Sx=Lx+Lw+Gx ! Position & size SLIDER
770 Sy=Gy
780 Sw=Iw-(Sx+Gx)
790 Sh=Ih-(2*Gy)
800 !
810 ! Create LABEL widget
820 !
830 ASSIGN @Label TO WIDGET "LABEL";PARENT @Main
840 CONTROL @Label;SET ("X":Lx,"Y":Ly,"WIDTH":Lw,"HEIGHT":Lh)
850 CONTROL @Label;SET ("BACKGROUND":1,"PEN":Black)
860 !
870 ! Create SLIDER widget
880 !
890 ASSIGN @Slider TO WIDGET "SLIDER";PARENT @Main
900 CONTROL @Slider;SET ("X":Sx,"Y":Sy,"WIDTH":Sw,"HEIGHT":Sh)
910 CONTROL @Slider;SET ("AUTO REPEAT":1,"LOGARITHMIC":0)
920 CONTROL @Slider;SET ("MAXIMUM":100,"MINIMUM":1)
930 CONTROL @Slider;SET ("MAJOR INCREMENT":10,"MINOR INCREMENT":1)
940 !
950 ! Enable events
960 !
970 ON EVENT @Log,"ACTIVATED" GOSUB Set_log
980 ON EVENT @Direct,"ACTIVATED" GOSUB Set_direct
990 ON EVENT @Slider,"CHANGED" GOSUB Set_label
1000 ON EVENT @Quit,"ACTIVATED" GOTO Finis
1010 !
1020 ! Initialize menu labels, make all widgets visible
1030 !
1040 GOSUB Set_label
1050 CONTROL @Main;SET ("VISIBLE":1)
1060 !
1070 ! Wait for event to happen
1080 !
1090 LOOP
1100 WAIT FOR EVENT
1110 END LOOP
1120 STOP
1130 !
1140 ! ********* Subroutines *****************
1150 !
1160 ! Toggle between log and linear mode
1170 !
1180 Set_log: !
1190 SELECT Log
1200 CASE 0
1210 CONTROL @Slider;SET ("LOGARITHMIC":1)
1220 CONTROL @Log;SET ("LABEL":"Set LINEAR Mode")
1230 Log=1
1240 CASE 1
1250 CONTROL @Slider;SET ("LOGARITHMIC":0)
1260 CONTROL @Log;SET ("LABEL":"Set LOG Mode")
1270 Log=0
1280 END SELECT
1290 RETURN
1300 !
1310 ! Toggle DIRECT MOVE on or off
1320 !
1330 Set_direct: !
1340 SELECT Direct
1350 CASE 0
1360 CONTROL @Slider;SET ("DIRECT MOVE":1)
1370 CONTROL @Direct;SET ("LABEL":"Clear DIRECT MOVE")
1380 Direct=1
1390 CASE 1
1400 CONTROL @Slider;SET ("DIRECT MOVE":0)
1410 CONTROL @Direct;SET ("LABEL":"Set DIRECT MOVE")
1420 Direct=0
1430 END SELECT
1440 RETURN
1450 !
1460 ! Set label value from SLIDER widget
1470 !
1480 Set_label: !
1490 STATUS @Slider;RETURN ("VALUE":V)
1500 CONTROL @Label;SET ("VALUE":V)
1510 RETURN
1520 !
1530 Finis: !
1540 ASSIGN @Main TO * ! Delete PANEL widget
1550 END
