home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / TSRBAS20.ZIP / CALC.BAS next >
Encoding:
BASIC Source File  |  1991-04-03  |  4.4 KB  |  174 lines
  1. 1000 ' calc.bas - simple terminate and stay resident calculator
  2. 1010 '
  3. 1020 ' press esc to terminate and stay resident
  4. 1030 ' press control-shift-b from dos to resume calculator 
  5. 1040 ' press control-c to terminate calculator
  6. 1050 '
  7. 1060 on error goto 2660
  8. 1070 first_suspend = 1
  9. 1080 csroff
  10. 1090 foreground lookup ("white")
  11. 1100 background lookup ("black")
  12. 1110 intensity lookup ("high")
  13. 1120 wintop 0
  14. 1130 winleft 59
  15. 1140 winbottom 7
  16. 1150 winright 75
  17. 1160 border
  18. 1170 cls
  19. 1180 '
  20. 1190 ' the following line sets up a window for debug messages
  21. 1200 ' that can be displayed using print:
  22. 1210 '
  23. 1220 ' wintop 10 : winleft 0: winbottom 20 : winright 79 : border : cls
  24. 1230 '
  25. 1240 display 2, 60, copy (chr (196), 15)
  26. 1250 display 3, 60, " 7  8  9"
  27. 1260 display 4, 60, " 4  5  6"
  28. 1270 display 5, 60, " 1  2  3"
  29. 1280 display 6, 60, " 0  .  c"
  30. 1290 foreground lookup ("red")
  31. 1300 display 3, 70, "+  ^"
  32. 1310 display 4, 70, "-  ("
  33. 1320 display 5, 70, "*  )"
  34. 1330 display 6, 70, "/  ="
  35. 1340 this_key = ""
  36. 1350 expr = ""
  37. 1360 '
  38. 1370 ' main command loop, get a key-code and convert to character
  39. 1380 '
  40. 1390 gosub 2540 ' display expr
  41. 1400 last_key = this_key
  42. 1410 this_key = chr (getkey() mod 256)
  43. 1420 '
  44. 1430 ' if key is control-c then re-initialize and exit
  45. 1440 '
  46. 1450 if this_key = chr (3) ' control-c
  47. 1460    then
  48. 1470       init
  49. 1480       cls
  50. 1490       end
  51. 1500 end if
  52. 1510 '
  53. 1520 ' if key is escape then suspend to dos or application
  54. 1530 '
  55. 1540 if this_key = chr (27) ' escape
  56. 1550    then
  57. 1560       if first_suspend
  58. 1570          then
  59. 1580             first_suspend = 0
  60. 1590             blank
  61. 1600       end if
  62. 1610       suspend
  63. 1620       goto 1080
  64. 1630 end if
  65. 1640 ' 
  66. 1650 ' if key is backspace erase last character entered
  67. 1660 '
  68. 1670 if this_key = chr (8) ' backspace
  69. 1680    then
  70. 1690       expr_len = len (expr)
  71. 1700       if expr_len > 0
  72. 1710          then
  73. 1720             expr = left (expr, expr_len-1)
  74. 1730          else
  75. 1740             beep
  76. 1750    end if
  77. 1760    goto 1360
  78. 1770 end if
  79. 1780 '
  80. 1790 ' if key is a digit or decimal point then append to expression
  81. 1800 '
  82. 1810 if this_key >= "0" and this_key <= "9" or this_key = "."
  83. 1820    then
  84. 1830       if last_key = "=" or last_key = chr (13)
  85. 1840          then
  86. 1850             expr = this_key
  87. 1860          else
  88. 1870             expr = cat (expr, this_key)
  89. 1880       end if
  90. 1890       goto 1360
  91. 1900 end if
  92. 1910 '
  93. 1920 ' if input was an operator then append it to execute string
  94. 1930 '
  95. 1940 if instr ("+-*/^", this_key)
  96. 1950    then
  97. 1960       '
  98. 1970       ' handle adjacent operators
  99. 1980       '
  100. 1990       if instr ("+-*/^", right (expr, 1))
  101. 2000          then
  102. 2010             expr = left (expr, len (expr) - 1)
  103. 2020       end if
  104. 2030       expr = cat (expr, this_key)
  105. 2040       goto 1360
  106. 2050 end if
  107. 2060 '
  108. 2070 ' if input was an equal sign then evaluate expression
  109. 2080 '
  110. 2090 if this_key = "="    or this_key = chr (13)
  111. 2100    then
  112. 2110       if expr <> ""
  113. 2120          then
  114. 2130             execute "expr = " + expr
  115. 2140       end if
  116. 2150       goto 1360
  117. 2160 end if
  118. 2170 '
  119. 2180 ' if input was the clear key then re-initialize everything
  120. 2190 '
  121. 2200 if this_key = "c"
  122. 2210    then
  123. 2220       expr = ""
  124. 2230       goto 1360
  125. 2240 end if
  126. 2250 '
  127. 2260 ' if input is a left paren and last char in execute
  128. 2270 ' string was an operator then append it to execute string
  129. 2280 '
  130. 2290 if this_key = "("
  131. 2300    then
  132. 2310       if instr ("+-*/^(", right (expr, 1)) 
  133. 2320          then
  134. 2330             expr = expr + this_key
  135. 2340       end if
  136. 2350       goto 1360
  137. 2360 end if
  138. 2370 '
  139. 2380 ' if input is a right paren and last char in execute
  140. 2390 ' string was NOT an operator then append it to execute string
  141. 2400 '
  142. 2410 if this_key = ")"
  143. 2420    then
  144. 2430       if not instr ("+-*/^(", right (expr, 1)) 
  145. 2440          then
  146. 2450             expr = expr + this_key
  147. 2460       end if
  148. 2470       goto 1360
  149. 2480 end if
  150. 2490 '
  151. 2500 ' if key was not valid signal error and get next keystroke
  152. 2510 '
  153. 2520 beep
  154. 2530 goto 1360
  155. 2540 '
  156. 2550 ' subroutine to display expr 
  157. 2560 '
  158. 2570 if expr = ""
  159. 2580    then
  160. 2590       display_expr = 0
  161. 2600    else
  162. 2610       display_expr = right (expr, 14)
  163. 2620 end if
  164. 2630 display 1, 60, space (15)
  165. 2640 display 1, 74 - len (display_expr), display_expr
  166. 2650 return
  167. 2660 '
  168. 2670 ' error handler
  169. 2680 '
  170. 2690 expr = "Error"
  171. 2700 gosub 2540 ' display expr
  172. 2710 beep
  173. 2720 resume 1350
  174.