home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64Software / HAL.ARC / HALCULATOR (.txt) < prev    next >
Commodore BASIC  |  2019-04-13  |  7KB  |  183 lines
  1. 10 REM **** CALCULATOR ROUTINES ****
  2. 15 DIMS$(250):PRINT"[147]":GOSUB505:GOSUB370:GOSUB540
  3. 20 IFPEEK(53247)<>88THEN715
  4. 25 GOSUB560
  5. 30 Z=0
  6. 35 IFBA<>10THENS$(Z)=H$:Z=Z+3:GOTO45
  7. 40 S$(Z)=D$:Z=Z+3
  8. 45 GETA$:IFA$=""THEN45:REM SCAN KEYS
  9. 50 IFA$="H"THEN880
  10. 55 IFF6=0THENPOKES+1,80+4*F7*VAL(A$):POKES,177:POKES+4,33:FORT=1TO20:NEXT:POKES+4,32
  11. 60 IFBA<>10THEN635
  12. 65 FORI=1TO15:IFA$=MID$(N$,I,1)THEN80
  13. 70 NEXT
  14. 75 GOTO145:REM A$ NOT NUMERIC
  15. 80 REM ADD TO D$
  16. 85 IF(A$="-"ORA$="+")THEN95
  17. 90 GOTO100
  18. 95 IF(F3<>0ANDRIGHT$(D$,1)<>"E")ORF5=1THEN145
  19. 100 IFD$=" 0"ORF4=1THEND$=" ":F1=0:F2=0:F3=0:F4=0:M=0
  20. 105 F3=1
  21. 110 IFA$="_"THEND$=LEFT$(D$,LEN(D$)-1):F1=0:F2=0:GOSUB560:GOTO45
  22. 115 IFA$="."ANDF1=1THEN45
  23. 120 IFA$="E"ANDF2=1THEN45
  24. 125 IFA$="."THENF1=1
  25. 130 IFA$="E"THENF2=1:F1=1
  26. 135 IFLEN(D$)<15THEND$=D$+A$
  27. 140 GOSUB560:GOTO45
  28. 145 M=0:F1=0:IF BA<>10THENS$(Z)=H$:Z=Z+1:GOTO155
  29. 150 S$(Z)=D$:Z=Z+1
  30. 155 DD=0:FORI=1TOLEN(OP$):IFA$=MID$(OP$,I,1)THEN180
  31. 160 NEXTI:IFA$="[133]"THENZ=Z-1:GOTO665
  32. 165 IFA$="C"THENZ=Z-1:GOTO745
  33. 170 IFA$="[135]"THENF6=-(F6=0):IFF6=1THENF7=-(F7=0)
  34. 175 GOTO45
  35. 180 F4=1:F5=1:D=VAL(D$):D$=STR$(D)
  36. 185 ONIGOTO245,240,240,240,240,240,240,275,190,195,200,200,280,285,325,330,335
  37. 190 D$=" 0":F3=0:F5=0:OP=O:A=0:GOSUB560:S$(Z)="CLEAR DISPLAY":Z=Z+1:GOTO45
  38. 195 FORI=1TO8:R(I)=0:NEXT:GOSUB540:FORI=1TOZ:S$(I)="":NEXT:Z=1:GOTO45
  39. 200 IFA$="S"THENPRINT"SAVE TO REG.#?":GOTO210
  40. 205 PRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]RECALL REG.#?"
  41. 210 GETB$:IFB$=""THEN210
  42. 215 IFB$=CHR$(13)THEN190
  43. 220 J=VAL(B$):IFJ>=1ANDJ<=8THEN230
  44. 225 GOTO200
  45. 230 IFA$="R"THENS$(Z)="RECALL #"+B$:Z=Z+1:D$=STR$(R(J)):GOSUB560:GOTO45
  46. 235 R(J)=VAL(D$):S$(Z)="SAVE TO #"+B$:Z=Z+1:GOSUB560:GOSUB540:GOTO45
  47. 240 GOSUB290:OP=I:A=VAL(D$):S$(Z)=A$:Z=Z+1:GOSUB560:GOTO45
  48. 245 S$(Z)="= ":Z=Z+1:ONOPGOTO45,250,255,260,260,265,270
  49. 250 D$=STR$(A+VAL(D$)):GOSUB560:A=0:OP=0:GOTO35
  50. 255 D$=STR$(A-VAL(D$)):GOSUB560:A=0:OP=0:GOTO35
  51. 260 D$=STR$(A*VAL(D$)):GOSUB560:A=0:OP=0:GOTO35
  52. 265 D$=STR$(A/VAL(D$)):GOSUB560:A=0:OP=0:GOTO35
  53. 270 D$=STR$(A^VAL(D$)):GOSUB560:A=0:OP=0:GOTO35
  54. 275 D$=STR$(ABS(D)^.5):S$(Z)="SQUARE ROOT ":Z=Z+1:GOSUB560:GOTO35
  55. 280 D$=STR$(LOG(ABS(D))):S$(Z)="LN ":Z=Z+1:GOSUB560:GOTO35
  56. 285 D$=STR$(LOG(ABS(D))/LOG(10)):S$(Z)="LOG ":Z=Z+1:GOSUB560:GOTO35
  57. 290 ONOPGOTO45,295,300,305,305,310,315,320,320,320,320,320,320,320
  58. 295 D$=STR$(A+VAL(D$)):F3=0:F5=0:RETURN
  59. 300 D$=STR$(A-VAL(D$)):F3=0:F5=0:RETURN
  60. 305 D$=STR$(A*VAL(D$)):F3=0:F5=0:RETURN
  61. 310 D$=STR$(A/VAL(D$)):F3=0:F5=0:RETURN
  62. 315 D$=STR$(A^VAL(D$)):F3=0:F5=0:RETURN
  63. 320 D$=STR$(VAL(D$)):F3=0:F5=0:RETURN
  64. 325 BA=16:BA$="    ":GOTO355
  65. 330 BA=10:BA$="    ":GOTO355
  66. 335 PRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]BASE";
  67. 340 INPUTBA$:BA=VAL(MID$(BA$,49,2)):IFBA<2ORBA>73THEN335
  68. 345 BA$="    ":IFBA=10ORBA=16ORBA=8ORBA=2THEN355
  69. 350 BA$="<"+RIGHT$(STR$(BA),LEN(STR$(BA))-1)+">":IFBA<10THENBA$=BA$+" "
  70. 355 PRINT"[194]      "BA$
  71. 360 S$(Z)="BASE"+STR$(BA):Z=Z+1
  72. 365 GOSUB560:GOSUB540:A$="=":GOTO245
  73. 370 PRINT"[147]";:REM PRINT SCREEN
  74. 375 PRINT"                       [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  75. 380 PRINT"[155][213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201] [[158]1][194]               [194]";
  76. 385 PRINT"[155][194] [154]   HALCULATOR  [146][155] [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  77. 390 PRINT"[155][194]                 [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  78. 395 PRINT"[155][194][213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201][155][194] [[158]2][194]               [194]";
  79. 400 PRINT"[155][194][194]               [194][155][194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  80. 405 PRINT"[155][194][202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203][155][194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  81. 410 PRINT"[155][194]                 [194] [[158]3][194]               [194]";
  82. 415 PRINT"[155][194]                 [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  83. 420 PRINT"[155][194]  [152][213][195][201][213][195][201][213][195][201][213][195][201] [155]  [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  84. 425 PRINT"[155][194] [152] [194][155]S[152][194][194][155]R[152][194][194][155]C[152][194][194][155][206][152][194][155]   [194] [[158]4][194]               [194]";
  85. 430 PRINT"[155][194]  [152][202][195][203][202][195][203][202][195][203][202][195][203] [155]  [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  86. 435 PRINT"[155][194]  [152][213][195][201][213][195][201][213][195][201][213][195][201] [155]  [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  87. 440 PRINT"[155][194] [152] [194][155]7[152][194][194][155]8[152][194][194][155]9[152][194][194][155]*[152][194][155]   [194] [[158]5][194]               [194]";
  88. 445 PRINT"[155][194]  [152][202][195][203][202][195][203][202][195][203][202][195][203] [155]  [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  89. 450 PRINT"[155][194]  [152][213][195][201][213][195][201][213][195][201][213][195][201] [155]  [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  90. 455 PRINT"[155][194]  [152][194][155]4[152][194][194][155]5[152][194][194][155]6[152][194][194][155][195][152][194][155]   [194] [[158]6][194]               [194]";
  91. 460 PRINT"[155][194]  [152][202][195][203][202][195][203][202][195][203][202][195][203] [155]  [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  92. 465 PRINT"[155][194]  [152][213][195][201][213][195][201][213][195][201][213][195][201] [155]  [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  93. 470 PRINT"[155][194]  [152][194][155]1[152][194][194][155]2[152][194][194][155]3[152][194][194][155][219][152][194][155]   [194] [[158]7][194]               [194]";
  94. 475 PRINT"[155][194]  [152][202][195][203][202][195][203][202][195][203][202][195][203] [155]  [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  95. 480 PRINT"[155][194]  [152][213][195][195][195][201] [213][195][201][213][195][201] [155]  [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  96. 485 PRINT"[155][194]  [152][194][155] 0 [152][194] [194][155].[152][194][194][155]=[152][194][155]   [194] [[158]8][194]               [194]";
  97. 490 PRINT"[155][194]  [152][202][195][195][195][203] [202][195][203][202][195][203] [155]  [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  98. 495 PRINT"[155][202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203][158]'H[158]'=H.A.L. [158]'C[158]'=MENU";
  99. 500 RETURN
  100. 505 REM INITIALIZE
  101. 510 E$="               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"
  102. 515 N$="0123456789.E+-_":OP$="=+-X*/^@"+CHR$(13)+"[195]SR[204]L[200][196][194]":D$=" 0":A$="":BA=10
  103. 520 NN$=".":FORI=0TO72:NN$=NN$+CHR$(48+I-(I>9)*7):NEXT
  104. 525 S=54272:FORL=STOS+24:POKEL,0:NEXT:POKES+5,9:POKES+6,0:POKES+24,15
  105. 530 POKE53280,0:POKE53281,0
  106. 535 RETURN
  107. 540 IFBA<>10THEN550:REM PRINT MEMORY REGISTERS
  108. 545 PRINT"";:FORI=1TO8:PRINT""E$;R(I);"";SPC(15-LEN(STR$(R(I)))):NEXT:RETURN
  109. 550 PRINT"";:FORI=1TO8:D=R(I):GOSUB575
  110. 555 PRINT""E$;H$;"";SPC(16-LEN(H$)):NEXT:PRINT"";:RETURN
  111. 560 REM PRINT DISPLAY
  112. 565 IFBA=10THENPRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"D$;:RETURN
  113. 570 D=VAL(D$):GOSUB575:PRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"H$;:RETURN
  114. 575 REM CONVERT D$ TO BASE BA (H$)
  115. 580 B=1:FORK=1TO13:B=B*BA:IFB>DTHEN590
  116. 585 NEXT:H$="***************":RETURN
  117. 590 H$=" ":IFK>1THENFORL=1TOK-1:D=D/BA:NEXT
  118. 595 IFBA=16THENH$="$"
  119. 600 IFBA=2THENH$="%"
  120. 605 IFBA=8THENH$="@"
  121. 610 IFD<0THENH$=H$+"-":D=ABS(D)
  122. 615 FORL=1TO13*(-(BA<11)-(BA>10)*2/LOG(BA)):D%=D:H$=H$+CHR$(48+D%-(D%>9)*(7))
  123. 620 D=BA*(D-D%):IFD=0ANDL>K-1THENRETURN
  124. 625 IFL=KTHENH$=H$+"."
  125. 630 NEXT:RETURN
  126. 635 REM INPUT ROUTINE FOR BA<>10
  127. 640 FORI=1TOBA+1:IFA$=MID$(NN$,I,1)THEN650
  128. 645 NEXT:GOTO145
  129. 650 IFI=1THENF1=1:GOTO45
  130. 655 IFF1=0THENDD=BA*DD+I-2:D$=STR$(DD):GOSUB560:GOTO45
  131. 660 M=M+1:DD=DD+(I-2)/BA^M:D$=STR$(DD):GOSUB560:GOTO45
  132. 665 J=22:PRINT"[147]"TAB(12)"PRESS <F3> TO QUIT"
  133. 670 PRINTTAB(18)"<CURSOR DOWN> TO SCAN"
  134. 675 PRINTTAB(18)"<F7> TO PRINT";
  135. 680 FORI=1TO22:PRINTS$(I)
  136. 685 NEXT
  137. 690 GETA$:IFA$=""THEN690
  138. 695 IFA$=""THENJ=J+1:PRINTS$(J):FORT=1TO50:NEXT:GOTO690
  139. 700 IFA$="[136]"THENOPEN4,4:FORI=1TOZ:PRINT#4,S$(I):NEXT:PRINT#4,:CLOSE4:GOTO690
  140. 705 IFA$="H"THEN745
  141. 710 GOSUB370:GOSUB560:GOSUB540:GOTO45
  142. 715 T$="C[158] FOR COMMANDS":POKE53247,88
  143. 720 D$="               "
  144. 725 FORI=1TOLEN(T$):D$=RIGHT$(D$+MID$(T$,I,1),15)
  145. 730 PRINT""D$;:FORT=1TO50:NEXTT,I
  146. 735 GETA$:IFA$=""THEN735
  147. 740 IFA$<>"C"THEND$=" 0":GOSUB560:GOTO55
  148. 745 PRINT"[147][154]         HALCULATOR COMMANDS         "
  149. 750 PRINT"+ - * / ^ =     LEGAL OPERATORS"
  150. 755 PRINT"   'RETURN'     CLEARS DISPLAY"
  151. 757 PRINT"        'C'     DISPLAYS COMMANDS NENU"
  152. 760 PRINT"<SHIFT> 'C'     CLEARS REGISTERS"
  153. 765 PRINT"        '_'     CLEARS LAST CHAR"
  154. 770 PRINT"        'S'     SAVES TO REGISTER"
  155. 775 PRINT"        'R'     RECALLS FROM REGISTER"
  156. 780 PRINT"        '@'     SQUARE ROOT"
  157. 785 PRINT"        'L'     LOG BASE 10"
  158. 790 PRINT"<SHIFT> 'L'     NATURAL LOG"
  159. 795 PRINT"        'H'     RETURNS TO [154]H.A.L."
  160. 800 PRINT"<SHIFT> 'H'     SETS CALCULATOR TO HEX"
  161. 805 PRINT"<SHIFT> 'D'     SETS CALCULATOR TO DEC"
  162. 810 PRINT"<SHIFT> 'B'     SETS TO ANY OTHER BASE"
  163. 815 PRINT"        <F1>    REVIEWS CALCULATION"
  164. 820 PRINTTAB(16)"(INCLUDES PRINT OPTION)"
  165. 825 PRINT"[145]        <F5>    DISABLES/ENABLES SOUND"
  166. 835 PRINT"NOTE: BASES > 35 UTILIZE GRAPHIC CHARS"
  167. 840 PRINT"        <F8>    LIST OF CHARS USED"
  168. 845 PRINT"[158]          (PRESS ANY KEY)"
  169. 850 GETA$:IFA$=""THEN850
  170. 855 IFA$="[140]"THEN865
  171. 860 D$=" 0":GOSUB370:GOSUB560:GOSUB540:GOTO45
  172. 865 PRINT"[147]";:FORI=1TO24
  173. 870 PRINTI;MID$(NN$,I+2,1)TAB(15)I+24;MID$(NN$,I+26,1)TAB(30)I+48;MID$(NN$,I+50,1)
  174. 875 NEXT:GOTO850
  175. 880 REM*** RETURN TO H.A.L. ROUTINE ***
  176. 885 POKE53280,0:POKE53281,0:PRINT"[147][144]"
  177. 890 H$="H.A.L."
  178. 895 POKE198,4
  179. 900 PRINT"[147]LOAD"CHR$(34)H$;
  180. 905 PRINT CHR$(34)",8";
  181. 910 POKE631,13:POKE632,82:POKE633,117:POKE634,13
  182. 915 END
  183.