home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / comdore / 64misc / clcltr.prg (.txt) < prev    next >
Commodore BASIC  |  1988-12-29  |  7KB  |  173 lines
  1. 10 REM C-64 CALCULATOR
  2. 12 PRINT"[147]":GOSUB206:GOSUB152:GOSUB220
  3. 14 IFPEEK(53247)<>88THEN290
  4. 16 GOSUB228
  5. 18 Z=0
  6. 20 IFBA<>10THENS$(Z)=H$:Z=Z+3:GOTO24
  7. 22 S$(Z)=D$:Z=Z+3
  8. 24 GETA$:IFA$=""THEN24:REM SCAN KEYS
  9. 26 IFF6=0THENPOKES+1,80+4*F7*VAL(A$):POKES,177:POKES+4,33:FORT=1TO20:NEXT:POKES+4,32
  10. 28 IFBA<>10THEN258
  11. 30 FORI=1TO15:IFA$=MID$(N$,I,1)THEN36
  12. 32 NEXT
  13. 34 GOTO62:REM A$ NOT NUMERIC
  14. 36 REM ADD TO D$
  15. 38 IF(A$="-"ORA$="+")THEN42
  16. 40 GOTO44
  17. 42 IF(F3<>0ANDRIGHT$(D$,1)<>"E")ORF5=1THEN62
  18. 44 IFD$=" 0"ORF4=1THEND$=" ":F1=0:F2=0:F3=0:F4=0:M=0
  19. 46 F3=1
  20. 48 IFA$="_"THEND$=LEFT$(D$,LEN(D$)-1):F1=0:F2=0:GOSUB228:GOTO24
  21. 50 IFA$="."ANDF1=1THEN24
  22. 52 IFA$="E"ANDF2=1THEN24
  23. 54 IFA$="."THENF1=1
  24. 56 IFA$="E"THENF2=1:F1=1
  25. 58 IFLEN(D$)<15THEND$=D$+A$
  26. 60 GOSUB228:GOTO24
  27. 62 M=0:F1=0:IF BA<>10THENS$(Z)=H$:Z=Z+1:GOTO66
  28. 64 S$(Z)=D$:Z=Z+1
  29. 66 DD=0:FORI=1TOLEN(OP$):IFA$=MID$(OP$,I,1)THEN76
  30. 68 NEXTI:IFA$="[133]"THENZ=Z-1:GOTO270
  31. 70 IFA$="H"THENZ=Z-1:GOTO302
  32. 72 IFA$="[135]"THENF6=-(F6=0):IFF6=1THENF7=-(F7=0)
  33. 74 GOTO24
  34. 76 F4=1:F5=1:D=VAL(D$):D$=STR$(D)
  35. 78 ONIGOTO102,100,100,100,100,100,100,114,80,82,84,84,116,118,134,136,138
  36. 80 D$=" 0":F3=0:F5=0:OP=O:A=0:GOSUB228:S$(Z)="CLEAR DISPLAY":Z=Z+1:GOTO24
  37. 82 FORI=1TO8:R(I)=0:NEXT:GOSUB220:FORI=1TOZ:S$(I)="":NEXT:Z=1:GOTO24
  38. 84 IFA$="S"THENPRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]SAVE REGISTER?":GOTO88
  39. 86 PRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]RECALL?"
  40. 88 GETB$:IFB$=""THEN88
  41. 90 IFB$=CHR$(13)THEN80
  42. 92 J=VAL(B$):IFJ>=1ANDJ<=8THEN96
  43. 94 GOTO84
  44. 96 IFA$="R"THENS$(Z)="RECALL #"+B$:Z=Z+1:D$=STR$(R(J)):GOSUB228:GOTO24
  45. 98 R(J)=VAL(D$):S$(Z)="SAVE TO #"+B$:Z=Z+1:GOSUB228:GOSUB220:GOTO24
  46. 100 GOSUB120:OP=I:A=VAL(D$):S$(Z)=A$:Z=Z+1:GOSUB228:GOTO24
  47. 102 S$(Z)="= ":Z=Z+1:ONOPGOTO24,104,106,108,108,110,112
  48. 104 D$=STR$(A+VAL(D$)):GOSUB228:A=0:OP=0:GOTO20
  49. 106 D$=STR$(A-VAL(D$)):GOSUB228:A=0:OP=0:GOTO20
  50. 108 D$=STR$(A*VAL(D$)):GOSUB228:A=0:OP=0:GOTO20
  51. 110 D$=STR$(A/VAL(D$)):GOSUB228:A=0:OP=0:GOTO20
  52. 112 D$=STR$(A^VAL(D$)):GOSUB228:A=0:OP=0:GOTO20
  53. 114 D$=STR$(ABS(D)^.5):S$(Z)="SQUARE ROOT ":Z=Z+1:GOSUB228:GOTO20
  54. 116 D$=STR$(LOG(ABS(D))):S$(Z)="LN ":Z=Z+1:GOSUB228:GOTO20
  55. 118 D$=STR$(LOG(ABS(D))/LOG(10)):S$(Z)="LOG ":Z=Z+1:GOSUB228:GOTO20
  56. 120 ONOPGOTO24,122,124,126,126,128,130,132,132,132,132,132,132,132
  57. 122 D$=STR$(A+VAL(D$)):F3=0:F5=0:RETURN
  58. 124 D$=STR$(A-VAL(D$)):F3=0:F5=0:RETURN
  59. 126 D$=STR$(A*VAL(D$)):F3=0:F5=0:RETURN
  60. 128 D$=STR$(A/VAL(D$)):F3=0:F5=0:RETURN
  61. 130 D$=STR$(A^VAL(D$)):F3=0:F5=0:RETURN
  62. 132 D$=STR$(VAL(D$)):F3=0:F5=0:RETURN
  63. 134 BA=16:BA$="    ":GOTO146
  64. 136 BA=10:BA$="    ":GOTO146
  65. 138 PRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]BASE";
  66. 140 INPUTBA$:BA=VAL(MID$(BA$,49,2)):IFBA<2ORBA>73THEN138
  67. 142 BA$="    ":IFBA=10ORBA=16ORBA=8ORBA=2THEN146
  68. 144 BA$="<"+RIGHT$(STR$(BA),LEN(STR$(BA))-1)+">":IFBA<10THENBA$=BA$+" "
  69. 146 PRINT"[194]      "BA$
  70. 148 S$(Z)="BASE"+STR$(BA):Z=Z+1
  71. 150 GOSUB228:GOSUB220:A$="=":GOTO102
  72. 152 PRINT"[147]";:REM PRINT SCREEN
  73. 154 PRINT"                       [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  74. 156 PRINT"[213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201] [1][194]               [194]";
  75. 158 PRINT"[194] C-64 CALCULATOR [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  76. 160 PRINT"[194]                 [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  77. 162 PRINT"[194][213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201][194] [2][194]               [194]";
  78. 164 PRINT"[194][194]               [194][194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  79. 166 PRINT"[194][202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203][194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  80. 168 PRINT"[194]                 [194] [3][194]               [194]";
  81. 170 PRINT"[194]                 [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  82. 172 PRINT"[194]  [213][195][201][213][195][201][213][195][201][213][195][201]   [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  83. 174 PRINT"[194]  [194]S[194][194]R[194][194]C[194][194][206][194]   [194] [4][194]               [194]";
  84. 176 PRINT"[194]  [202][195][203][202][195][203][202][195][203][202][195][203]   [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  85. 178 PRINT"[194]  [213][195][201][213][195][201][213][195][201][213][195][201]   [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  86. 180 PRINT"[194]  [194]7[194][194]8[194][194]9[194][194][214][194]   [194] [5][194]               [194]";
  87. 182 PRINT"[194]  [202][195][203][202][195][203][202][195][203][202][195][203]   [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  88. 184 PRINT"[194]  [213][195][201][213][195][201][213][195][201][213][195][201]   [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  89. 186 PRINT"[194]  [194]4[194][194]5[194][194]6[194][194][195][194]   [194] [6][194]               [194]";
  90. 188 PRINT"[194]  [202][195][203][202][195][203][202][195][203][202][195][203]   [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  91. 190 PRINT"[194]  [213][195][201][213][195][201][213][195][201][213][195][201]   [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  92. 192 PRINT"[194]  [194]1[194][194]2[194][194]3[194][194][219][194]   [194] [7][194]               [194]";
  93. 194 PRINT"[194]  [202][195][203][202][195][203][202][195][203][202][195][203]   [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  94. 196 PRINT"[194]  [213][195][195][195][201] [213][195][201][213][195][201]   [194]    [213][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][201]";
  95. 198 PRINT"[194]  [194] 0 [194] [194][209][194][194]=[194]   [194] [8][194]               [194]";
  96. 200 PRINT"[194]  [202][195][195][195][203] [202][195][203][202][195][203]   [194]    [202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  97. 202 PRINT"[202][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][203]";
  98. 204 RETURN
  99. 206 REM INITIALIZE
  100. 208 E$="               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]":DIMS$(1000)
  101. 210 N$="0123456789.E+-_":OP$="=+-X*/^@"+CHR$(13)+"[195]SR[204]L[200][196][194]":D$=" 0":A$="":BA=10
  102. 212 NN$=".":FORI=0TO72:NN$=NN$+CHR$(48+I-(I>9)*7):NEXT
  103. 214 S=54272:FORL=STOS+24:POKEL,0:NEXT:POKES+5,9:POKES+6,0:POKES+24,15
  104. 216 POKE53280,15:POKE53281,15
  105. 218 RETURN
  106. 220 IFBA<>10THEN224:REM PRINT MEMORY REGISTERS
  107. 222 PRINT"";:FORI=1TO8:PRINT""E$;R(I);"";SPC(15-LEN(STR$(R(I)))):NEXT:RETURN
  108. 224 PRINT"";:FORI=1TO8:D=R(I):GOSUB234
  109. 226 PRINT""E$;H$;"";SPC(16-LEN(H$)):NEXT:PRINT"";:RETURN
  110. 228 REM PRINT DISPLAY
  111. 230 IFBA=10THENPRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"D$;:RETURN
  112. 232 D=VAL(D$):GOSUB234:PRINT"               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]"H$;:RETURN
  113. 234 REM CONVERT D$ TO BASE BA (H$)
  114. 236 B=1:FORK=1TO13:B=B*BA:IFB>DTHEN240
  115. 238 NEXT:H$="***************":RETURN
  116. 240 H$=" ":IFK>1THENFORL=1TOK-1:D=D/BA:NEXT
  117. 242 IFBA=16THENH$="$"
  118. 244 IFBA=2THENH$="%"
  119. 246 IFBA=8THENH$="@"
  120. 248 IFD<0THENH$=H$+"-":D=ABS(D)
  121. 250 FORL=1TO13*(-(BA<11)-(BA>10)*2/LOG(BA)):D%=D:H$=H$+CHR$(48+D%-(D%>9)*(7))
  122. 252 D=BA*(D-D%):IFD=0ANDL>K-1THENRETURN
  123. 254 IFL=KTHENH$=H$+"."
  124. 256 NEXT:RETURN
  125. 258 REM INPUT ROUTINE FOR BA<>10
  126. 260 FORI=1TOBA+1:IFA$=MID$(NN$,I,1)THEN264
  127. 262 NEXT:GOTO62
  128. 264 IFI=1THENF1=1:GOTO24
  129. 266 IFF1=0THENDD=BA*DD+I-2:D$=STR$(DD):GOSUB228:GOTO24
  130. 268 M=M+1:DD=DD+(I-2)/BA^M:D$=STR$(DD):GOSUB228:GOTO24
  131. 270 J=22:PRINT"[147]"TAB(12)"PRESS <F3> TO QUIT"
  132. 272 PRINTTAB(18)"<CURSOR DOWN> TO SCAN"
  133. 274 PRINTTAB(18)"<F7> TO PRINT";
  134. 276 FORI=1TO22:PRINTS$(I)
  135. 278 NEXT
  136. 280 GETA$:IFA$=""THEN280
  137. 282 IFA$=""THENJ=J+1:PRINTS$(J):FORT=1TO50:NEXT:GOTO280
  138. 284 IFA$="[136]"THENOPEN4,4:FORI=1TOZ:PRINT#4,S$(I):NEXT:PRINT#4,:CLOSE4:GOTO280
  139. 286 IFA$="H"THEN302
  140. 288 GOSUB152:GOSUB228:GOSUB220:GOTO24
  141. 290 T$="C-64 CALCULATOR      BY  DICK WEISIGER     HIT H FOR HELP":POKE53247,88
  142. 292 D$="               "
  143. 294 FORI=1TOLEN(T$):D$=RIGHT$(D$+MID$(T$,I,1),15)
  144. 296 PRINT""D$;:FORT=1TO50:NEXTT,I
  145. 298 GETA$:IFA$=""THEN298
  146. 300 IFA$<>"H"THEND$=" 0":GOSUB228:GOTO26
  147. 302 PRINT"[147]       C-64 CALCULATOR COMMANDS"
  148. 304 PRINT"+ - * / ^ =     LEGAL OPERATORS"
  149. 306 PRINT"        <RTN>   CLEARS DISPLAY"
  150. 308 PRINT"<SHIFT> <C>     CLEARS REGISTERS"
  151. 310 PRINT"        <_>     CLEARS LAST CHAR"
  152. 312 PRINT"        <S>     SAVES TO REGISTER"
  153. 314 PRINT"        <R>     RECALLS FROM REGISTER"
  154. 316 PRINT"        <@>     SQUARE ROOT"
  155. 318 PRINT"        <L>     LOG BASE 10"
  156. 320 PRINT"<SHIFT> <L>     NATURAL LOG"
  157. 322 PRINT"        <H>     DISPLAYS HELP SCREEN"
  158. 324 PRINT"<SHIFT> <H>     SETS CALCULATOR TO HEX"
  159. 326 PRINT"<SHIFT> <D>     SETS CALCULATOR TO DEC"
  160. 328 PRINT"<SHIFT> <B>     SETS TO ANY OTHER BASE"
  161. 330 PRINT"        <F1>    REVIEWS CALCULATION"
  162. 332 PRINTTAB(16)"(INCLUDES PRINT OPTION)"
  163. 334 PRINT"[145]        <F5>    DISABLES/ENABLES SOUND"
  164. 336 PRINT"NOTE: BASES > 35 UTILIZE GRAPHIC CHARS"
  165. 338 PRINT"      HIT <F8> FOR LIST OF CHARS USED"
  166. 340 PRINT"          <PRESS ANY KEY>"
  167. 342 GETA$:IFA$=""THEN342
  168. 344 IFA$="[140]"THEN348
  169. 346 D$=" 0":GOSUB152:GOSUB228:GOSUB220:GOTO24
  170. 348 PRINT"[147]";:FORI=1TO24
  171. 350 PRINTI;MID$(NN$,I+2,1)TAB(15)I+24;MID$(NN$,I+26,1)TAB(30)I+48;MID$(NN$,I+50,1)
  172. 352 NEXT:GOTO342
  173.