home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib37b.dsk / NUMBERCRUNCHER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  15KB  |  141 lines
  1. 10  REM  *************************
  2. 20  REM  * NumberCruncher        *
  3. 30  REM  * by Eric C. Mueller    *
  4. 40  REM  * Copyright (C) 1989    *
  5. 50  REM  * MindCraft Publ. Corp. *
  6. 60  REM  * Concord, MA  01742    *
  7. 70  REM  *************************
  8. 80  REM 
  9. 90 EP = 0: REM  set ep=1 for Epson FX/compatible printer
  10. 100 PL = 55:PS = 1:RLF$ =  CHR$(27) + CHR$(114):FLF$ =  CHR$(27) + CHR$(102) + CHR$(13):TS$ =  CHR$(13): REM :pl = page length; ps = printer slot; rlf$ = reverse line feeds on; flf$ = forward line feeds on
  11. 110  IF EP  THEN RLF$ = "":FLF$ = "":TS$ =  CHR$(27) + CHR$(106) + CHR$(18):TS$ = TS$ +TS$
  12. 120  GOTO 280: REM :jump over subroutines
  13. 130  REM :----subroutines----
  14. 140 DR = 4: REM :# of registers to display
  15. 150  REM -check for len of each numeric string here
  16. 160  FOR I = 1 TO DR: POKE 6,I: CALL 768: IF   NOT DI  THEN  HTAB 20 - LEN( STR$(R(I))): PRINT R(I): NEXT : RETURN 
  17. 170  ON R(I) >65535  OR R(I) <0 GOTO 180: POKE 6,R(I) - INT(R(I)/256) *256: POKE 7, INT(R(I)/256): CALL 768 +3 *DI: NEXT : RETURN 
  18. 180  HTAB 9: PRINT "(too "; MID$ ("largesmall",((R(I) <0) *5) +1,5)")": NEXT : RETURN 
  19. 190 T = R(1): FOR I = 2 TO 4:R(I -1) = R(I): NEXT :R(4) = T: RETURN : REM :rotate up
  20. 200 T = R(4): FOR I = 3 TO 1  STEP  -1:R(I +1) = R(I): NEXT :R(1) = T: RETURN : REM :rotate down
  21. 210  FOR I = 1 TO 4:US(I) = R(I): NEXT : GOSUB 190:DR = 3: GOSUB 150: VTAB 5: HTAB 3: PRINT  SPC( 17);: HTAB 4:L = 1:N$ = L$: PRINT L$;
  22. 220  PRINT "_"; CHR$(8);: POKE  -16368,0: WAIT  -16384,128: GET L$: ON L$ < > CHR$(13)  AND L = 8 GOTO 250: IF L$ =  CHR$(13)  THEN R(4) =  VAL(N$): PRINT :XC$ = ">": ON PRTR GOSUB 1000:CM = 0: RETURN 
  23. 230  IF L$ = "e"  THEN L$ = "E": REM :must be capital to function
  24. 240  IF (L$ > = "0"  AND L$ < = "9")  OR L$ = "."  OR L$ = "E"  OR L$ = "e"  THEN N$ = N$ +L$:L = L +1: PRINT L$;: GOTO 220
  25. 250  IF L$ =  CHR$(8)  OR L$ =  CHR$(127)  OR L$ =  CHR$(24)  THEN  ON L = 1  OR L$ =  CHR$(24) GOTO 200:L = L -1: PRINT " "; CHR$(8); CHR$(8);:N$ =  LEFT$(N$, LEN(N$) -1):CM = 0: GOTO 220
  26. 260  POKE 6, ASC(L$): CALL 768 +12,CM$: ON  PEEK(7) = 0 GOTO 220:L$ =  CHR$( PEEK(6)):R(4) =  VAL(N$): PRINT : ON PRTR GOSUB 1000:CM = 1: RETURN 
  27. 270  REM :----program start----
  28. 280  ONERR  GOTO 1240: REM :set up that error trap, first thing!
  29. 290  HOME : PRINT  CHR$(17): GOSUB 1360:P$(1) = "on ":P$(0) = "off":SX$(0) = "dec":SX$(2) = "bin":SX$(1) = "hex": DIM D(50),MM(1,50):LI = 1: GOSUB 1100: REM :variable and mach. lang setup & clear regs
  30. 300  GOSUB 1160: REM :disp title screen
  31. 310  POKE 34,1: POKE 35,23: HOME : VTAB 4: PRINT "Y:": PRINT "X:": FOR I = 2 TO 23: VTAB I: HTAB 20: PRINT "!";: NEXT : FOR I = 1 TO 40: VTAB 6: HTAB I: PRINT "-": VTAB 19: HTAB 41 -I: PRINT "-": NEXT 
  32. 320  VTAB 6: HTAB 20: PRINT "+": VTAB 19: HTAB 20: PRINT "+": VTAB 2: HTAB 23: PRINT "Number Cruncher": HTAB 28: PRINT "(?) about": HTAB 23: PRINT "(CTRL-Z) undo": HTAB 26: PRINT "(ESC) quit"
  33. 330  POKE 32,21: VTAB 6: PRINT : PRINT "(U) rotate up": PRINT "(D) rotate down": PRINT "(O) pop X off": PRINT "(W) swap X & Y": PRINT "(Z) clear X": PRINT "(K) clear all": PRINT "(,) display: "
  34. 340  POKE 32,1: VTAB 6: PRINT : PRINT "(/*+-) math fn": PRINT "(S) sine": PRINT "(C) cosine": PRINT "(T) tangent": PRINT "(Q) arcsine": PRINT "(V) arccosine": PRINT "(F) arctangent": PRINT "(^) X^Y": PRINT "(<) negate X"
  35. 350  PRINT "(I) integer": PRINT "(A) exp": PRINT "(L) logarithm"
  36. 360  VTAB 20: PRINT "(P) printer:": PRINT "(X) dump X": PRINT "(Y) dump Y & X": PRINT "(N) new column";
  37. 370  POKE 32,21: VTAB 14: PRINT : PRINT "(:) print data": PRINT "(') show data": PRINT "(;) edit data": PRINT "(=) enter data": IF DS = 0  THEN  VTAB 20: PRINT : PRINT  SPC( 3);"no data set ": PRINT  SPC( 4);"in memory": GOTO 390
  38. 380  PRINT : PRINT "(!) std. dev. > X": PRINT "(@) median > X ": PRINT "(#) mod     ": PRINT "($) mean (avg) > X";: REM :statistics options (5 spcs)
  39. 390 CMD$ = "UD" + CHR$(11) + CHR$(10) +"WZK/*+-SCT" +"PXYN?" + CHR$(27) +"QVF" + CHR$(13) +"IAL" + CHR$(94) +"<" + CHR$(26) +"=,!@#$O';:": REM  these are the valid command characters
  40. 400  POKE 32,0: VTAB 13: HTAB 35: PRINT SX$(DI): VTAB 20: HTAB 15: PRINT P$(PRTR):RDR = 0
  41. 410  GOSUB 140: REM :display registers
  42. 420  POKE  -16368,0: WAIT  -16384,128: GET L$: IF (L$ > = "0"  AND L$ < = "9")  OR L$ = "."  THEN  GOSUB 210: IF   NOT CM  THEN 410: REM :accept number
  43. 430  POKE 6, ASC(L$): CALL 768 +12,CM$:T% =  PEEK(7): ON T% = 0 GOTO 420: IF L$ < > CHR$(26)  THEN  FOR I = 1 TO 4:US(I) = R(I): NEXT : REM :save stack in case of undo
  44. 440 XC$ = L$: IF XC$ =  CHR$(13)  THEN XC$ = ">": REM :use ">" to denote enter key
  45. 450 MX = 0: ON T% GOSUB 190,200,190,200,1090,1110,1100,520,530,540,550,560,570,580,990,1000,1010,1030,300,1200,590,600,610,1120,490,500,510,470,480,1130,650,620,830,840,870,970,1140,730,760,800: ON RDR GOTO 370: GOTO 400
  46. 460  REM :----math functions----
  47. 470 R(3) = R(4) ^R(3): GOSUB 200:R(1) = 0: ON PRTR GOSUB 1000: RETURN : REM :X ^ Y
  48. 480 R(4) = 0 -R(4): ON PRTR GOSUB 1000: RETURN : REM :negate X
  49. 490 R(4) =  INT(R(4)): ON PRTR GOSUB 1000: RETURN : REM :integer
  50. 500 R(4) =  EXP(R(4)): ON PRTR GOSUB 1000: RETURN : REM :antilog
  51. 510 R(4) =  LOG(R(4)): ON PRTR GOSUB 1000: RETURN : REM :logarithm
  52. 520 R(3) = R(3)/R(4): GOSUB 200:R(1) = 0: ON PRTR GOSUB 1000: RETURN : REM :/
  53. 530 R(3) = R(3) *R(4): GOSUB 200:R(1) = 0: ON PRTR GOSUB 1000: RETURN : REM :*
  54. 540 R(3) = R(3) +R(4): GOSUB 200:R(1) = 0: ON PRTR GOSUB 1000: RETURN : REM :+
  55. 550 R(3) = R(3) -R(4): GOSUB 200:R(1) = 0: ON PRTR GOSUB 1000: RETURN : REM :-
  56. 560 R(4) =  SIN(R(4)): ON PRTR GOSUB 1000: RETURN : REM :sine
  57. 570 R(4) =  COS(R(4)): ON PRTR GOSUB 1000: RETURN : REM :cosine
  58. 580 R(4) =  TAN(R(4)): ON PRTR GOSUB 1000: RETURN : REM :tangent
  59. 590 R(4) =  ATN(R(4)/ SQR( -R(4) *R(4) +1)): ON PRTR GOSUB 1000: RETURN : REM :arcsin
  60. 600 R(4) =  - ATN(R(4)/ SQR( -R(4) *R(4) +1)) +1.5708: ON PRTR GOSUB 1000: RETURN : REM :arccos
  61. 610 R(4) =  ATN(R(4)): ON PRTR GOSUB 1000: RETURN : REM :arctan
  62. 620 DI = DI +1:DI = DI -(3 *(DI = 3)): RETURN : REM :toggle display base
  63. 630  REM :----data entry/edit stuff----
  64. 640  POKE 34,19: POKE 35,23: POKE 33,20: POKE 32,20: HOME : RETURN 
  65. 650  GOSUB 640: REM :enter data set
  66. 660  IF DS  THEN  PRINT : PRINT : PRINT "  Clear old data?": PRINT  SPC( 5);"(Y) or (N)": POKE  -16368,0: WAIT  -16384,128: GET L$: IF L$ = "y"  OR L$ = "Y"  THEN DS = 0: REM :erase old data by setting pointer to zero
  67. 670  PRINT "Enter data or a": PRINT "blank line to quit.": POKE 34,21: GOTO 700
  68. 680  VTAB 22: HTAB 19: PRINT : PRINT DS +1;: INPUT ":";A$: ON (A$ = "") GOTO 810:B$ = "": FOR I = 1 TO  LEN(A$):X$ =  MID$ (A$,I,1):X$ =  CHR$( ASC(X$) -(32 *( ASC(X$) >96))): ON (X$ <"0"  OR X$ >"9")  AND X$ < >"E"  AND X$ < >"." GOTO 690:B$ = B$ +X$
  69. 690  NEXT :A =  VAL(B$):DS = DS +1:D(DS) = A:T = R(4):R(4) = A: ON PRTR GOSUB 1000:R(4) = T: PRINT 
  70. 700  ON DS < >50 GOTO 680:M$ = "Only 50 data points allowed!"
  71. 710  GOSUB 640: HOME : PRINT M$
  72. 720  PRINT : PRINT "Press Return";: POKE  -16368,0: WAIT  -16384,128: GET L$:ED = 0: GOTO 820
  73. 730  ON DS = 0 GOTO 820: GOSUB 640:ST = 1
  74. 740  FOR I = ST TO DS: PRINT  RIGHT$(" " + STR$(I),2);": ";D(I);: ON I = DS  AND ED = 0 GOTO 750: POKE  -16368,0: WAIT  -16384,128: GET L$: ON L$ =  CHR$(27)  OR ((L$ = "C"  OR L$ = "c")  AND ED = 1) GOTO 750: PRINT : NEXT : ON ED = 0 GOTO 720: RETURN 
  75. 750 V = I:I = 999: NEXT : PRINT : ON ED = 0 GOTO 720: RETURN : REM :if ESC tapped or at end, leave loop
  76. 760  ON DS = 0 GOTO 820:ED = 1:ST = 1:M$ = "End of data." + CHR$(13): REM :editing on, start at data point one
  77. 770  GOSUB 640: POKE 34,19: PRINT "Press (C) to change": PRINT "or (ESC) to stop.": PRINT : POKE 34,22: GOSUB 740: ON L$ < >"C"  AND L$ < >"c" GOTO 710: POKE 34,19: HOME : PRINT "Enter new value.": PRINT "Old value: ";D(V)
  78. 780  VTAB 22: HTAB 19: PRINT : PRINT V;: INPUT ":";A$:A =  VAL(A$): ON A$ = "" GOTO 790:D(V) = A: REM :get new value for point and change it
  79. 790 ST = V: GOTO 770: REM :start again where we left off
  80. 800  ON DS = 0 GOTO 820:T = R(4): FOR I = 1 TO DS:R(4) = D(I): GOSUB 1000: NEXT :R(4) = T: RETURN : REM :print data set
  81. 810  REM :----statistics stuff----
  82. 820  POKE 34,19: POKE 33,20: POKE 32,20: POKE 35,23: HOME : POKE 34,1: POKE 35,23: POKE 33,40: POKE 32,0:RDR = 1: RETURN 
  83. 830  ON DS = 0 GOTO 820:S1 = 0:S2 = 0: FOR I = 1 TO DS:S1 = S1 +D(I):S2 = S2 +D(I) *D(I): NEXT :S = S1/DS: GOSUB 190:R(4) =  SQR((S2 -DS *S *S)/(DS -1)): ON PRTR GOSUB 1000: RETURN : REM :compute standard deviation (yuck!)
  84. 840  ON DS = 0 GOTO 820: GOSUB 640: PRINT : PRINT  SPC( 5 -MX);" computing ":MX = 1 -MX:SW = 0: FOR I = 1 TO DS -1: IF D(I) >D(I +1)  THEN T = D(I +1):D(I +1) = D(I):D(I) = T:SW = 1: REM  :median
  85. 850  NEXT : ON SW GOTO 840: GOSUB 190: IF  INT(DS/2) = DS/2  THEN R(4) = (D(DS/2) +D((DS/2) +1))/2: ON PRTR GOSUB 1000: GOTO 820: REM :finish up bubble sort & compute middle position
  86. 860 R(4) = D((DS/2) +.5): ON PRTR GOSUB 1000: GOTO 820: REM :different handling for odd number of data elements
  87. 870  ON DS = 0 GOTO 820: GOSUB 640: PRINT : PRINT  SPC( 5);"computing":MC = 1:MM(0,1) = D(1):MM(1,1) = 0: FOR I = 1 TO DS:V = D(I): FOR J = 1 TO MC: IF MM(0,J) = V  THEN MM(1,J) = MM(1,J) +1:J = MC +1: NEXT : GOTO 890: REM :mode
  88. 880  NEXT :MC = MC +1:MM(0,MC) = V:MM(1,MC) = 1: REM :no record exists for it; make one
  89. 890  NEXT :CT = 0:NH = MM(1,1): FOR I = 1 TO MC: IF MM(1,I) =  >NH  THEN NH = MM(1,I):Z = I
  90. 900  NEXT : FOR I = 1 TO MC: ON MM(1,I) < >NH GOTO 920: ON Z = I GOTO 920
  91. 910 I = 999: NEXT :M$ = "This data is" + CHR$(13) +"multimodal.": GOTO 710: REM :andthat'snogood!
  92. 920  NEXT :NT = 0:BV = 0: FOR I = 1 TO MC: IF MM(1,I) =  >NT  THEN NT = MM(1,I):BV = MM(0,I): REM :this is largest so far
  93. 930  NEXT : IF MC = 1  THEN M$ = "All values are" + CHR$(13) +"equal": GOTO 710
  94. 940 CN = MM(1,1): FOR I = 1 TO MC: IF MM(1,I) = CN  THEN  NEXT :M$ = "Every value":NT = CN: GOTO 960: REM :if none stand out
  95. 950 I = 999: NEXT :M$ = "The value " + STR$(BV)
  96. 960 M$ = M$ + CHR$(13) +"occurred " + STR$(NT) +" time" + CHR$( ASC("s") *(NT < >1)) +".": GOTO 710
  97. 970  ON DS = 0 GOTO 820: GOSUB 190:S1 = 0: FOR I = 1 TO DS:S1 = S1 +D(I): NEXT :R(4) = S1/DS: ON PRTR GOSUB 1000: RETURN : REM :mean (average)
  98. 980  REM :----printer stuff----
  99. 990 PRTR = 1 -PRTR: RETURN : REM :toggle printer
  100. 1000  GOSUB 1050: PRINT  SPC( 15 * INT(TC)); RIGHT$("               " + STR$(R(4)),12); CHR$(32);XC$: GOSUB 1020: GOSUB 1060: RETURN : REM :dump X (15 spaces)
  101. 1010  GOSUB 1050: PRINT  SPC( 15 * INT(TC)); RIGHT$("               " + STR$(R(3)),12);"  ": GOSUB 1020: GOTO 1000: REM :dump Y & X (15/2 spaces)
  102. 1020 LI = LI +1: IF LI < >PL  THEN  RETURN : REM :haven't reached end of this column yet
  103. 1030 TC = TC +1: IF TC = 5  THEN  GOSUB 1050: FOR LL = 1 TO 5: PRINT : NEXT :LI = 1: GOSUB 1060:TC = 0: RETURN : REM :at end of last column, start new page
  104. 1040  GOSUB 1050: PRINT RLF$;: FOR LL = 1 TO LI -EP: PRINT TS$;: NEXT : PRINT FLF$;: GOSUB 1060:LI = 1: RETURN : REM :reverse up to top of page in preparation for next column of numbers
  105. 1050  PRINT  CHR$(4);"PR#"PS: PRINT  CHR$(9);"80N";: RETURN : REM :turn printer on
  106. 1060  PRINT  CHR$(4);"PR#0": RETURN : REM :turn printer off
  107. 1070  REM :----stack handling subroutines----
  108. 1080  HTAB 21 - LEN(A$)/2: PRINT A$: RETURN : REM :center line
  109. 1090 T = R(3):R(3) = R(4):R(4) = T: RETURN : REM :swap X & Y
  110. 1100  FOR I = 0 TO 3:R(I +1) = 0: NEXT : RETURN : REM :clear all regs
  111. 1110 R(4) = 0: RETURN : REM :clear x
  112. 1120  GOSUB 190:R(4) = R(3): ON PRTR GOSUB 1000: RETURN : REM :enter
  113. 1130  FOR I = 1 TO 4:R(I) = US(I): NEXT : RETURN : REM :undo
  114. 1140  GOSUB 200:R(1) = 0: RETURN : REM :pop up
  115. 1150  REM :----title page----
  116. 1160  TEXT : NORMAL : FOR I = 1 TO 24: CALL  -912: NEXT : FOR I = 1 TO 39: VTAB 24: HTAB I: PRINT "-";: VTAB 1: HTAB 41 -I: PRINT "-";: NEXT : POKE 1024, ASC("-") +128: POKE 2039, ASC("-") +128:S$ = ""
  117. 1170  VTAB 3:B$ = " N U M B E R C R U N C H E R ": FOR I = 1 TO  LEN(B$):S$ = S$ +" ": NEXT : INVERSE :A$ = S$: GOSUB 1080:A$ = B$: GOSUB 1080:A$ = S$: GOSUB 1080: NORMAL : VTAB 7:A$ = "Copyright 1989, MindCraft Publ. Corp.": GOSUB 1080:A$ = "Concord, MA  01742": GOSUB 1080
  118. 1180  VTAB 11:A$ = "Written by Eric C. Mueller": GOSUB 1080: VTAB 18: PRINT " * All operations are stack based": PRINT : PRINT " * Based on Hewlett-Packard calculators"
  119. 1190  VTAB 23:A$ = "Press Return": GOSUB 1080: POKE  -16368,0: WAIT  -16384,128: GET L$: POKE 34,1: POKE 35,23: HOME : RETURN : REM :title screen
  120. 1200  HOME : VTAB 11:A$ = "Are you sure you want to quit?": GOSUB 1080:A$ = "(Y) or (N)": PRINT : GOSUB 1080: POKE  -16368,0: WAIT  -16384,128: GET L$: IF L$ < >"Y"  AND L$ < >"y"  THEN  GOTO 310
  121. 1210  TEXT : HOME : IF PRTR  THEN  PRINT : PRINT  CHR$(4);"PR#0"
  122. 1220  END : REM  end program execution
  123. 1230  REM :----error trapping----
  124. 1240  CALL 768 +9: POKE 34,19: POKE 35,23: POKE 33,20: POKE 32,20: HOME : PRINT : PRINT  SPC( 4)"please press": PRINT  SPC( 7)"Return"
  125. 1250  POKE 34,1: POKE 35,23: POKE 33,40: POKE 32,0: REM :clean stack & screen
  126. 1260  POKE 216,0: ONERR  GOTO 1240: REM :clear error and reset error trap  
  127. 1270 ER =  PEEK(222):EL =  PEEK(218) + PEEK(219) *256: IF ER = 69  THEN ER$ = "OVERFLOW OCCURRED"
  128. 1280  IF ER = 255  THEN 370: REM  :ignore ctrl-c
  129. 1290  IF ER = 53  THEN ER$ = "ILLEGAL OPERATION"
  130. 1300  IF ER = 133  THEN ER$ = "DIVISION BY ZERO"
  131. 1310  IF ER = 16  THEN ER$ = "TYPO: LINE " + STR$(EL)
  132. 1320  IF ER$ = ""  THEN ER$ = "ERR " + STR$( PEEK(222)) +" @ " + STR$( PEEK(218) + PEEK(219) *256): REM :generic error message
  133. 1330  IF EL = 1040  THEN ER$ = "PRINTER ERROR"
  134. 1340  VTAB 5: HTAB 3: PRINT  SPC( 17);: HTAB 3: INVERSE : PRINT ER$;: NORMAL : POKE  -16368,0: WAIT  -16384,128: GET L$: HTAB 3: PRINT  SPC( 17): GOSUB 1130: POP : GOTO 370: REM :restore stack and try for another command
  135. 1350  REM :----misc program init----
  136. 1360  FOR I = 768 TO 768 +206: READ X: POKE I,X: NEXT : IF  PEEK( -1101) < >6  THEN  CALL 927: REM  poke in m/l, and if II+ found, call uppercase converter
  137. 1370  RETURN 
  138. 1380  DATA 76,15,3,76,35,3,76,54,3,76,88,3,76,98,3,165,6,32,91,251,169,2,133,36,160,17,169,160,32,237,253,136,208,248,96,169,14,133,36,169,164,32,237,253,165,7,32,218,253
  139. 1390  DATA  165,6,76,218,253,169,2,133,36,169,165,32,237,253,165,7,32,70,3,165,6,162,7,42,72,169,176,144,2,169,177,32,237,253,104,202,16,241,96,104,168,104,166,223,154,72
  140. 1400  DATA  152,72,96,165,6,41,127,201,96,144,4,41,95,133,6,32,190,222,32,123,221,32,108,221,160,0,177,160,141,158,3,200,177,160,72,200,177,160,133,161,104,133,160,160,0,177,160,197,6,240,8,200,204,158,3,208,244,160,255,200,132,7,96,0
  141. 1410  DATA  165,103,133,0,165,104,133,1,160,1,177,0,240,33,160,4,177,0,240,13,48,8,201,96,144,4,41,95,145,0,200,208,239,160,0,177,0,170,200,177,0,133,1,134,0,208,223,96