home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 83win / data1.cab / Basic_Plus_Examples / CALCULAT < prev    next >
Encoding:
Text File  |  2001-03-02  |  35.5 KB  |  811 lines
  1. 10    ! **********************************************************
  2. 20    ! Example: Calculator
  3. 30    !
  4. 40    ! This program creates a calculator using PUSHBUTTON widgets.
  5. 50    !
  6. 60    ! **********************************************************
  7. 70    !
  8. 80       COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(100)
  9. 90       ASSIGN @Calc TO WIDGET "PANEL";SET ("TITLE":" Example: Calculator","X":20,"Y":20,"WIDTH":300,"HEIGHT":400)
  10. 100       STATUS @Calc;RETURN ("INSIDE WIDTH":Iw)
  11. 110       CONTROL @Calc;SET ("SYSTEM MENU":"Quit")
  12. 120       ON EVENT @Calc,"SYSTEM MENU" GOTO Finis
  13. 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
  14. 140       Xpos=5
  15. 150       Ypos=80
  16. 160       Item=1
  17. 170       RAD
  18. 180       ON EVENT @Calc,"RESIZED" GOSUB Resized
  19. 190       DIM Val$[64],Tmp$[64]
  20. 200       DIM Modes$(1:2)[80]
  21. 210       REAL Mem(10)
  22. 220       Modes$(1)="DEGREES"
  23. 230       Modes$(2)="RADIANS"
  24. 240       Val$=""
  25. 250       Fkey=0
  26. 260       Max_stack=100
  27. 270       Stack_ptr=0
  28. 280       Base=10
  29. 290       Store_mode=0
  30. 300       Recall_mode=0
  31. 310   !
  32. 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
  33. 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
  34. 340       CONTROL @Button10;SET ("BACKGROUND":6,"PEN":1,"LABEL":"7","VISIBLE":1)
  35. 350       CONTROL @Label10;SET ("PEN":0,"VALUE":"A")
  36. 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
  37. 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
  38. 380       CONTROL @Button11;SET ("BACKGROUND":6,"PEN":1,"LABEL":"4","VISIBLE":1)
  39. 390       CONTROL @Label11;SET ("PEN":0,"VALUE":"D")
  40. 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
  41. 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
  42. 420       CONTROL @Button12;SET ("BACKGROUND":6,"PEN":1,"LABEL":"1","VISIBLE":1)
  43. 430       CONTROL @Label12;SET ("PEN":0,"VALUE":"","VISIBLE":1)
  44. 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
  45. 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
  46. 460       CONTROL @Button13;SET ("BACKGROUND":6,"PEN":1,"LABEL":"0","VISIBLE":1)
  47. 470       CONTROL @Label13;SET ("PEN":0,"VALUE":"STO","VISIBLE":1)
  48. 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
  49. 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
  50. 500       CONTROL @Button14;SET ("WIDTH":(Iw-20)/2.5-10)
  51. 510       CONTROL @Label14;SET ("WIDTH":(Iw-20)/2.5-10)
  52. 520       CONTROL @Button14;SET ("BACKGROUND":6,"PEN":1,"LABEL":"ENTER","VISIBLE":1)
  53. 530       CONTROL @Label14;SET ("PEN":0,"VALUE":"QUIT","VISIBLE":1)
  54. 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
  55. 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
  56. 560       CONTROL @Button15;SET ("BACKGROUND":6,"PEN":1,"LABEL":"8","VISIBLE":1)
  57. 570       CONTROL @Label15;SET ("PEN":0,"VALUE":"B")
  58. 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
  59. 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
  60. 600       CONTROL @Button16;SET ("BACKGROUND":6,"PEN":1,"LABEL":"5","VISIBLE":1)
  61. 610       CONTROL @Label16;SET ("PEN":0,"VALUE":"E")
  62. 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
  63. 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
  64. 640       CONTROL @Button17;SET ("BACKGROUND":6,"PEN":1,"LABEL":"2","VISIBLE":1)
  65. 650       CONTROL @Label17;SET ("PEN":0,"VALUE":"e","VISIBLE":1)
  66. 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
  67. 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
  68. 680       CONTROL @Button18;SET ("BACKGROUND":6,"PEN":1,"LABEL":".","VISIBLE":1)
  69. 690       CONTROL @Label18;SET ("PEN":0,"VALUE":"RCL","VISIBLE":1)
  70. 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
  71. 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
  72. 720       CONTROL @Button20;SET ("BACKGROUND":6,"PEN":1,"LABEL":"9","VISIBLE":1)
  73. 730       CONTROL @Label20;SET ("PEN":0,"VALUE":"C")
  74. 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
  75. 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
  76. 760       CONTROL @Button21;SET ("BACKGROUND":6,"PEN":1,"LABEL":"6","VISIBLE":1)
  77. 770       CONTROL @Label21;SET ("PEN":0,"VALUE":"F")
  78. 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
  79. 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
  80. 800       CONTROL @Button22;SET ("BACKGROUND":6,"PEN":1,"LABEL":"3","VISIBLE":1)
  81. 810       CONTROL @Label22;SET ("PEN":0,"VALUE":"PI","VISIBLE":1)
  82. 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
  83. 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
  84. 840       CONTROL @Button23;SET ("BACKGROUND":6,"PEN":1,"LABEL":"CHS","VISIBLE":1)
  85. 850       CONTROL @Label23;SET ("PEN":0,"VALUE":"ANGL","VISIBLE":1)
  86. 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
  87. 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
  88. 880       CONTROL @Button24;SET ("BACKGROUND":6,"PEN":1,"LABEL":"CLX","VISIBLE":1)
  89. 890       CONTROL @Label24;SET ("PEN":0,"VALUE":"","VISIBLE":1)
  90. 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
  91. 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
  92. 920       CONTROL @Button25;SET ("BACKGROUND":6,"PEN":1,"LABEL":"/","VISIBLE":1)
  93. 930       CONTROL @Label25;SET ("PEN":0,"VALUE":"HEX","VISIBLE":1)
  94. 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
  95. 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
  96. 960       CONTROL @Button26;SET ("BACKGROUND":6,"PEN":1,"LABEL":"*","VISIBLE":1)
  97. 970       CONTROL @Label26;SET ("PEN":0,"VALUE":"DEC","VISIBLE":1)
  98. 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
  99. 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
  100. 1000       CONTROL @Button27;SET ("BACKGROUND":6,"PEN":1,"LABEL":"-","VISIBLE":1)
  101. 1010       CONTROL @Label27;SET ("PEN":0,"VALUE":"OCT","VISIBLE":1)
  102. 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
  103. 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
  104. 1040       CONTROL @Button28;SET ("BACKGROUND":6,"PEN":1,"LABEL":"+","VISIBLE":1)
  105. 1050       CONTROL @Label28;SET ("PEN":0,"VALUE":"BIN","VISIBLE":1)
  106. 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
  107. 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
  108. 1080       CONTROL @Button29;SET ("BACKGROUND":6,"PEN":1,"LABEL":"f","VISIBLE":1)
  109. 1090       CONTROL @Label29;SET ("PEN":0,"VALUE":"","VISIBLE":1)
  110. 1100       CONTROL @Button29;SET ("BACKGROUND":3,"PEN":0)
  111. 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
  112. 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
  113. 1130       CONTROL @Button30;SET ("BACKGROUND":6,"PEN":1,"LABEL":"SIN","VISIBLE":1)
  114. 1140       CONTROL @Label30;SET ("PEN":0,"VALUE":"ASN","VISIBLE":1)
  115. 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
  116. 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
  117. 1170       CONTROL @Button31;SET ("BACKGROUND":6,"PEN":1,"LABEL":"COS","VISIBLE":1)
  118. 1180       CONTROL @Label31;SET ("PEN":0,"VALUE":"ACS","VISIBLE":1)
  119. 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
  120. 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
  121. 1210       CONTROL @Button32;SET ("BACKGROUND":6,"PEN":1,"LABEL":"TAN","VISIBLE":1)
  122. 1220       CONTROL @Label32;SET ("PEN":0,"VALUE":"ATN","VISIBLE":1)
  123. 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
  124. 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
  125. 1250       CONTROL @Button33;SET ("BACKGROUND":6,"PEN":1,"LABEL":"10^X","VISIBLE":1)
  126. 1260       CONTROL @Label33;SET ("PEN":0,"VALUE":"LOG","VISIBLE":1)
  127. 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
  128. 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
  129. 1290       CONTROL @Button34;SET ("BACKGROUND":6,"PEN":1,"LABEL":"EEX","VISIBLE":1)
  130. 1300       CONTROL @Label34;SET ("PEN":0,"VALUE":"LN","VISIBLE":1)
  131. 1310       ON ERROR GOTO Process_error
  132. 1320       ON EVENT @Button10,"ACTIVATED" GOSUB Button10
  133. 1330       CONTROL @Label16;SET ("VISIBLE":1)
  134. 1340       ON EVENT @Button11,"ACTIVATED" GOSUB Button11
  135. 1350       ON EVENT @Button12,"ACTIVATED" GOSUB Button12
  136. 1360       ON EVENT @Button13,"ACTIVATED" GOSUB Button13
  137. 1370       ON EVENT @Button14,"ACTIVATED" GOSUB Button14
  138. 1380       ON EVENT @Button15,"ACTIVATED" GOSUB Button15
  139. 1390       ON EVENT @Button16,"ACTIVATED" GOSUB Button16
  140. 1400       ON EVENT @Button17,"ACTIVATED" GOSUB Button17
  141. 1410       ON EVENT @Button18,"ACTIVATED" GOSUB Button18
  142. 1420       ON EVENT @Button20,"ACTIVATED" GOSUB Button20
  143. 1430       ON EVENT @Button21,"ACTIVATED" GOSUB Button21
  144. 1440       ON EVENT @Button22,"ACTIVATED" GOSUB Button22
  145. 1450       ON EVENT @Button23,"ACTIVATED" GOSUB Button23
  146. 1460       ON EVENT @Button24,"ACTIVATED" GOSUB Button24
  147. 1470       ON EVENT @Button25,"ACTIVATED" GOSUB Button25
  148. 1480       ON EVENT @Button26,"ACTIVATED" GOSUB Button26
  149. 1490       ON EVENT @Button27,"ACTIVATED" GOSUB Button27
  150. 1500       ON EVENT @Button28,"ACTIVATED" GOSUB Button28
  151. 1510       ON EVENT @Button29,"ACTIVATED" GOSUB Button29
  152. 1520       ON EVENT @Button30,"ACTIVATED" GOSUB Button30
  153. 1530       ON EVENT @Button31,"ACTIVATED" GOSUB Button31
  154. 1540       ON EVENT @Button32,"ACTIVATED" GOSUB Button32
  155. 1550       ON EVENT @Button33,"ACTIVATED" GOSUB Button33
  156. 1560       ON EVENT @Button34,"ACTIVATED" GOSUB Button34
  157. 1570       LOOP
  158. 1580           WAIT FOR EVENT
  159. 1590       END LOOP
  160. 1600  Button10:!
  161. 1610       Number=7
  162. 1620       GOSUB Check_storcl
  163. 1630       IF Store_mode=0 AND Recall_mode=0 THEN
  164. 1640           GOSUB Getval
  165. 1650           IF Fkey=0 OR Base<>16 THEN
  166. 1660               Modval(Val$,Number)
  167. 1670           ELSE
  168. 1680               Modval(Val$,0,"A")
  169. 1690           END IF
  170. 1700           CONTROL @Display;SET ("VALUE":Val$)
  171. 1710       ELSE
  172. 1720           GOSUB Enable_base
  173. 1730       END IF
  174. 1740       GOSUB Check_fkey
  175. 1750       RETURN
  176. 1760  Button11:!
  177. 1770       Number=4
  178. 1780       GOSUB Check_storcl
  179. 1790       IF Store_mode=0 AND Recall_mode=0 THEN
  180. 1800           GOSUB Getval
  181. 1810           IF Fkey=0 OR Base<>16 THEN
  182. 1820               Modval(Val$,Number)
  183. 1830           ELSE
  184. 1840               Modval(Val$,0,"D")
  185. 1850           END IF
  186. 1860           CONTROL @Display;SET ("VALUE":Val$)
  187. 1870       ELSE
  188. 1880           GOSUB Enable_base
  189. 1890       END IF
  190. 1900       GOSUB Check_fkey
  191. 1910       RETURN
  192. 1920  Button12:!
  193. 1930       Number=1
  194. 1940       GOSUB Check_storcl
  195. 1950       IF Store_mode=0 AND Recall_mode=0 THEN
  196. 1960           GOSUB Getval
  197. 1970           Modval(Val$,Number)
  198. 1980           CONTROL @Display;SET ("VALUE":Val$)
  199. 1990       ELSE
  200. 2000           GOSUB Enable_base
  201. 2010       END IF
  202. 2020       GOSUB Check_fkey
  203. 2030       RETURN
  204. 2040  Button13:!
  205. 2050       Number=0
  206. 2060       GOSUB Check_storcl
  207. 2070       IF Store_mode=0 AND Recall_mode=0 THEN
  208. 2080           GOSUB Getval
  209. 2090           IF Fkey=0 THEN
  210. 2100               Modval(Val$,Number)
  211. 2110           ELSE
  212. 2120               Store_mode=1
  213. 2130               GOSUB Enable_all
  214. 2140               GOSUB Clear_fn_keys
  215. 2150               GOSUB Clear_hex_keys
  216. 2160               RETURN
  217. 2170           END IF
  218. 2180           CONTROL @Display;SET ("VALUE":Val$)
  219. 2190       ELSE
  220. 2200           GOSUB Enable_base
  221. 2210       END IF
  222. 2220       GOSUB Check_fkey
  223. 2230       RETURN
  224. 2240  Button14:!
  225. 2250       IF Fkey=0 THEN
  226. 2260           Get_dispval(@Display,Base,Val)
  227. 2270           Push_val(Val,@Display)
  228. 2280           Restart=1
  229. 2290       ELSE
  230. 2300           STOP
  231. 2310       END IF
  232. 2320       GOSUB Check_fkey
  233. 2330       RETURN
  234. 2340  Button15:!
  235. 2350       Number=8
  236. 2360       GOSUB Check_storcl
  237. 2370       IF Store_mode=0 AND Recall_mode=0 THEN
  238. 2380           GOSUB Getval
  239. 2390           IF Fkey=0 OR Base<>16 THEN
  240. 2400               Modval(Val$,Number)
  241. 2410           ELSE
  242. 2420               Modval(Val$,0,"B")
  243. 2430           END IF
  244. 2440           CONTROL @Display;SET ("VALUE":Val$)
  245. 2450       ELSE
  246. 2460           GOSUB Enable_base
  247. 2470       END IF
  248. 2480       GOSUB Check_fkey
  249. 2490       RETURN
  250. 2500  Button16:!
  251. 2510       Number=5
  252. 2520       GOSUB Check_storcl
  253. 2530       IF Store_mode=0 AND Recall_mode=0 THEN
  254. 2540           GOSUB Getval
  255. 2550           IF Fkey=0 OR (Base<>16 AND Base<>10) THEN
  256. 2560               Modval(Val$,Number)
  257. 2570           ELSE
  258. 2580               IF Base=10 THEN
  259. 2590                   GOSUB Process_e
  260. 2600               ELSE
  261. 2610                   Modval(Val$,0,"E")
  262. 2620               END IF
  263. 2630           END IF
  264. 2640           CONTROL @Display;SET ("VALUE":Val$)
  265. 2650       ELSE
  266. 2660           GOSUB Enable_base
  267. 2670       END IF
  268. 2680       GOSUB Check_fkey
  269. 2690       RETURN
  270. 2700  Button17:!
  271. 2710       Number=2
  272. 2720       GOSUB Check_storcl
  273. 2730       IF Store_mode=0 AND Recall_mode=0 THEN
  274. 2740           GOSUB Getval
  275. 2750           IF Fkey=0 THEN
  276. 2760               Modval(Val$,Number)
  277. 2770           ELSE
  278. 2780               Tentobase(Base,EXP(1),Val$,Error)
  279. 2790           END IF
  280. 2800           CONTROL @Display;SET ("VALUE":Val$)
  281. 2810       ELSE
  282. 2820           GOSUB Enable_base
  283. 2830       END IF
  284. 2840       GOSUB Check_fkey
  285. 2850       RETURN
  286. 2860  Button18:!
  287. 2870       IF Fkey=0 THEN
  288. 2880           STATUS @Display;RETURN ("VALUE":Val$)
  289. 2890           IF (POS(Val$,".")=0) THEN Val$=Val$&"."
  290. 2900           CONTROL @Display;SET ("VALUE":Val$)
  291. 2910       ELSE
  292. 2920           Recall_mode=1
  293. 2930           GOSUB Enable_all
  294. 2940           GOSUB Clear_fn_keys
  295. 2950           GOSUB Clear_hex_keys
  296. 2960       END IF
  297. 2970       GOSUB Check_fkey
  298. 2980       RETURN
  299. 2990  Button19:!
  300. 3000  Button20:!
  301. 3010       Number=9
  302. 3020       GOSUB Check_storcl
  303. 3030       IF Store_mode=0 AND Recall_mode=0 THEN
  304. 3040           GOSUB Getval
  305. 3050           IF Fkey=0 OR Base<>16 THEN
  306. 3060               Modval(Val$,Number)
  307. 3070           ELSE
  308. 3080               Modval(Val$,0,"C")
  309. 3090           END IF
  310. 3100           CONTROL @Display;SET ("VALUE":Val$)
  311. 3110       ELSE
  312. 3120           GOSUB Enable_base
  313. 3130       END IF
  314. 3140       GOSUB Check_fkey
  315. 3150       RETURN
  316. 3160  Button21:!
  317. 3170       Number=6
  318. 3180       GOSUB Check_storcl
  319. 3190       IF Store_mode=0 AND Recall_mode=0 THEN
  320. 3200           GOSUB Getval
  321. 3210           IF Fkey=0 OR Base<>16 THEN
  322. 3220               Modval(Val$,Number)
  323. 3230           ELSE
  324. 3240               Modval(Val$,0,"F")
  325. 3250           END IF
  326. 3260           CONTROL @Display;SET ("VALUE":Val$)
  327. 3270       ELSE
  328. 3280           GOSUB Enable_base
  329. 3290       END IF
  330. 3300       GOSUB Check_fkey
  331. 3310       RETURN
  332. 3320  Button22:!
  333. 3330       Number=3
  334. 3340       GOSUB Check_storcl
  335. 3350       IF Store_mode=0 AND Recall_mode=0 THEN
  336. 3360           GOSUB Getval
  337. 3370           IF Fkey=0 THEN
  338. 3380               Modval(Val$,Number)
  339. 3390           ELSE
  340. 3400               Tentobase(Base,PI,Val$,Error)
  341. 3410           END IF
  342. 3420           CONTROL @Display;SET ("VALUE":Val$)
  343. 3430       ELSE
  344. 3440           GOSUB Enable_base
  345. 3450       END IF
  346. 3460       GOSUB Check_fkey
  347. 3470       RETURN
  348. 3480  Button23:!
  349. 3490       IF Fkey=0 THEN
  350. 3500           STATUS @Display;RETURN ("VALUE":Val$)
  351. 3510           IF Base=10 THEN
  352. 3520               IF Val$[1;1]="-" THEN
  353. 3530                   Val$=Val$[2]
  354. 3540               ELSE
  355. 3550                   Val$="-"&Val$
  356. 3560               END IF
  357. 3570           ELSE
  358. 3580               Twos_comp(Base,Val$)
  359. 3590           END IF
  360. 3600           CONTROL @Display;SET ("VALUE":Val$)
  361. 3610       ELSE
  362. 3620    !* DIALOG "LIST","Trigonometric Mode",Button;SET ("ITEMS":Modes$(*),"SELECTED ITEM":Item),
  363. 3630           IF Button=0 AND Item<>-1 THEN
  364. 3640               IF Item=0 THEN DEG
  365. 3650               IF Item=1 THEN RAD
  366. 3660           END IF
  367. 3670       END IF
  368. 3680       GOSUB Check_fkey
  369. 3690       RETURN
  370. 3700  Button24:!
  371. 3710       CONTROL @Display;SET ("VALUE":0)
  372. 3720       GOSUB Check_fkey
  373. 3730       RETURN
  374. 3740  Button25:!
  375. 3750       IF Fkey=0 THEN
  376. 3760           Get_dispval(@Display,Base,Val1)
  377. 3770           Val2=FNPop_val(@Display)
  378. 3780           Val$=VAL$(Val2/Val1)
  379. 3790           Set_dispval(@Display,Base,VAL(Val$))
  380. 3800           Push_val(VAL(Val$),@Display)
  381. 3810           Restart=1
  382. 3820       ELSE
  383. 3830           Get_dispval(@Display,Base,Val1)
  384. 3840           Base=16
  385. 3850           Set_dispval(@Display,Base,Val1)
  386. 3860           CONTROL @Label10;SET ("VISIBLE":1)
  387. 3870           CONTROL @Label11;SET ("VISIBLE":1)
  388. 3880           CONTROL @Label15;SET ("VISIBLE":1)
  389. 3890           CONTROL @Label16;SET ("VISIBLE":1)
  390. 3900           CONTROL @Label20;SET ("VISIBLE":1)
  391. 3910           CONTROL @Label21;SET ("VISIBLE":1)
  392. 3920           GOSUB Enable_all
  393. 3930       END IF
  394. 3940       GOSUB Check_fkey
  395. 3950       RETURN
  396. 3960  Button26:!
  397. 3970       IF Fkey=0 THEN
  398. 3980           Get_dispval(@Display,Base,Val1)
  399. 3990           Val2=FNPop_val(@Display)
  400. 4000           Val$=VAL$(Val2*Val1)
  401. 4010           Set_dispval(@Display,Base,VAL(Val$))
  402. 4020           Push_val(VAL(Val$),@Display)
  403. 4030           Restart=1
  404. 4040       ELSE
  405. 4050           Get_dispval(@Display,Base,Val1)
  406. 4060           Base=10
  407. 4070           Set_dispval(@Display,Base,Val1)
  408. 4080           GOSUB Enable_all
  409. 4090           GOSUB Clear_hex_keys
  410. 4100           CONTROL @Label16;SET ("VISIBLE":1)
  411. 4110       END IF
  412. 4120       GOSUB Check_fkey
  413. 4130       RETURN
  414. 4140  Button27:!
  415. 4150       IF Fkey=0 THEN
  416. 4160           Get_dispval(@Display,Base,Val1)
  417. 4170           Val2=FNPop_val(@Display)
  418. 4180           Val$=VAL$(Val2-Val1)
  419. 4190           Set_dispval(@Display,Base,VAL(Val$))
  420. 4200           Push_val(VAL(Val$),@Display)
  421. 4210           Restart=1
  422. 4220       ELSE
  423. 4230           Get_dispval(@Display,Base,Val1)
  424. 4240           Base=8
  425. 4250           Set_dispval(@Display,Base,Val1)
  426. 4260           GOSUB Enable_all
  427. 4270           GOSUB Clear_nonoct
  428. 4280       END IF
  429. 4290       GOSUB Check_fkey
  430. 4300       RETURN
  431. 4310  Button28:!
  432. 4320       IF Fkey=0 THEN
  433. 4330           Get_dispval(@Display,Base,Val1)
  434. 4340           Val2=FNPop_val(@Display)
  435. 4350           Val$=VAL$(Val1+Val2)
  436. 4360           Push_val(VAL(Val$),@Display)
  437. 4370           Set_dispval(@Display,Base,VAL(Val$))
  438. 4380           Restart=1
  439. 4390       ELSE
  440. 4400           Get_dispval(@Display,Base,Val1)
  441. 4410           Base=2
  442. 4420           Set_dispval(@Display,Base,Val1)
  443. 4430           GOSUB Enable_all
  444. 4440           GOSUB Clear_nonbin
  445. 4450       END IF
  446. 4460       GOSUB Check_fkey
  447. 4470       RETURN
  448. 4480  Button29:!
  449. 4490       Fkey=(Fkey+1) MOD 2
  450. 4500       IF Fkey=1 THEN
  451. 4510           CONTROL @Display;SET ("PEN":3)
  452. 4520           GOSUB Enable_pi
  453. 4530       ELSE
  454. 4540           CONTROL @Display;SET ("PEN":2)
  455. 4550           GOSUB Enable_base
  456. 4560       END IF
  457. 4570       RETURN
  458. 4580  Button30:!
  459. 4590       Get_dispval(@Display,Base,Val1)
  460. 4600       IF Fkey=0 THEN
  461. 4610           Val$=VAL$(SIN(Val1))
  462. 4620       ELSE
  463. 4630           Val$=VAL$(ASN(Val1))
  464. 4640       END IF
  465. 4650       Set_dispval(@Display,Base,VAL(Val$))
  466. 4660       Push_val(VAL(Val$),@Display)
  467. 4670       Restart=1
  468. 4680       GOSUB Check_fkey
  469. 4690       RETURN
  470. 4700  Button31:!
  471. 4710       Get_dispval(@Display,Base,Val1)
  472. 4720       IF Fkey=0 THEN
  473. 4730           Val$=VAL$(COS(Val1))
  474. 4740       ELSE
  475. 4750           Val$=VAL$(ACS(Val1))
  476. 4760       END IF
  477. 4770       Set_dispval(@Display,Base,VAL(Val$))
  478. 4780       Push_val(VAL(Val$),@Display)
  479. 4790       Restart=1
  480. 4800       GOSUB Check_fkey
  481. 4810       RETURN
  482. 4820  Button32:!
  483. 4830       Get_dispval(@Display,Base,Val1)
  484. 4840       IF Fkey=0 THEN
  485. 4850           Val$=VAL$(TAN(Val1))
  486. 4860       ELSE
  487. 4870           Val$=VAL$(ATN(Val1))
  488. 4880       END IF
  489. 4890       Set_dispval(@Display,Base,VAL(Val$))
  490. 4900       Push_val(VAL(Val$),@Display)
  491. 4910       Restart=1
  492. 4920       GOSUB Check_fkey
  493. 4930       RETURN
  494. 4940  Button33:!
  495. 4950       Get_dispval(@Display,Base,Val1)
  496. 4960       IF Fkey=0 THEN
  497. 4970           Val$=VAL$(10^Val1)
  498. 4980       ELSE
  499. 4990           Val$=VAL$(LGT(Val1))
  500. 5000       END IF
  501. 5010       Set_dispval(@Display,Base,VAL(Val$))
  502. 5020       Push_val(VAL(Val$),@Display)
  503. 5030       Restart=1
  504. 5040       GOSUB Check_fkey
  505. 5050       RETURN
  506. 5060  Button34:!
  507. 5070       Get_dispval(@Display,Base,Val1)
  508. 5080       IF Fkey=0 THEN
  509. 5090           Val$=VAL$(EXP(Val1))
  510. 5100       ELSE
  511. 5110           Val$=VAL$(LOG(Val1))
  512. 5120       END IF
  513. 5130       Set_dispval(@Display,Base,VAL(Val$))
  514. 5140       Push_val(VAL(Val$),@Display)
  515. 5150       Restart=1
  516. 5160       GOSUB Check_fkey
  517. 5170       RETURN
  518. 5180  Clear_nonbin:!
  519. 5190       CONTROL @Button17;SET ("SENSITIVE":0)
  520. 5200       CONTROL @Button22;SET ("SENSITIVE":0)
  521. 5210       CONTROL @Button11;SET ("SENSITIVE":0)
  522. 5220       CONTROL @Button16;SET ("SENSITIVE":0)
  523. 5230       CONTROL @Button21;SET ("SENSITIVE":0)
  524. 5240       CONTROL @Button10;SET ("SENSITIVE":0)
  525. 5250  Clear_nonoct:!
  526. 5260       CONTROL @Button15;SET ("SENSITIVE":0)
  527. 5270       CONTROL @Button20;SET ("SENSITIVE":0)
  528. 5280  Clear_hex_keys:!
  529. 5290       CONTROL @Label10;SET ("VISIBLE":0)
  530. 5300       CONTROL @Label11;SET ("VISIBLE":0)
  531. 5310       CONTROL @Label15;SET ("VISIBLE":0)
  532. 5320       CONTROL @Label16;SET ("VISIBLE":0)
  533. 5330       CONTROL @Label20;SET ("VISIBLE":0)
  534. 5340       CONTROL @Label21;SET ("VISIBLE":0)
  535. 5350       RETURN
  536. 5360  Clear_fn_keys:!
  537. 5370       CONTROL @Button29;SET ("SENSITIVE":0)
  538. 5380       CONTROL @Button23;SET ("SENSITIVE":0)
  539. 5390       CONTROL @Button30;SET ("SENSITIVE":0)
  540. 5400       CONTROL @Button32;SET ("SENSITIVE":0)
  541. 5410       CONTROL @Button31;SET ("SENSITIVE":0)
  542. 5420       CONTROL @Button24;SET ("SENSITIVE":0)
  543. 5430       CONTROL @Button34;SET ("SENSITIVE":0)
  544. 5440       CONTROL @Button33;SET ("SENSITIVE":0)
  545. 5450       CONTROL @Button26;SET ("SENSITIVE":0)
  546. 5460       CONTROL @Button14;SET ("SENSITIVE":0)
  547. 5470       CONTROL @Button28;SET ("SENSITIVE":0)
  548. 5480       CONTROL @Button27;SET ("SENSITIVE":0)
  549. 5490       CONTROL @Button18;SET ("SENSITIVE":0)
  550. 5500       CONTROL @Button25;SET ("SENSITIVE":0)
  551. 5510       RETURN
  552. 5520  Enable_all:!
  553. 5530       CONTROL @Button13;SET ("SENSITIVE":1)
  554. 5540       CONTROL @Button12;SET ("SENSITIVE":1)
  555. 5550       CONTROL @Button17;SET ("SENSITIVE":1)
  556. 5560       CONTROL @Button22;SET ("SENSITIVE":1)
  557. 5570       CONTROL @Button11;SET ("SENSITIVE":1)
  558. 5580       CONTROL @Button16;SET ("SENSITIVE":1)
  559. 5590       CONTROL @Button21;SET ("SENSITIVE":1)
  560. 5600       CONTROL @Button10;SET ("SENSITIVE":1)
  561. 5610       CONTROL @Button15;SET ("SENSITIVE":1)
  562. 5620       CONTROL @Button20;SET ("SENSITIVE":1)
  563. 5630       CONTROL @Button29;SET ("SENSITIVE":1)
  564. 5640       CONTROL @Button23;SET ("SENSITIVE":1)
  565. 5650       CONTROL @Button30;SET ("SENSITIVE":1)
  566. 5660       CONTROL @Button32;SET ("SENSITIVE":1)
  567. 5670       CONTROL @Button31;SET ("SENSITIVE":1)
  568. 5680       CONTROL @Button24;SET ("SENSITIVE":1)
  569. 5690       CONTROL @Button34;SET ("SENSITIVE":1)
  570. 5700       CONTROL @Button33;SET ("SENSITIVE":1)
  571. 5710       CONTROL @Button26;SET ("SENSITIVE":1)
  572. 5720       CONTROL @Button14;SET ("SENSITIVE":1)
  573. 5730       CONTROL @Button28;SET ("SENSITIVE":1)
  574. 5740       CONTROL @Button27;SET ("SENSITIVE":1)
  575. 5750       CONTROL @Button18;SET ("SENSITIVE":1)
  576. 5760       CONTROL @Button25;SET ("SENSITIVE":1)
  577. 5770       RETURN
  578. 5780  Enable_e:!
  579. 5790       CONTROL @Label16;SET ("VISIBLE":1)
  580. 5800       RETURN
  581. 5810  Enable_pi:!
  582. 5820       CONTROL @Button22;SET ("SENSITIVE":1)
  583. 5830       CONTROL @Button17;SET ("SENSITIVE":1)
  584. 5840       RETURN
  585. 5850  Enable_base:!
  586. 5860       Recall_mode=0
  587. 5870       Store_mode=0
  588. 5880       GOSUB Enable_all
  589. 5890       IF Base=2 THEN GOSUB Clear_nonbin
  590. 5900       IF Base=8 THEN GOSUB Clear_nonoct
  591. 5910       IF Base=10 THEN
  592. 5920           GOSUB Clear_hex_keys
  593. 5930           GOSUB Enable_e
  594. 5940       END IF
  595. 5950       RETURN
  596. 5960  Check_storcl:!
  597. 5970       IF Store_mode THEN
  598. 5980           Get_dispval(@Display,Base,Val1)
  599. 5990           Mem(Number)=Val1
  600. 6000       ELSE
  601. 6010           IF Recall_mode THEN
  602. 6020               Val1=Mem(Number)
  603. 6030               Set_dispval(@Display,Base,Val1)
  604. 6040           END IF
  605. 6050       END IF
  606. 6060       RETURN
  607. 6070  Resized: RETURN
  608. 6080  Process_e:!
  609. 6090       IF (POS(Val$,"E")=0) THEN Val$=Val$&"E"
  610. 6100       RETURN
  611. 6110  Process_error:!
  612. 6120       IF Fkey=1 THEN CONTROL @Display;SET ("PEN":2)
  613. 6130       Fkey=0
  614. 6140       STATUS @Display;RETURN ("VALUE":Tmp$)
  615. 6150       CONTROL @Display;SET ("VALUE":ERRM$)
  616. 6160       WAIT 2
  617. 6170       CONTROL @Display;SET ("VALUE":Tmp$)
  618. 6180       RETURN
  619. 6190  Getval:!
  620. 6200       IF Restart THEN
  621. 6210           Restart=0
  622. 6220           Val$="0"
  623. 6230       ELSE
  624. 6240           STATUS @Display;RETURN ("VALUE":Val$)
  625. 6250       END IF
  626. 6260       RETURN
  627. 6270  Check_fkey:!
  628. 6280       IF Fkey=1 THEN
  629. 6290           CONTROL @Display;SET ("PEN":2)
  630. 6300           GOSUB Enable_base
  631. 6310       END IF
  632. 6320       Fkey=0
  633. 6330       RETURN
  634. 6340  Finis: END
  635. 6350  !    
  636. 6360       SUB Push_val(REAL Val,@Disp)
  637. 6370           COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(*)
  638. 6380           Stack(Stack_ptr)=Val
  639. 6390           IF Stack_ptr<=Max_stack THEN
  640. 6400               Stack_ptr=Stack_ptr+1
  641. 6410           ELSE
  642. 6420               BEEP
  643. 6430               STATUS @Disp;RETURN ("VALUE":Tmpval$)
  644. 6440               CONTROL @Disp;SET ("VALUE":"ERROR: STACK OVERFLOW!!!")
  645. 6450               WAIT 2
  646. 6460               CONTROL @Disp;SET ("VALUE":Tmpval$)
  647. 6470               SUBEXIT
  648. 6480           END IF
  649. 6490       SUBEND
  650. 6500       DEF FNPop_val(@Disp)
  651. 6510           COM /Stack_com/ INTEGER Max_stack,Stack_ptr,REAL Stack(*)
  652. 6520           IF Stack_ptr>0 THEN
  653. 6530               Stack_ptr=Stack_ptr-1
  654. 6540           ELSE
  655. 6550               BEEP
  656. 6560               STATUS @Disp;RETURN ("VALUE":Tmpval$)
  657. 6570               CONTROL @Disp;SET ("VALUE":"ERROR: STACK UNDERFLOW!!!")
  658. 6580               WAIT 2
  659. 6590               CONTROL @Disp;SET ("VALUE":Tmpval$)
  660. 6600               RETURN 0
  661. 6610           END IF
  662. 6620           RETURN Stack(Stack_ptr)
  663. 6630       FNEND
  664. 6640       DEF FNGetval(A$)
  665. 6650           IF NUM(A$)>=NUM("0") AND NUM(A$)<=NUM("9") THEN
  666. 6660               RETURN VAL(A$)
  667. 6670           ELSE
  668. 6680               RETURN NUM(A$)-55
  669. 6690           END IF
  670. 6700       FNEND
  671. 6710       DEF FNGetval$(A)
  672. 6720           IF A>=10 THEN
  673. 6730               RETURN CHR$(A+NUM("A")-10)
  674. 6740           ELSE
  675. 6750               RETURN VAL$(A)
  676. 6760           END IF
  677. 6770       FNEND
  678. 6780       SUB Basetoten(Base,Value,Str$)
  679. 6790           IF Base=10 THEN
  680. 6800               Value=VAL(Str$)
  681. 6810               SUBEXIT
  682. 6820           END IF
  683. 6830           Sign=0
  684. 6840           IF LEN(Str$)=MAXLEN(Str$) AND FNGetval$(Base-1)=Str$[1;1] THEN
  685. 6850               Sign=1
  686. 6860               Twos_comp(Base,Str$)
  687. 6870           END IF
  688. 6880           Value=0.
  689. 6890           Max=LEN(Str$)
  690. 6900           IF POS(Str$,".")<>0 THEN Max=POS(Str$,".")-1
  691. 6910           FOR I=1 TO Max
  692. 6920               Value=Base*Value+FNGetval(Str$[I;1])
  693. 6930           NEXT I
  694. 6940           IF POS(Str$,".")<>0 THEN
  695. 6950               J=0
  696. 6960               FOR I=Max+2 TO LEN(Str$)
  697. 6970                   J=J+1
  698. 6980                   Value=Value+FNGetval(Str$[I;1])*Base^(-J)
  699. 6990               NEXT I
  700. 7000           END IF
  701. 7010           IF Sign=1 THEN
  702. 7020               Value=-Value
  703. 7030               Twos_comp(Base,Str$)
  704. 7040           END IF
  705. 7050       SUBEND
  706. 7060       SUB Tentobase(Base,Value,Str$,Error)
  707. 7070           Error=0
  708. 7080           Str$=""
  709. 7090           IF Base=10 THEN
  710. 7100               Str$=VAL$(Value)
  711. 7110               SUBEXIT
  712. 7120           END IF
  713. 7130           Sign=0
  714. 7140           IF Value<0 THEN
  715. 7150               Sign=1
  716. 7160               Value=-Value
  717. 7170           END IF
  718. 7180           Divisor1=Value DIV 1
  719. 7190           I=1
  720. 7200           WHILE Divisor1<>0
  721. 7210               IF I>=MAXLEN(Str$) THEN GOTO Length_err
  722. 7220               Str$[I;1]=FNGetval$(Divisor1 MOD Base)
  723. 7230               I=I+1
  724. 7240               Divisor1=Divisor1 DIV Base
  725. 7250           END WHILE
  726. 7260           Str$=REV$(Str$)
  727. 7270           Divisor2=(Value-Value DIV 1)
  728. 7280           I=1
  729. 7290           IF Divisor2<>0 THEN
  730. 7300               Str2$[I;1]="."
  731. 7310               I=I+1
  732. 7320           END IF
  733. 7330           WHILE Divisor2<>0
  734. 7340               Divisor2=Divisor2*Base
  735. 7350               Str2$[I;1]=FNGetval$(Divisor2 DIV 1)
  736. 7360               Divisor2=Divisor2-Divisor2 DIV 1
  737. 7370               I=I+1
  738. 7380               IF I>MAXLEN(Str2$) THEN Divisor2=0
  739. 7390           END WHILE
  740. 7400           IF LEN(Str$)+LEN(Str2$)>MAXLEN(Str$) THEN GOTO Length_err
  741. 7410           Str$=Str$&Str2$
  742. 7420           IF Sign=1 THEN
  743. 7430               Value=-Value
  744. 7440               Twos_comp(Base,Str$)
  745. 7450           END IF
  746. 7460           IF Value=0 THEN Str$="0"
  747. 7470           SUBEXIT
  748. 7480  Length_err:!
  749. 7490           Error=1
  750. 7500           IF Sign=1 THEN Value=-Value
  751. 7510       SUBEND
  752. 7520       SUB Get_dispval(@Disp,Src_base,Value)
  753. 7530           DIM Str$[64]
  754. 7540           STATUS @Disp;RETURN ("VALUE":Str$)
  755. 7550           IF Dest_base<>10 THEN
  756. 7560               Basetoten(Src_base,Value,Str$)
  757. 7570           ELSE
  758. 7580               Value=VAL(Str$)
  759. 7590           END IF
  760. 7600       SUBEND
  761. 7610       SUB Set_dispval(@Disp,Dest_base,Value)
  762. 7620           DIM Value$[64]
  763. 7630           IF Dest_base<>10 THEN
  764. 7640               Tentobase(Dest_base,Value,Value$,Error)
  765. 7650           ELSE
  766. 7660               Value$=VAL$(Value)
  767. 7670           END IF
  768. 7680           IF Error=0 THEN
  769. 7690               CONTROL @Disp;SET ("VALUE":Value$)
  770. 7700           ELSE
  771. 7710               CONTROL @Disp;SET ("VALUE":"ERROR: Value out of range.")
  772. 7720               WAIT 3
  773. 7730               CONTROL @Disp;SET ("VALUE":0)
  774. 7740           END IF
  775. 7750       SUBEND
  776. 7760       SUB Twos_comp(Base,Str$)
  777. 7770           DIM Tmpstr$[64]
  778. 7780           Tmpstr$=RPT$(FNGetval$(Base-1),64)
  779. 7790           FOR I=1 TO LEN(Str$)
  780. 7800               IF Str$[I;1]<>"." THEN
  781. 7810                   Tmpstr$[MAXLEN(Str$)-LEN(Str$)+I]=FNGetval$(Base-FNGetval(Str$[I;1])-1)
  782. 7820               ELSE
  783. 7830                   Tmpstr$[MAXLEN(Str$)-LEN(Str$)+I]=Str$[I;1]
  784. 7840               END IF
  785. 7850           NEXT I
  786. 7860           Carry=1
  787. 7870           Str$=""
  788. 7880           FOR I=MAXLEN(Tmpstr$) TO 1 STEP -1
  789. 7890               IF Tmpstr$[I;1]<>"." THEN
  790. 7900                   Num=FNGetval(Tmpstr$[I;1])
  791. 7910                   Nextnum=(Num+Carry) MOD Base
  792. 7920                   Str$=FNGetval$(Nextnum)&Str$
  793. 7930                   Carry=(Num+Carry) DIV Base
  794. 7940                   IF Carry=0 THEN GOTO Bail_out
  795. 7950               ELSE
  796. 7960                   Str$="."&Str$
  797. 7970               END IF
  798. 7980           NEXT I
  799. 7990           SUBEXIT
  800. 8000  Bail_out: Str$=Tmpstr$[1,I-1]&Str$
  801. 8010       SUBEND
  802. 8020       SUB Modval(Val$,Value,OPTIONAL Str$)
  803. 8030           IF NPAR>2 THEN
  804. 8040               IF Val$="0" THEN Val$=""
  805. 8050               Val$=Val$&Str$
  806. 8060           ELSE
  807. 8070               IF Val$="0" THEN Val$=""
  808. 8080               Val$=Val$&VAL$(Value)
  809. 8090           END IF
  810. 8100       SUBEND
  811.