HTBasic Help
×
Menu
Index

Example: Calculator

 
10     ! *********************************************************************
20     ! Example: Calculator
30     !
40     ! This program creates a calculator using PUSHBUTTON widgets.
50     !
60     ! **********************************************************
70     !
80     COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(100)
90     ASSIGN @Calc TO WIDGET "PANEL";SET ("TITLE":" Example: Calculator","X":20,"Y":20,"WIDTH":300,"HEIGHT":400)
100   STATUS @Calc;RETURN ("INSIDE WIDTH":Iw)
110   CONTROL @Calc;SET ("SYSTEM MENU":"Quit")
120   ON EVENT @Calc,"SYSTEM MENU" GOTO Finis
130   ASSIGN @Display TO WIDGET "LABEL";SET ("X":5,"Y":5,"WIDTH":Iw-10,"HEIGHT":40,"BACKGROUND":0,"PEN":2,"VALUE":0,"JUSTIFICATION":"RIGHT"),PARENT @Calc
140   Xpos=5
150   Ypos=80
160   Item=1
170   RAD
180   ON EVENT @Calc,"RESIZED" GOSUB Resized
190   DIM Val$[64],Tmp$[64]
200   DIM Modes$(1:2)[80]
210   REAL Mem(10)
220   Modes$(1)="DEGREES"
230   Modes$(2)="RADIANS"
240   Val$=""
250   Fkey=0
260   Max_stack=100
270   Stack_ptr=0
280   Base=10
290   Store_mode=0
300   Recall_mode=0
310   !
320   ASSIGN @Button10 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
330   ASSIGN @Label10 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
340   CONTROL @Button10;SET ("BACKGROUND":6,"PEN":1,"LABEL":"7","VISIBLE":1)
350   CONTROL @Label10;SET ("PEN":0,"VALUE":"A")
360   ASSIGN @Button11 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
370   ASSIGN @Label11 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
380   CONTROL @Button11;SET ("BACKGROUND":6,"PEN":1,"LABEL":"4","VISIBLE":1)
390   CONTROL @Label11;SET ("PEN":0,"VALUE":"D")
400   ASSIGN @Button12 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
410   ASSIGN @Label12 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
420   CONTROL @Button12;SET ("BACKGROUND":6,"PEN":1,"LABEL":"1","VISIBLE":1)
430   CONTROL @Label12;SET ("PEN":0,"VALUE":"","VISIBLE":1)
440   ASSIGN @Button13 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
450   ASSIGN @Label13 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
460   CONTROL @Button13;SET ("BACKGROUND":6,"PEN":1,"LABEL":"0","VISIBLE":1)
470   CONTROL @Label13;SET ("PEN":0,"VALUE":"STO","VISIBLE":1)
480   ASSIGN @Button14 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
490   ASSIGN @Label14 TO WIDGET "LABEL";SET ("X":Xpos+0*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
500   CONTROL @Button14;SET ("WIDTH":(Iw-20)/2.5-10)
510   CONTROL @Label14;SET ("WIDTH":(Iw-20)/2.5-10)
520   CONTROL @Button14;SET ("BACKGROUND":6,"PEN":1,"LABEL":"ENTER","VISIBLE":1)
530   CONTROL @Label14;SET ("PEN":0,"VALUE":"QUIT","VISIBLE":1)
540   ASSIGN @Button15 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
550   ASSIGN @Label15 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
560   CONTROL @Button15;SET ("BACKGROUND":6,"PEN":1,"LABEL":"8","VISIBLE":1)
570   CONTROL @Label15;SET ("PEN":0,"VALUE":"B")
580   ASSIGN @Button16 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
590   ASSIGN @Label16 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
600   CONTROL @Button16;SET ("BACKGROUND":6,"PEN":1,"LABEL":"5","VISIBLE":1)
610   CONTROL @Label16;SET ("PEN":0,"VALUE":"E")
620   ASSIGN @Button17 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
630   ASSIGN @Label17 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
640   CONTROL @Button17;SET ("BACKGROUND":6,"PEN":1,"LABEL":"2","VISIBLE":1)
650   CONTROL @Label17;SET ("PEN":0,"VALUE":"e","VISIBLE":1)
660   ASSIGN @Button18 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
670   ASSIGN @Label18 TO WIDGET "LABEL";SET ("X":Xpos+1*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
680   CONTROL @Button18;SET ("BACKGROUND":6,"PEN":1,"LABEL":".","VISIBLE":1)
690   CONTROL @Label18;SET ("PEN":0,"VALUE":"RCL","VISIBLE":1)
700   ASSIGN @Button20 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
710   ASSIGN @Label20 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
720   CONTROL @Button20;SET ("BACKGROUND":6,"PEN":1,"LABEL":"9","VISIBLE":1)
730   CONTROL @Label20;SET ("PEN":0,"VALUE":"C")
740   ASSIGN @Button21 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
750   ASSIGN @Label21 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
760   CONTROL @Button21;SET ("BACKGROUND":6,"PEN":1,"LABEL":"6","VISIBLE":1)
770   CONTROL @Label21;SET ("PEN":0,"VALUE":"F")
780   ASSIGN @Button22 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
790   ASSIGN @Label22 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
800   CONTROL @Button22;SET ("BACKGROUND":6,"PEN":1,"LABEL":"3","VISIBLE":1)
810   CONTROL @Label22;SET ("PEN":0,"VALUE":"PI","VISIBLE":1)
820   ASSIGN @Button23 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
830   ASSIGN @Label23 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
840   CONTROL @Button23;SET ("BACKGROUND":6,"PEN":1,"LABEL":"CHS","VISIBLE":1)
850   CONTROL @Label23;SET ("PEN":0,"VALUE":"ANGL","VISIBLE":1)
860   ASSIGN @Button24 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
870   ASSIGN @Label24 TO WIDGET "LABEL";SET ("X":Xpos+2*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
880   CONTROL @Button24;SET ("BACKGROUND":6,"PEN":1,"LABEL":"CLX","VISIBLE":1)
890   CONTROL @Label24;SET ("PEN":0,"VALUE":"","VISIBLE":1)
900   ASSIGN @Button25 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
910   ASSIGN @Label25 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
920   CONTROL @Button25;SET ("BACKGROUND":6,"PEN":1,"LABEL":"/","VISIBLE":1)
930   CONTROL @Label25;SET ("PEN":0,"VALUE":"HEX","VISIBLE":1)
940   ASSIGN @Button26 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
950   ASSIGN @Label26 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
960   CONTROL @Button26;SET ("BACKGROUND":6,"PEN":1,"LABEL":"*","VISIBLE":1)
970   CONTROL @Label26;SET ("PEN":0,"VALUE":"DEC","VISIBLE":1)
980   ASSIGN @Button27 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
990   ASSIGN @Label27 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1000  CONTROL @Button27;SET ("BACKGROUND":6,"PEN":1,"LABEL":"-","VISIBLE":1)
1010  CONTROL @Label27;SET ("PEN":0,"VALUE":"OCT","VISIBLE":1)
1020  ASSIGN @Button28 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1030  ASSIGN @Label28 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1040  CONTROL @Button28;SET ("BACKGROUND":6,"PEN":1,"LABEL":"+","VISIBLE":1)
1050  CONTROL @Label28;SET ("PEN":0,"VALUE":"BIN","VISIBLE":1)
1060  ASSIGN @Button29 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1070  ASSIGN @Label29 TO WIDGET "LABEL";SET ("X":Xpos+3*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1080  CONTROL @Button29;SET ("BACKGROUND":6,"PEN":1,"LABEL":"f","VISIBLE":1)
1090  CONTROL @Label29;SET ("PEN":0,"VALUE":"","VISIBLE":1)
1100  CONTROL @Button29;SET ("BACKGROUND":3,"PEN":0)
1110  ASSIGN @Button30 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+0*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1120  ASSIGN @Label30 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+0*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1130  CONTROL @Button30;SET ("BACKGROUND":6,"PEN":1,"LABEL":"SIN","VISIBLE":1)
1140  CONTROL @Label30;SET ("PEN":0,"VALUE":"ASN","VISIBLE":1)
1150  ASSIGN @Button31 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+1*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1160  ASSIGN @Label31 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+1*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1170  CONTROL @Button31;SET ("BACKGROUND":6,"PEN":1,"LABEL":"COS","VISIBLE":1)
1180  CONTROL @Label31;SET ("PEN":0,"VALUE":"ACS","VISIBLE":1)
1190  ASSIGN @Button32 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+2*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1200  ASSIGN @Label32 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+2*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1210  CONTROL @Button32;SET ("BACKGROUND":6,"PEN":1,"LABEL":"TAN","VISIBLE":1)
1220  CONTROL @Label32;SET ("PEN":0,"VALUE":"ATN","VISIBLE":1)
1230  ASSIGN @Button33 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+3*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1240  ASSIGN @Label33 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+3*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1250  CONTROL @Button33;SET ("BACKGROUND":6,"PEN":1,"LABEL":"10^X","VISIBLE":1)
1260  CONTROL @Label33;SET ("PEN":0,"VALUE":"LOG","VISIBLE":1)
1270  ASSIGN @Button34 TO WIDGET "PUSHBUTTON";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+4*(250-20)/4,"WIDTH":(Iw-20)/5-10,"HEIGHT":30,"VISIBLE":0),PARENT @Calc
1280  ASSIGN @Label34 TO WIDGET "LABEL";SET ("X":Xpos+4*(Iw-10)/5,"Y":Ypos+4*(250-20)/4-25,"WIDTH":(Iw-20)/5-10,"HEIGHT":25,"BORDER":0,"VISIBLE":0),PARENT @Calc
1290  CONTROL @Button34;SET ("BACKGROUND":6,"PEN":1,"LABEL":"EEX","VISIBLE":1)
1300  CONTROL @Label34;SET ("PEN":0,"VALUE":"LN","VISIBLE":1)
1310  ON ERROR GOTO Process_error
1320  ON EVENT @Button10,"ACTIVATED" GOSUB Button10
1330  CONTROL @Label16;SET ("VISIBLE":1)
1340  ON EVENT @Button11,"ACTIVATED" GOSUB Button11
1350  ON EVENT @Button12,"ACTIVATED" GOSUB Button12
1360  ON EVENT @Button13,"ACTIVATED" GOSUB Button13
1370  ON EVENT @Button14,"ACTIVATED" GOSUB Button14
1380  ON EVENT @Button15,"ACTIVATED" GOSUB Button15
1390  ON EVENT @Button16,"ACTIVATED" GOSUB Button16
1400  ON EVENT @Button17,"ACTIVATED" GOSUB Button17
1410  ON EVENT @Button18,"ACTIVATED" GOSUB Button18
1420  ON EVENT @Button20,"ACTIVATED" GOSUB Button20
1430  ON EVENT @Button21,"ACTIVATED" GOSUB Button21
1440  ON EVENT @Button22,"ACTIVATED" GOSUB Button22
1450  ON EVENT @Button23,"ACTIVATED" GOSUB Button23
1460  ON EVENT @Button24,"ACTIVATED" GOSUB Button24
1470  ON EVENT @Button25,"ACTIVATED" GOSUB Button25
1480  ON EVENT @Button26,"ACTIVATED" GOSUB Button26
1490  ON EVENT @Button27,"ACTIVATED" GOSUB Button27
1500  ON EVENT @Button28,"ACTIVATED" GOSUB Button28
1510  ON EVENT @Button29,"ACTIVATED" GOSUB Button29
1520  ON EVENT @Button30,"ACTIVATED" GOSUB Button30
1530  ON EVENT @Button31,"ACTIVATED" GOSUB Button31
1540  ON EVENT @Button32,"ACTIVATED" GOSUB Button32
1550  ON EVENT @Button33,"ACTIVATED" GOSUB Button33
1560  ON EVENT @Button34,"ACTIVATED" GOSUB Button34
1570  LOOP
1580    WAIT FOR EVENT
1590  END LOOP
1600 Button10:     !
1610  Number=7
1620  GOSUB Check_storcl
1630  IF Store_mode=0 AND Recall_mode=0 THEN
1640    GOSUB Getval
1650    IF Fkey=0 OR Base<>16 THEN
1660      Modval(Val$,Number)
1670    ELSE
1680      Modval(Val$,0,"A")
1690    END IF
1700    CONTROL @Display;SET ("VALUE":Val$)
1710  ELSE
1720    GOSUB Enable_base
1730  END IF
1740  GOSUB Check_fkey
1750  RETURN
1760 Button11:     !
1770  Number=4
1780  GOSUB Check_storcl
1790  IF Store_mode=0 AND Recall_mode=0 THEN
1800    GOSUB Getval
1810    IF Fkey=0 OR Base<>16 THEN
1820      Modval(Val$,Number)
1830    ELSE
1840      Modval(Val$,0,"D")
1850    END IF
1860    CONTROL @Display;SET ("VALUE":Val$)
1870  ELSE
1880    GOSUB Enable_base
1890  END IF
1900  GOSUB Check_fkey
1910  RETURN
1920 Button12:     !
1930  Number=1
1940  GOSUB Check_storcl
1950  IF Store_mode=0 AND Recall_mode=0 THEN
1960    GOSUB Getval
1970    Modval(Val$,Number)
1980    CONTROL @Display;SET ("VALUE":Val$)
1990  ELSE
2000    GOSUB Enable_base
2010  END IF
2020  GOSUB Check_fkey
2030  RETURN
2040 Button13:     !
2050  Number=0
2060  GOSUB Check_storcl
2070  IF Store_mode=0 AND Recall_mode=0 THEN
2080    GOSUB Getval
2090    IF Fkey=0 THEN
2100      Modval(Val$,Number)
2110    ELSE
2120      Store_mode=1
2130      GOSUB Enable_all
2140      GOSUB Clear_fn_keys
2150      GOSUB Clear_hex_keys
2160      RETURN
2170    END IF
2180    CONTROL @Display;SET ("VALUE":Val$)
2190  ELSE
2200    GOSUB Enable_base
2210  END IF
2220  GOSUB Check_fkey
2230  RETURN
2240 Button14:     !
2250  IF Fkey=0 THEN
2260    Get_dispval(@Display,Base,Val)
2270    Push_val(Val,@Display)
2280    Restart=1
2290  ELSE
2300    STOP
2310  END IF
2320  GOSUB Check_fkey
2330  RETURN
2340 Button15:     !
2350  Number=8
2360  GOSUB Check_storcl
2370  IF Store_mode=0 AND Recall_mode=0 THEN
2380    GOSUB Getval
2390    IF Fkey=0 OR Base<>16 THEN
2400      Modval(Val$,Number)
2410    ELSE
2420      Modval(Val$,0,"B")
2430    END IF
2440    CONTROL @Display;SET ("VALUE":Val$)
2450  ELSE
2460    GOSUB Enable_base
2470  END IF
2480  GOSUB Check_fkey
2490  RETURN
2500 Button16:     !
2510  Number=5
2520  GOSUB Check_storcl
2530  IF Store_mode=0 AND Recall_mode=0 THEN
2540    GOSUB Getval
2550    IF Fkey=0 OR (Base<>16 AND Base<>10) THEN
2560      Modval(Val$,Number)
2570    ELSE
2580      IF Base=10 THEN
2590        GOSUB Process_e
2600      ELSE
2610        Modval(Val$,0,"E")
2620      END IF
2630    END IF
2640    CONTROL @Display;SET ("VALUE":Val$)
2650  ELSE
2660    GOSUB Enable_base
2670  END IF
2680  GOSUB Check_fkey
2690  RETURN
2700 Button17:      !
2710  Number=2
2720  GOSUB Check_storcl
2730  IF Store_mode=0 AND Recall_mode=0 THEN
2740    GOSUB Getval
2750    IF Fkey=0 THEN
2760      Modval(Val$,Number)
2770    ELSE
2780      Tentobase(Base,EXP(1),Val$,Error)
2790    END IF
2800    CONTROL @Display;SET ("VALUE":Val$)
2810  ELSE
2820    GOSUB Enable_base
2830  END IF
2840  GOSUB Check_fkey
2850  RETURN
2860 Button18:      !
2870  IF Fkey=0 THEN
2880    STATUS @Display;RETURN ("VALUE":Val$)
2890    IF (POS(Val$,".")=0) THEN Val$=Val$&"."
2900    CONTROL @Display;SET ("VALUE":Val$)
2910  ELSE
2920    Recall_mode=1
2930    GOSUB Enable_all
2940    GOSUB Clear_fn_keys
2950    GOSUB Clear_hex_keys
2960  END IF
2970  GOSUB Check_fkey
2980  RETURN
2990 Button19:      !
3000 Button20:      !
3010  Number=9
3020  GOSUB Check_storcl
3030  IF Store_mode=0 AND Recall_mode=0 THEN
3040    GOSUB Getval
3050    IF Fkey=0 OR Base<>16 THEN
3060      Modval(Val$,Number)
3070    ELSE
3080      Modval(Val$,0,"C")
3090    END IF
3100    CONTROL @Display;SET ("VALUE":Val$)
3110  ELSE
3120    GOSUB Enable_base
3130  END IF
3140  GOSUB Check_fkey
3150  RETURN
3160 Button21:      !
3170  Number=6
3180  GOSUB Check_storcl
3190  IF Store_mode=0 AND Recall_mode=0 THEN
3200    GOSUB Getval
3210    IF Fkey=0 OR Base<>16 THEN
3220      Modval(Val$,Number)
3230    ELSE
3240      Modval(Val$,0,"F")
3250    END IF
3260    CONTROL @Display;SET ("VALUE":Val$)
3270  ELSE
3280    GOSUB Enable_base
3290  END IF
3300  GOSUB Check_fkey
3310  RETURN
3320 Button22:      !
3330  Number=3
3340  GOSUB Check_storcl
3350  IF Store_mode=0 AND Recall_mode=0 THEN
3360    GOSUB Getval
3370    IF Fkey=0 THEN
3380      Modval(Val$,Number)
3390    ELSE
3400      Tentobase(Base,PI,Val$,Error)
3410    END IF
3420    CONTROL @Display;SET ("VALUE":Val$)
3430  ELSE
3440    GOSUB Enable_base
3450  END IF
3460  GOSUB Check_fkey
3470  RETURN
3480 Button23:      !
3490  IF Fkey=0 THEN
3500    STATUS @Display;RETURN ("VALUE":Val$)
3510    IF Base=10 THEN
3520      IF Val$[1;1]="-" THEN
3530        Val$=Val$[2]
3540      ELSE
3550        Val$="-"&Val$
3560      END IF
3570    ELSE
3580      Twos_comp(Base,Val$)
3590    END IF
3600    CONTROL @Display;SET ("VALUE":Val$)
3610  ELSE
3620    !* DIALOG "LIST","Trigonometric Mode",Button;SET ("ITEMS":Modes$(*),"SELECTED ITEM":Item),
3630    IF Button=0 AND Item<>-1 THEN
3640      IF Item=0 THEN DEG
3650      IF Item=1 THEN RAD
3660    END IF
3670  END IF
3680  GOSUB Check_fkey
3690  RETURN
3700 Button24:      !
3710  CONTROL @Display;SET ("VALUE":0)
3720  GOSUB Check_fkey
3730  RETURN
3740 Button25:      !
3750  IF Fkey=0 THEN
3760    Get_dispval(@Display,Base,Val1)
3770    Val2=FNPop_val(@Display)
3780    Val$=VAL$(Val2/Val1)
3790    Set_dispval(@Display,Base,VAL(Val$))
3800    Push_val(VAL(Val$),@Display)
3810    Restart=1
3820  ELSE
3830    Get_dispval(@Display,Base,Val1)
3840    Base=16
3850    Set_dispval(@Display,Base,Val1)
3860    CONTROL @Label10;SET ("VISIBLE":1)
3870    CONTROL @Label11;SET ("VISIBLE":1)
3880    CONTROL @Label15;SET ("VISIBLE":1)
3890    CONTROL @Label16;SET ("VISIBLE":1)
3900    CONTROL @Label20;SET ("VISIBLE":1)
3910    CONTROL @Label21;SET ("VISIBLE":1)
3920    GOSUB Enable_all
3930  END IF
3940  GOSUB Check_fkey
3950  RETURN
3960 Button26:      !
3970  IF Fkey=0 THEN
3980    Get_dispval(@Display,Base,Val1)
3990    Val2=FNPop_val(@Display)
4000    Val$=VAL$(Val2*Val1)
4010    Set_dispval(@Display,Base,VAL(Val$))
4020    Push_val(VAL(Val$),@Display)
4030    Restart=1
4040  ELSE
4050    Get_dispval(@Display,Base,Val1)
4060    Base=10
4070    Set_dispval(@Display,Base,Val1)
4080    GOSUB Enable_all
4090    GOSUB Clear_hex_keys
4100    CONTROL @Label16;SET ("VISIBLE":1)
4110  END IF
4120  GOSUB Check_fkey
4130  RETURN
4140 Button27:      !
4150  IF Fkey=0 THEN
4160    Get_dispval(@Display,Base,Val1)
4170    Val2=FNPop_val(@Display)
4180    Val$=VAL$(Val2-Val1)
4190    Set_dispval(@Display,Base,VAL(Val$))
4200    Push_val(VAL(Val$),@Display)
4210    Restart=1
4220  ELSE
4230    Get_dispval(@Display,Base,Val1)
4240    Base=8
4250    Set_dispval(@Display,Base,Val1)
4260    GOSUB Enable_all
4270    GOSUB Clear_nonoct
4280  END IF
4290  GOSUB Check_fkey
4300  RETURN
4310 Button28:      !
4320  IF Fkey=0 THEN
4330    Get_dispval(@Display,Base,Val1)
4340    Val2=FNPop_val(@Display)
4350    Val$=VAL$(Val1+Val2)
4360    Push_val(VAL(Val$),@Display)
4370    Set_dispval(@Display,Base,VAL(Val$))
4380    Restart=1
4390  ELSE
4400    Get_dispval(@Display,Base,Val1)
4410    Base=2
4420    Set_dispval(@Display,Base,Val1)
4430    GOSUB Enable_all
4440    GOSUB Clear_nonbin
4450  END IF
4460  GOSUB Check_fkey
4470  RETURN
4480 Button29:      !
4490  Fkey=(Fkey+1) MOD 2
4500  IF Fkey=1 THEN
4510    CONTROL @Display;SET ("PEN":3)
4520    GOSUB Enable_pi
4530  ELSE
4540    CONTROL @Display;SET ("PEN":2)
4550    GOSUB Enable_base
4560  END IF
4570  RETURN
4580 Button30:      !
4590  Get_dispval(@Display,Base,Val1)
4600  IF Fkey=0 THEN
4610    Val$=VAL$(SIN(Val1))
4620  ELSE
4630    Val$=VAL$(ASN(Val1))
4640  END IF
4650  Set_dispval(@Display,Base,VAL(Val$))
4660  Push_val(VAL(Val$),@Display)
4670  Restart=1
4680  GOSUB Check_fkey
4690  RETURN
4700 Button31:      !
4710  Get_dispval(@Display,Base,Val1)
4720  IF Fkey=0 THEN
4730    Val$=VAL$(COS(Val1))
4740  ELSE
4750    Val$=VAL$(ACS(Val1))
4760  END IF
4770  Set_dispval(@Display,Base,VAL(Val$))
4780  Push_val(VAL(Val$),@Display)
4790  Restart=1
4800  GOSUB Check_fkey
4810  RETURN
4820 Button32:      !
4830  Get_dispval(@Display,Base,Val1)
4840  IF Fkey=0 THEN
4850    Val$=VAL$(TAN(Val1))
4860  ELSE
4870    Val$=VAL$(ATN(Val1))
4880  END IF
4890  Set_dispval(@Display,Base,VAL(Val$))
4900  Push_val(VAL(Val$),@Display)
4910  Restart=1
4920  GOSUB Check_fkey
4930  RETURN
4940 Button33:      !
4950  Get_dispval(@Display,Base,Val1)
4960  IF Fkey=0 THEN
4970    Val$=VAL$(10^Val1)
4980  ELSE
4990    Val$=VAL$(LGT(Val1))
5000  END IF
5010  Set_dispval(@Display,Base,VAL(Val$))
5020  Push_val(VAL(Val$),@Display)
5030  Restart=1
5040  GOSUB Check_fkey
5050  RETURN
5060 Button34:      !
5070  Get_dispval(@Display,Base,Val1)
5080  IF Fkey=0 THEN
5090    Val$=VAL$(EXP(Val1))
5100  ELSE
5110    Val$=VAL$(LOG(Val1))
5120  END IF
5130  Set_dispval(@Display,Base,VAL(Val$))
5140  Push_val(VAL(Val$),@Display)
5150  Restart=1
5160  GOSUB Check_fkey
5170  RETURN
5180 Clear_nonbin:  !
5190  CONTROL @Button17;SET ("SENSITIVE":0)
5200  CONTROL @Button22;SET ("SENSITIVE":0)
5210  CONTROL @Button11;SET ("SENSITIVE":0)
5220  CONTROL @Button16;SET ("SENSITIVE":0)
5230  CONTROL @Button21;SET ("SENSITIVE":0)
5240  CONTROL @Button10;SET ("SENSITIVE":0)
5250 Clear_nonoct:  !
5260  CONTROL @Button15;SET ("SENSITIVE":0)
5270  CONTROL @Button20;SET ("SENSITIVE":0)
5280 Clear_hex_keys:  !
5290  CONTROL @Label10;SET ("VISIBLE":0)
5300  CONTROL @Label11;SET ("VISIBLE":0)
5310  CONTROL @Label15;SET ("VISIBLE":0)
5320  CONTROL @Label16;SET ("VISIBLE":0)
5330  CONTROL @Label20;SET ("VISIBLE":0)
5340  CONTROL @Label21;SET ("VISIBLE":0)
5350  RETURN
5360 Clear_fn_keys:  !
5370  CONTROL @Button29;SET ("SENSITIVE":0)
5380  CONTROL @Button23;SET ("SENSITIVE":0)
5390  CONTROL @Button30;SET ("SENSITIVE":0)
5400  CONTROL @Button32;SET ("SENSITIVE":0)
5410  CONTROL @Button31;SET ("SENSITIVE":0)
5420  CONTROL @Button24;SET ("SENSITIVE":0)
5430  CONTROL @Button34;SET ("SENSITIVE":0)
5440  CONTROL @Button33;SET ("SENSITIVE":0)
5450  CONTROL @Button26;SET ("SENSITIVE":0)
5460  CONTROL @Button14;SET ("SENSITIVE":0)
5470  CONTROL @Button28;SET ("SENSITIVE":0)
5480  CONTROL @Button27;SET ("SENSITIVE":0)
5490  CONTROL @Button18;SET ("SENSITIVE":0)
5500  CONTROL @Button25;SET ("SENSITIVE":0)
5510  RETURN
5520 Enable_all:  !
5530  CONTROL @Button13;SET ("SENSITIVE":1)
5540  CONTROL @Button12;SET ("SENSITIVE":1)
5550  CONTROL @Button17;SET ("SENSITIVE":1)
5560  CONTROL @Button22;SET ("SENSITIVE":1)
5570  CONTROL @Button11;SET ("SENSITIVE":1)
5580  CONTROL @Button16;SET ("SENSITIVE":1)
5590  CONTROL @Button21;SET ("SENSITIVE":1)
5600  CONTROL @Button10;SET ("SENSITIVE":1)
5610  CONTROL @Button15;SET ("SENSITIVE":1)
5620  CONTROL @Button20;SET ("SENSITIVE":1)
5630  CONTROL @Button29;SET ("SENSITIVE":1)
5640  CONTROL @Button23;SET ("SENSITIVE":1)
5650  CONTROL @Button30;SET ("SENSITIVE":1)
5660  CONTROL @Button32;SET ("SENSITIVE":1)
5670  CONTROL @Button31;SET ("SENSITIVE":1)
5680  CONTROL @Button24;SET ("SENSITIVE":1)
5690  CONTROL @Button34;SET ("SENSITIVE":1)
5700  CONTROL @Button33;SET ("SENSITIVE":1)
5710  CONTROL @Button26;SET ("SENSITIVE":1)
5720  CONTROL @Button14;SET ("SENSITIVE":1)
5730  CONTROL @Button28;SET ("SENSITIVE":1)
5740  CONTROL @Button27;SET ("SENSITIVE":1)
5750  CONTROL @Button18;SET ("SENSITIVE":1)
5760  CONTROL @Button25;SET ("SENSITIVE":1)
5770  RETURN
5780 Enable_e:     !
5790  CONTROL @Label16;SET ("VISIBLE":1)
5800  RETURN
5810 Enable_pi:     !
5820  CONTROL @Button22;SET ("SENSITIVE":1)
5830  CONTROL @Button17;SET ("SENSITIVE":1)
5840  RETURN
5850 Enable_base:   !
5860  Recall_mode=0
5870  Store_mode=0
5880  GOSUB Enable_all
5890  IF Base=2 THEN GOSUB Clear_nonbin
5900  IF Base=8 THEN GOSUB Clear_nonoct
5910  IF Base=10 THEN
5920    GOSUB Clear_hex_keys
5930    GOSUB Enable_e
5940  END IF
5950  RETURN
5960 Check_storcl: !
5970  IF Store_mode THEN
5980    Get_dispval(@Display,Base,Val1)
5990    Mem(Number)=Val1
6000  ELSE
6010    IF Recall_mode THEN
6020      Val1=Mem(Number)
6030      Set_dispval(@Display,Base,Val1)
6040    END IF
6050  END IF
6060  RETURN
6070 Resized: RETURN
6080 Process_e: !
6090  IF (POS(Val$,"E")=0) THEN Val$=Val$&"E"
6100  RETURN
6110 Process_error: !
6120  IF Fkey=1 THEN CONTROL @Display;SET ("PEN":2)
6130  Fkey=0
6140  STATUS @Display;RETURN ("VALUE":Tmp$)
6150  CONTROL @Display;SET ("VALUE":ERRM$)
6160  WAIT 2
6170  CONTROL @Display;SET ("VALUE":Tmp$)
6180  RETURN
6190 Getval: !
6200  IF Restart THEN
6210    Restart=0
6220    Val$="0"
6230  ELSE
6240    STATUS @Display;RETURN ("VALUE":Val$)
6250  END IF
6260  RETURN
6270 Check_fkey: !
6280  IF Fkey=1 THEN
6290    CONTROL @Display;SET ("PEN":2)
6300    GOSUB Enable_base
6310  END IF
6320  Fkey=0
6330  RETURN
6340 Finis: END
6350  !    
6360  SUB Push_val(REAL Val,@Disp)
6370    COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(*)
6380    Stack(Stack_ptr)=Val
6390    IF Stack_ptr<=Max_stack THEN
6400      Stack_ptr=Stack_ptr+1
6410    ELSE
6420      BEEP
6430      STATUS @Disp;RETURN ("VALUE":Tmpval$)
6440      CONTROL @Disp;SET ("VALUE":"ERROR: STACK OVERFLOW!!!")
6450      WAIT 2
6460      CONTROL @Disp;SET ("VALUE":Tmpval$)
6470      SUBEXIT
6480    END IF
6490  SUBEND
6500  DEF FNPop_val(@Disp)
6510    COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(*)
6520    IF Stack_ptr>0 THEN
6530      Stack_ptr=Stack_ptr-1
6540    ELSE
6550      BEEP
6560      STATUS @Disp;RETURN ("VALUE":Tmpval$)
6570      CONTROL @Disp;SET ("VALUE":"ERROR: STACK UNDERFLOW!!!")
6580      WAIT 2
6590      CONTROL @Disp;SET ("VALUE":Tmpval$)
6600      RETURN 0
6610    END IF
6620    RETURN Stack(Stack_ptr)
6630  FNEND
6640  DEF FNGetval(A$)
6650    IF NUM(A$)>=NUM("0") AND NUM(A$)<=NUM("9") THEN
6660      RETURN VAL(A$)
6670    ELSE
6680      RETURN NUM(A$)-55
6690    END IF
6700  FNEND
6710  DEF FNGetval$(A)
6720    IF A>=10 THEN
6730      RETURN CHR$(A+NUM("A")-10)
6740    ELSE
6750      RETURN VAL$(A)
6760    END IF
6770  FNEND
6780  SUB Basetoten(Base,Value,Str$)
6790    IF Base=10 THEN
6800      Value=VAL(Str$)
6810      SUBEXIT
6820    END IF
6830    Sign=0
6840    IF LEN(Str$)=MAXLEN(Str$) AND FNGetval$(Base-1)=Str$[1;1] THEN
6850      Sign=1
6860      Twos_comp(Base,Str$)
6870    END IF
6880    Value=0.
6890    Max=LEN(Str$)
6900    IF POS(Str$,".")<>0 THEN Max=POS(Str$,".")-1
6910    FOR I=1 TO Max
6920      Value=Base*Value+FNGetval(Str$[I;1])
6930    NEXT I
6940    IF POS(Str$,".")<>0 THEN
6950      J=0
6960      FOR I=Max+2 TO LEN(Str$)
6970        J=J+1
6980        Value=Value+FNGetval(Str$[I;1])*Base^(-J)
6990      NEXT I
7000    END IF
7010    IF Sign=1 THEN
7020      Value=-Value
7030      Twos_comp(Base,Str$)
7040    END IF
7050  SUBEND
7060  SUB Tentobase(Base,Value,Str$,Error)
7070    Error=0
7080    Str$=""
7090    IF Base=10 THEN
7100      Str$=VAL$(Value)
7110      SUBEXIT
7120    END IF
7130    Sign=0
7140    IF Value<0 THEN
7150      Sign=1
7160      Value=-Value
7170    END IF
7180    Divisor1=Value DIV 1
7190    I=1
7200    WHILE Divisor1<>0
7210      IF I>=MAXLEN(Str$) THEN GOTO Length_err
7220      Str$[I;1]=FNGetval$(Divisor1 MOD Base)
7230      I=I+1
7240      Divisor1=Divisor1 DIV Base
7250    END WHILE
7260    Str$=REV$(Str$)
7270    Divisor2=(Value-Value DIV 1)
7280    I=1
7290    IF Divisor2<>0 THEN
7300      Str2$[I;1]="."
7310      I=I+1
7320    END IF
7330    WHILE Divisor2<>0
7340      Divisor2=Divisor2*Base
7350      Str2$[I;1]=FNGetval$(Divisor2 DIV 1)
7360      Divisor2=Divisor2-Divisor2 DIV 1
7370      I=I+1
7380      IF I>MAXLEN(Str2$) THEN Divisor2=0
7390    END WHILE
7400    IF LEN(Str$)+LEN(Str2$)>MAXLEN(Str$) THEN GOTO Length_err
7410    Str$=Str$&Str2$
7420    IF Sign=1 THEN
7430      Value=-Value
7440      Twos_comp(Base,Str$)
7450    END IF
7460    IF Value=0 THEN Str$="0"
7470    SUBEXIT
7480 Length_err: !
7490    Error=1
7500    IF Sign=1 THEN Value=-Value
7510  SUBEND
7520  SUB Get_dispval(@Disp,Src_base,Value)
7530    DIM Str$[64]
7540    STATUS @Disp;RETURN ("VALUE":Str$)
7550    IF Dest_base<>10 THEN
7560      Basetoten(Src_base,Value,Str$)
7570    ELSE
7580      Value=VAL(Str$)
7590    END IF
7600  SUBEND
7610  SUB Set_dispval(@Disp,Dest_base,Value)
7620    DIM Value$[64]
7630    IF Dest_base<>10 THEN
7640      Tentobase(Dest_base,Value,Value$,Error)
7650    ELSE
7660      Value$=VAL$(Value)
7670    END IF
7680    IF Error=0 THEN
7690      CONTROL @Disp;SET ("VALUE":Value$)
7700    ELSE
7710      CONTROL @Disp;SET ("VALUE":"ERROR: Value out of range.")
7720      WAIT 3
7730      CONTROL @Disp;SET ("VALUE":0)
7740    END IF
7750  SUBEND
7760  SUB Twos_comp(Base,Str$)
7770    DIM Tmpstr$[64]
7780    Tmpstr$=RPT$(FNGetval$(Base-1),64)
7790    FOR I=1 TO LEN(Str$)
7800      IF Str$[I;1]<>"." THEN
7810        Tmpstr$[MAXLEN(Str$)-LEN(Str$)+I]=FNGetval$(Base-FNGetval(Str$[I;1])-1)
7820      ELSE
7830        Tmpstr$[MAXLEN(Str$)-LEN(Str$)+I]=Str$[I;1]
7840      END IF
7850    NEXT I
7860    Carry=1
7870    Str$=""
7880    FOR I=MAXLEN(Tmpstr$) TO 1 STEP -1
7890      IF Tmpstr$[I;1]<>"." THEN
7900        Num=FNGetval(Tmpstr$[I;1])
7910        Nextnum=(Num+Carry) MOD Base
7920        Str$=FNGetval$(Nextnum)&Str$
7930        Carry=(Num+Carry) DIV Base
7940        IF Carry=0 THEN GOTO Bail_out
7950      ELSE
7960        Str$="."&Str$
7970      END IF
7980    NEXT I
7990    SUBEXIT
8000 Bail_out: Str$=Tmpstr$[1,I-1]&Str$
8010  SUBEND
8020  SUB Modval(Val$,Value,OPTIONAL Str$)
8030    IF NPAR>2 THEN
8040      IF Val$="0" THEN Val$=""
8050      Val$=Val$&Str$
8060    ELSE
8070      IF Val$="0" THEN Val$=""
8080      Val$=Val$&VAL$(Value)
8090    END IF
8100  SUBEND