home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib35a.dsk / OCTOBER.1988 / CHARTWORKS.bas next >
BASIC Source File  |  2023-02-26  |  21KB  |  325 lines
  1. 10  REM ************************
  2. 20  REM * CHARTWORKS           *
  3. 30  REM * BY RICHARD R. HIATT  *
  4. 40  REM * COPYRIGHT(C) 1988    *
  5. 50  REM * MICROSPARC, INC.     *
  6. 60  REM * CONCORD, MA 01742    *
  7. 70  REM ************************
  8. 75  PRINT  CHR$(21)
  9. 80  LOMEM: 28700: HGR2 : TEXT : HOME : ROT= 0: SCALE= 1: HCOLOR= 3: PRINT  SPC( 15)"CHARTWORKS": PRINT : PRINT  SPC( 4)"COPYRIGHT(C) 1988 MICROSPARC, INC.": PRINT : PRINT "One minute, Please"
  10. 90  FOR I = 1 TO 6: READ Y$: NEXT :N = 36: DIM K$(N): FOR I = 0 TO N: READ K$(I): NEXT :NF = 0: FOR I = 800 TO 809: READ J: POKE I,J: NEXT 
  11. 110  ONERR  GOTO 130
  12. 120  GOTO 140
  13. 130  CALL 800: HOME : PRINT : PRINT "The disk in the current drive": PRINT "must have files CHARTWORKS.BIN & CHSET": VTAB 23: END 
  14. 140 D$ =  CHR$(4):J = 0: FOR I = 24576 TO 24596:J = J + PEEK(I): NEXT : FOR I = 15504 TO 15524:J = J + PEEK(I): NEXT : IF J < >5512  THEN  PRINT D$"BLOADCHARTWORKS.BIN,A$6000": PRINT D$"BLOADCHSET,A$3C00": POKE 232,0: POKE 233,60
  15. 150 EG = 25831:EZ = 25809:ES = 25125:EE = 768:DM = 250:XA = 240:XB = 31:YA = 150:YB = 10:YY = 156:M% = 0: ONERR  GOTO 9000
  16. 160  DEF  FN L(X) = X -256 * INT(X/256): DEF  FN H(X) =  INT(X/256): DEF  FN D(X) =  PEEK(X) +256 * PEEK(X +1)
  17. 170  DEF  FN CL(X) = X -26 * INT(X/26.01): DEF  FN CH(X) =  INT(X/26.01)
  18. 180  DIM E%(9),X%(DM),X(DM),Y%(20),Y(DM),T(4),M$(51),V$(8),L$(5),S$(3)
  19. 190  RESTORE : GOSUB 1900: GOTO 3050
  20. 200  PRINT  CHR$(27) CHR$(17): RETURN 
  21. 210  REM  INPUT ROUTINES
  22. 220  REM  GENERAL ALPHANUMERIC
  23. 230 CD = 1:ML = 2: GOTO 280
  24. 240 NQ = 1:ML = 1: PRINT "? (Y/N) ";: GOTO 280
  25. 250 NM = 1: GOTO 280
  26. 260 DC = 1:ML = 40: GOTO 280
  27. 270 NB = 1
  28. 280 Q$ = "":D% = 0
  29. 290  GET CR$:Q =  ASC(CR$):L =  LEN(Q$): IF Q = 13  AND L = 0  AND ML >0  THEN 210
  30. 300  IF Q = 27  AND ML = 0  THEN NB = 0: PRINT : RETURN 
  31. 310  IF Q = 13  THEN  PRINT :NB = 0:CD = 0:DC = 0:NQ = 0:NM = 0:Q =  VAL(Q$): RETURN 
  32. 320  IF L > = ML  AND Q < >8  THEN 290
  33. 330  IF Q < >8  OR L = 0  THEN 370
  34. 340  PRINT  CHR$(8)" " CHR$(8);: IF L = 1  THEN 280
  35. 350  IF DC  AND  ASC( RIGHT$(Q$,1)) = 46  THEN D% = 0
  36. 360 L = L -1:Q$ =  LEFT$(Q$,L): GOTO 290
  37. 370  IF NB  AND (Q <48  OR Q >57)  THEN 290
  38. 380  IF DC  THEN 470
  39. 390  IF CD  OR NM  THEN 430
  40. 400  IF NQ  AND Q >90  THEN Q = Q -32:CR$ =  CHR$(Q)
  41. 410  IF NQ  AND (Q < >89  AND Q < >78)  THEN 290
  42. 420  PRINT CR$;:Q$ = Q$ +CR$: GOTO 290
  43. 430  IF Q >96  THEN Q = Q -32:CR$ =  CHR$(Q)
  44. 440  IF NM  AND (Q <32  OR Q >94)  THEN 290
  45. 450  IF CD  AND (Q <65  OR Q >90)  THEN 290
  46. 460  GOTO 420
  47. 470  IF L = 0  AND (Q = 43  OR Q = 45)  THEN 420
  48. 480  IF   NOT D%  AND Q = 46  THEN D% = 1: GOTO 420
  49. 490  IF Q <48  OR Q >57  THEN 290
  50. 500  GOTO 420
  51. 510 P =  PEEK( -16384): IF P <128  THEN 510
  52. 520  POKE  -16368,0: RETURN 
  53. 530  REM  SELECT FILE
  54. 540 VS = 6
  55. 550  HOME : PRINT K$(0) SPC( 38)"Escape: "K$(8): VTAB 23: PRINT "Use arrow keys to hilight choice and press Return"
  56. 560  POKE 34,6: POKE 35,19
  57. 570 J = 0:C = 1:K = 14: IF NF <K -1  THEN K = NF +1
  58. 580  HOME :C = J +1: FOR I = J +1 TO K -2: HTAB 10: PRINT M$(I): NEXT :V = VS +1: HTAB 10: PRINT M$(K -1);: GOTO 700
  59. 590  GOSUB 510: IF P = 141  THEN F$ = M$(C): GOTO 710
  60. 600  IF P = 155  THEN C = 0: GOTO 710
  61. 610 P = P -137: IF P <1  OR P >2  THEN 590
  62. 620  ON P GOTO 670,630
  63. 630 I = C -1: IF I = J  AND J >0  THEN J = J -1:K = K -1
  64. 640  IF I = J  THEN 590
  65. 650  IF I = J +1  THEN 580
  66. 660  VTAB V: HTAB 10: PRINT M$(C);:V = V -1 +(V <7):C = I: GOTO 700
  67. 670 I = C +1: IF I = K  AND K <NF +1  THEN K = K +1:J = J +1
  68. 680  IF I = K  THEN 590
  69. 690  VTAB V: HTAB 10: PRINT M$(C):V = V +1 -(V = 19):C = I
  70. 700  VTAB V: INVERSE : HTAB 10: PRINT M$(C);: NORMAL : GOTO 590
  71. 710  POKE 34,0: POKE 35,24: POKE 36,0: HOME : RETURN 
  72. 720  REM  MENU DISPLAY/SELECT
  73. 730  HOME : PRINT K$(Q) SPC( 70 - LEN(K$(Q)) - LEN(K$(T)))"Escape: "K$(T)
  74. 740  VTAB 23: PRINT "Use arrow keys or numbers to hilight choice and press Return"
  75. 750  IF S >0  THEN  VTAB 3: PRINT K$(S): PRINT 
  76. 760 J = 0:V = VS +1: VTAB V: FOR I = 1 TO K -1: PRINT I". "V$(I): NEXT :C = 1: GOTO 830
  77. 770  GOSUB 510: IF P = 141  THEN  HOME :Q = C: RETURN 
  78. 780  IF P = 155  THEN C = 0: HOME : GOTO 840
  79. 790 Q = P -176: IF Q >J  AND Q <K  THEN I = Q: GOTO 820
  80. 800 Q = P -138: IF Q <0  OR Q >1  THEN 770
  81. 810 Q = Q -(Q = 0):I = C -Q: IF I = K  OR I = J  THEN 770
  82. 820  VTAB V: PRINT C". "V$(C):V = VS +I:C = I
  83. 830  VTAB V: PRINT C". ";: INVERSE : PRINT V$(C): NORMAL : GOTO 770
  84. 840  IF T < >7  THEN  POP : RETURN 
  85. 850  HOME : VTAB 10: PRINT  SPC( 22)"Do you really want to quit?";: GOSUB 240: IF Q$ = "N"  OR Q$ = "n"  THEN  RETURN 
  86. 860  HOME : VTAB 23: END 
  87. 870  REM  DELETE AND CLOSE-UP
  88. 880  IF L  THEN  PRINT "Making Deletions...":M% = 0
  89. 890  IF L <2  THEN 920
  90. 900  FOR I = 1 TO L -1: FOR J = I +1 TO L: IF X%(J) <X%(I)  THEN K = X%(I):X%(I) = X%(J):X%(J) = L
  91. 910  NEXT : NEXT 
  92. 920  IF   NOT L  THEN 990
  93. 930  REM @@  IF X%(L) = N THEN X(N) = 0:Y(N) = 0:NX = NX - (NX = N):NY = NY - (YN = N):N = N - 1:L = L - 1: GOTO 920
  94. 940 X = 0:Y = 0:K = 1:J = 1:I = X%(K):X = X +(I < = NX):Y = Y +(I < = NY)
  95. 950 I = I +1: IF I >N  THEN 980
  96. 960  IF K +1 < = L  AND X%(K +1) = I  THEN K = K +1:J = J +1:X = X +(I < = NX):Y = Y +(I < = NY): GOTO 950
  97. 970 X(I -J) = X(I):Y(I -J) = Y(I): GOTO 950
  98. 980 NX = NX -X:NY = NY -Y: FOR I = NX +1 TO N:X(I) = 0: NEXT : FOR I = NY +1 TO N:Y(I) = 0: NEXT 
  99. 990  RETURN 
  100. 1000  REM  DISPLAY DATA AND OFFER DELETIONS
  101. 1010  PRINT K$(3) SPC( 23)"Escape: "K$(8)" with no deletions": VTAB 21: PRINT K$(36): PRINT "To indicate a desired deletion, use arrow keys to hilight index and press Delete": VTAB 3: PRINT "Index";: HTAB 15: PRINT "X";: HTAB 30: PRINT "Y"
  102. 1020 VS = 4: POKE 34,VS: POKE 35,21:M = 1:L = 0:N = NX: IF NY >N  THEN N = NY
  103. 1030 J = M -1:K = M +16: IF K >N +1  THEN K = N +1
  104. 1040  HOME :V = VS +1: VTAB V: FOR I = M TO K -1: PRINT I".";: HTAB 15: PRINT X(I);: HTAB 30: PRINT Y(I): NEXT :C = M:I = M: GOTO 1110
  105. 1050 : GOSUB 510: IF P = 155  THEN  POKE 34,0: POKE 35,24: RETURN 
  106. 1060  IF P = 141  THEN 1120
  107. 1070  IF P = 255  THEN 1140
  108. 1080 P = P -138: IF P <0  OR P >1  THEN 1050
  109. 1090 P = P -(P = 0):I = C -P: IF I = J  OR I = K  THEN 1050
  110. 1100  VTAB V: PRINT C".";:V = V -P: HTAB 60: PRINT 
  111. 1110  VTAB V: INVERSE : PRINT I".";: NORMAL :C = I: HTAB 60: PRINT : GOTO 1050
  112. 1120  IF K = N +1  THEN  POKE 34,0: POKE 35,24: HOME : GOTO 880
  113. 1130 M = M +16: GOTO 1030
  114. 1140  IF   NOT L  THEN 1170
  115. 1150 P = 0: FOR I = 1 TO L: IF X%(I) = C  THEN I = L:P = I
  116. 1160  NEXT : IF P  THEN 1050
  117. 1170 L = L +1:X%(L) = C: VTAB V: HTAB 15: INVERSE : PRINT X(C);: HTAB 30: PRINT Y(C): NORMAL : GOTO 1050
  118. 1180  REM  UTILITY ROUTINES
  119. 1190  VTAB 22
  120. 1200  PRINT K$(36);:ML = 0: GOSUB 270: RETURN 
  121. 1210 V$(0) = K$(35)
  122. 1220 C = (80 - LEN(V$(0)))/2: IF C <0  THEN C = 0
  123. 1230  HOME : VTAB 10: PRINT  SPC( C)V$(0): GOSUB 1190: HOME : RETURN 
  124. 1240 I =  FN CL(Q):J =  FN CH(Q):Q$ =  CHR$(I +64): IF J >0  THEN Q$ =  CHR$(J +64) +Q$
  125. 1250  RETURN 
  126. 1260  IF  PEEK(EE) < >255  THEN  RETURN 
  127. 1270  HOME : PRINT "There seems to be a fatal error": PRINT "Suggest you try a different data disk or quit":NF = 0:F$ = "": GOSUB 1190: POP : RETURN 
  128. 1280  REM  READ DATA ROUTINES
  129. 1290  REM  CHOOSE A COL
  130. 1300  PRINT "From";: GOTO 1320
  131. 1310  PRINT "To";
  132. 1320  PRINT " What Column? ("S$"-"T$") ";: GOSUB 230: RETURN 
  133. 1330 I =  LEN(Q$):J =  ASC(Q$) -64: IF I >1  THEN I =  ASC( RIGHT$(Q$,1)) -64:J = 26 *J +I
  134. 1340  RETURN 
  135. 1350  REM  GET A ROW
  136. 1360  PRINT "From";: GOTO 1380
  137. 1370  PRINT "To";
  138. 1380  PRINT " What Row # ("I"-"J") ";:ML = 3: GOSUB 270: RETURN 
  139. 1390  REM  DATA FROM A COLUMN
  140. 1400 Q = NC: GOSUB 1240:S$ = Q$:Q = MC: GOSUB 1240:T$ = Q$
  141. 1410  GOSUB 1320: GOSUB 1330:C = J: IF J <NC  OR J >MC  THEN  GOSUB 1210: GOTO 1410
  142. 1420  HOME :I = NR:J = MR: IF J -I >DM -1  THEN J = I +DM -1
  143. 1430  GOSUB 1360:R1 = Q: PRINT :I = Q:J = MR: IF J -I >DM -1  THEN J = I +DM -1
  144. 1440  GOSUB 1370:R2 = Q: IF R1 >R2  OR R2 -R1 >DM -1  OR R1 <NR  OR R2 >MR  THEN  GOSUB 1210: GOTO 1420
  145. 1450  POKE 26,C: POKE 27, FN L(R1): POKE 28, FN H(R1): POKE 29, FN L(R2): POKE 74, FN H(R2): IF X >1  THEN 1470
  146. 1460 NX = R2 -R1 +1: FOR I = 1 TO NX:X(I) = 0: NEXT :X(1) = X(1): GOTO 1480
  147. 1470 NY = R2 -R1 +1: FOR I = 1 TO NY:Y(I) = 0: NEXT :Y(1) = Y(1)
  148. 1480  CALL 24970: GOSUB 1260: RETURN 
  149. 1490  REM  DATA FROM A ROW
  150. 1500 I = NR:J = MR: GOSUB 1380:R = Q: IF Q <I  OR Q >J  THEN  GOSUB 1210: GOTO 1500
  151. 1510 Q = NC: GOSUB 1240:S$ = Q$:Q = MC: GOSUB 1240:T$ = Q$
  152. 1520  GOSUB 1300: GOSUB 1330:C1 = J:Q = J: GOSUB 1240:S$ = Q$: GOSUB 1310: GOSUB 1330:C2 = J: IF C1 >C2  OR C1 <NC  OR C2 >MC  THEN  GOSUB 1210: GOTO 1510
  153. 1530  POKE 26, FN L(R): POKE 27, FN H(R): POKE 28,C1: POKE 29,C2: IF X >1  THEN 1550
  154. 1540 NX = C2 -C1 +1: FOR I = 1 TO NX:X(I) = 0: NEXT :X(1) = X(1): GOTO 1560
  155. 1550 NY = C2 -C1 +1: FOR I = 1 TO NY:Y(I) = 0: NEXT :Y(1) = Y(1)
  156. 1560  CALL 24828: GOSUB 1260: RETURN 
  157. 1570 V$(1) = K$(14):V$(2) = K$(15): RETURN 
  158. 1580 V$(1) = K$(11):V$(2) = K$(12): RETURN 
  159. 1590  REM  CHOOSE ROW OR COLUMN
  160. 1600  GOSUB 1580:K = 3:S = 10:T = 8:VS = 8:Q = 2: GOSUB 730:H = Q
  161. 1610  GOSUB 1570:K = 3:S = 13:T = 8:VS = 8:Q = 2: GOSUB 730:X = Q
  162. 1620  ON H GOSUB 1400,1500:M% = 0: GOTO 1600
  163. 1630  REM  DISPLAY FILE
  164. 1640  PRINT K$(1) SPC( 35)"Escape: "K$(8): PRINT : PRINT  TAB( 40)"Column": PRINT "Row":C1 = 1: POKE 34,5
  165. 1650 C2 = C1 +3: IF C2 >MC  THEN C2 = MC
  166. 1660  VTAB 4: HTAB 8: CALL  -868: VTAB 4: HTAB 8:Q = C1: GOSUB 1240:K =  LEN(Q$): PRINT Q$;: FOR Q = C1 +1 TO C2: GOSUB 1240: PRINT  SPC( 16 -K)Q$;:K =  LEN(Q$): NEXT : PRINT : POKE 28,C1 -1: POKE 29,C2:I = I: CALL 24576: GOSUB 1260
  167. 1670  PRINT I;: CALL 24804: IF  PEEK(EE) = 255  THEN  GOSUB 1270
  168. 1680 P =  PEEK(232): IF   NOT P  THEN 1670
  169. 1690  IF P <255  THEN 1710
  170. 1700  VTAB 23: PRINT K$(36);:ML = 0: GOSUB 270: IF Q = 0  AND C2 <MC  THEN C1 = C1 +4: GOTO 1650
  171. 1710  POKE 34,0: POKE 232,0: RETURN 
  172. 1720  REM  LOAD A FILE
  173. 1730 M$(1) = M$(1): CALL 25840: GOSUB 1260:NF =  PEEK(4): IF   NOT NF  THEN V$(0) = K$(31): GOSUB 1220: RETURN 
  174. 1740  IF NF = 1  THEN C = 1:F$ = M$(C): GOTO 1760
  175. 1750  GOSUB 540: IF C = 0  THEN  RETURN 
  176. 1760  PRINT "Loading key block of "F$:M$(C) = M$(C): CALL 25994: GOSUB 1260
  177. 1770  PRINT : PRINT "and scanning file dimensions": PRINT : CALL ES: GOSUB 1260:MC =  PEEK(27):NC =  PEEK(26):MR =  FN D(74):NR =  FN D(28)
  178. 1780  PRINT "File Parameters": PRINT : HTAB 15: PRINT "Col" SPC( 13)"Row":Q = NC: GOSUB 1240: PRINT K$(28);: HTAB 16: PRINT Q$;: HTAB 32: PRINT NR:Q = MC: GOSUB 1240: PRINT K$(29);: HTAB 16: PRINT Q$;: HTAB 32: PRINT MR: PRINT : GOSUB 1200: RETURN 
  179. 1790  REM  GRAPHICS ROUTINES
  180. 1800  REM  UTILITIES
  181. 1810  PRINT " ","X","Y": PRINT K$(28),XN,YN: PRINT K$(29),XM,YM: PRINT : RETURN 
  182. 1820  HPLOT X,YA TO X,Y TO X +TX,Y TO X +TX,YA:X = X +TX: RETURN 
  183. 1830  FOR J = Y TO YA: HPLOT X,J TO X +TX,J: NEXT :X = X +TX: RETURN 
  184. 1840 L =  LEN(Y$)
  185. 1850  IF P% -K <0  THEN  RETURN 
  186. 1860  FOR J = 1 TO L:Y =  ASC( MID$ (Y$,J)) -31:Y = Y -32 *(Y >65): XDRAW Y AT X -2 *(Y = 15),P% -K:X = X +6 -2 *(Y = 15): NEXT : RETURN 
  187. 1870 L =  LEN(Y$): ROT= 48: FOR J = 1 TO L:X =  ASC( MID$ (Y$,J)) -31: XDRAW X AT P%,Y +2 *(X = 15):Y = Y -6 +2 *(X = 15): NEXT : ROT= 0: RETURN 
  188. 1880  GOSUB 200: POKE  -16304,0: POKE  -16297,0: POKE  -16302,0: POKE  -16299,0: RETURN 
  189. 1890 Y$ = K$(36):P% = 185:X = 135:K = 0: GOSUB 1840: RETURN 
  190. 1900  GOSUB 1890:GF = 0:SB = 64:H = 0
  191. 1910  FOR I = 0 TO 5: READ L$(I): NEXT : RESTORE : RETURN 
  192. 1920  CALL EZ: GOTO 1900
  193. 1930 Y$ = " * 10^" + STR$(P): RETURN 
  194. 1940  FOR J = 0 TO 8: HPLOT 0,J TO 279,J: NEXT : RETURN 
  195. 1950  FOR J = YY +10 TO YY +28: HPLOT 0,J TO 279,J: NEXT : RETURN 
  196. 1960  FOR J = 0 TO 8: HPLOT J,9 TO J,YY: NEXT : RETURN 
  197. 1970  HCOLOR= 0: GOSUB 1940: GOSUB 1950: GOSUB 1960: GOSUB 1910: HCOLOR= 3: RETURN 
  198. 1980  HCOLOR= 0: ON I +1 GOSUB 1940,1950,1960: HCOLOR= 3: RETURN 
  199. 1990  REM  MIN & MAX
  200. 2000  IF M%  THEN  RETURN 
  201. 2010  HOME : PRINT "Finding "K$(28)" & "K$(29)" "K$(34): PRINT :XM = X(1):XN = X(1):YM = Y(1):YN = Y(1): IF NX = 0  THEN 2050
  202. 2020  FOR I = 2 TO NX: IF X(I) <XN  THEN XN = X(I)
  203. 2030  IF X(I) >XM  THEN XM = X(I)
  204. 2040 : NEXT :DX = XM -XN
  205. 2050  IF NY = 0  THEN 2090
  206. 2060  FOR I = 2 TO NY: IF Y(I) <YN  THEN YN = Y(I)
  207. 2070  IF Y(I) >YM  THEN YM = Y(I)
  208. 2080  NEXT :DY = YM -YN
  209. 2090 M% = 1: GOSUB 1810: GOSUB 1200: RETURN 
  210. 2100  REM  COMPUTE LINEAR LEAST SQUARES
  211. 2110  IF NX = 1  THEN V$(0) = K$(32) +" " +K$(14) +" has only one point": GOSUB 1220: RETURN 
  212. 2120  FOR I = 0 TO 4:T(I) = 0: NEXT : HOME : PRINT "Computing least squares line": PRINT 
  213. 2130  FOR I = 1 TO NX:T(0) = T(0) +X(I):T(1) = T(1) +X(I) *X(I):T(2) = T(2) +Y(I):T(3) = T(3) +Y(I) *Y(I):T(4) = T(4) +X(I) *Y(I): NEXT 
  214. 2140 B = (T(4) -T(0) *T(2)/NX)/(T(1) -T(0) *T(0)/NX):A = T(2)/NX -B *T(0)/NX
  215. 2150  PRINT "Line is:": PRINT "Y = "A" + "B" * X": PRINT 
  216. 2160 T(0) = XM:T(1) = XN:T(2) = A +B *XM:T(3) = A +B *XN: GOSUB 1200: RETURN 
  217. 2170  REM  SCALE SEARCH
  218. 2180 P = 0
  219. 2190 F = .01 *(F = 0) +F: IF F <10  THEN F = 10 *F:U = 10 *U:L = 10 *L:P = P +1: GOTO 2190
  220. 2200  IF F >100  THEN F = F/10:U = U/10:L = L/10:P = P -1: GOTO 2200
  221. 2210 T = 1.25: FOR I = 1 TO 4:T = 2 *T:S = F/T: IF  INT(S) < >S  THEN S =  INT(S +1)
  222. 2220  IF S = 4  OR S = 5  OR S = 6  THEN I = 4
  223. 2230  NEXT :Z = T * INT(L/T):Q = W/(U -Z): RETURN 
  224. 2240  REM  SCALE X AND Y
  225. 2250  HOME : PRINT "Finding Scale Factors"
  226. 2260 L = XN:U = XM:F = DX:W = XA: GOSUB 2180:S1 = S:UX = U:LX = L:FX = F:PX = P:ZX = Z:TX = T:SX = Q:HX = 1: GOSUB 1930:S$(1) = Y$
  227. 2270 L = YN:U = YM:F = DY:W = YA -YB: GOSUB 2180:S2 = S:UY = U:LY = L:FY = F:PY = P:ZY = Z:TY = T:SY = Q: GOSUB 1930:S$(2) = Y$: RETURN 
  228. 2280 T(C) = YY +12:E%(C +4) = XB +(XA -6 *L)/2: RETURN 
  229. 2290 L$(E%(C)) = Q$ +L$(E%(C)):L =  LEN(L$(E%(C))) +J: RETURN 
  230. 2300 Y$ = Y$ +"Label": IF (C = 1  OR C = 3)  AND H = 3  THEN I = I -6
  231. 2310  PRINT Y$K$(P)" is "L$(E%(C)): PRINT "Change that";: GOSUB 240: IF Q$ = "N"  OR Q$ = "n"  THEN L =  LEN(L$(E%(C))) +J: RETURN 
  232. 2320 ML = I: PRINT : PRINT "Key in new "Y$K$(P)" (Max Char = "ML")": GOSUB 250:L$(E%(C)) = Q$:L = L +J: RETURN 
  233. 2330 V$(1) = K$(24):V$(2) = "Legend" +K$(25):V$(3) = "Legend" +K$(26):VS = 6:S = 27:K = 4:T = 16
  234. 2340 Q = 22: GOSUB 730:C = Q -1:J =  LEN(S$(C)): ON Q GOSUB 2350,2360,2420: GOTO 2340
  235. 2350 P = 24:Y$ = "":I = 35: GOSUB 2310:E%(C +4) = 0:T(C) = 0: RETURN 
  236. 2360  IF H = 3  THEN  PRINT K$(21)"ing both X & Y": PRINT "There will be a double label"K$(25): PRINT 
  237. 2370 P = 25:I =  INT(XA/6) -J:Y$ = "": IF H = 3  THEN Y$ = "X-"
  238. 2380  GOSUB 2300: IF H = 3  THEN Q$ = "BLANK=": GOSUB 2290
  239. 2390  GOSUB 2280:T(C) = T(C) -1
  240. 2400  IF H = 3  THEN C = 3:J =  LEN(S$(C)):I =  INT(XA/6) -J:Y$ = "Y-": GOSUB 2300:Q$ = "SOLID=": GOSUB 2290: GOSUB 2280:T(C) = T(C) +8
  241. 2410  RETURN 
  242. 2420 P = 26:I =  INT((YA -YB)/6) -J:Y$ = "": GOSUB 2300:E%(C +4) = YA -(YA -YB -6 *L)/2:T(C) = 0: RETURN 
  243. 2430  REM  COMPUTE FREQUENCIES FOR HISTOGRAM
  244. 2440  HOME : PRINT "Frequency computation for histogram": PRINT 
  245. 2450  PRINT : GOSUB 1810:X$ = "Desired ":Y$ = K$(25) +" is? ": PRINT X$K$(28)Y$;: GOSUB 260:LX = Q: PRINT X$K$(29)Y$;: GOSUB 260:UX = Q: PRINT 
  246. 2460  PRINT "# of desired divisions"K$(25)" is? ("2"-"20") ";:ML = 2: GOSUB 270:D = Q: IF D <2  OR D >20  OR UX <LX  THEN  GOSUB 1210: GOTO 2440
  247. 2470  PRINT : PRINT "Computing frequencies"
  248. 2480 UY = 0: ON H GOTO 2490,2530,2490
  249. 2490  FOR I = 0 TO D:X%(I) = 0: NEXT :J = (UX -LX)/D: FOR I = 1 TO NX: IF X(I) >UX  OR X(I) <LX  THEN 2510
  250. 2500 K = (X(I) -LX)/J:X%(K) = X%(K) +1: IF K = D  THEN X%(K -1) = X%(K -1) +1
  251. 2510  NEXT :UY = X%(0): FOR I = 1 TO D -1: IF X%(I) >UY  THEN UY = X%(I)
  252. 2520  NEXT : IF H = 1  THEN 2570
  253. 2530  FOR I = 0 TO D:Y%(I) = 0: NEXT :J = (UX -LX)/D: FOR I = 1 TO NY: IF Y(I) >UX  OR Y(I) <LX  THEN 2550
  254. 2540 K = (Y(I) -LX)/J:Y%(K) = Y%(K) +1: IF K = D  THEN Y%(K -1) = Y%(K -1) +1
  255. 2550  NEXT :LY = Y%(0): FOR I = 1 TO D -1: IF Y%(I) >LY  THEN LY = Y%(I)
  256. 2560  NEXT : IF LY >UY  THEN UY = LY
  257. 2570 L = 0:U = UY:F = UY:W = YA -YB: GOSUB 2180:S2 = S:UY = U:LY = 0:FY = F:PY = P:TY = T:SY = Q: GOSUB 1930:S$(2) = Y$: IF H = 2  THEN 2590
  258. 2580  FOR I = 0 TO D -1:X%(I) = X%(I) *(10 ^PY) *SY: NEXT : IF H = 1  THEN 2600
  259. 2590  FOR I = 0 TO D -1:Y%(I) = Y%(I) *(10 ^PY) *SY: NEXT 
  260. 2600 HX = 1:PX = 0:ZX = LX:TX = (UX -LX)/D:S1 = D:SX = XA/D/TX: IF UX <1  OR UX >100  THEN PX =  INT( LOG(UX -LX)/2.303 +.01) -1:HX = 10 ^PX:PX =  -PX
  261. 2610 P = PX: GOSUB 1930:S$(1) = Y$:S$(3) = Y$: RETURN 
  262. 2620  REM  DRAW AXES
  263. 2630  GOSUB 1880
  264. 2640  HPLOT XB,YB TO XB,YA TO XA +XB,YA
  265. 2650 K = 3: FOR I = 1 TO S2 -1:P% = YY -YB -I *TY *SY +.5: HPLOT XB,P% TO XB +3,P%:Y$ =  STR$(ZY +TY *I):L =  LEN(Y$): IF L >3  THEN L = 3
  266. 2660 X = XB -9 -6 *(L -1): GOSUB 1850: NEXT :N = 1: IF S1 >10  THEN N = 2
  267. 2670 K = 0: FOR I = 1 TO S1 -1  STEP N:P% = XB +I *TX *SX +.5: HPLOT P%,YA +3 TO P%,YA:Y$ =  STR$(ZX +TX *I/HX):L =  LEN(Y$): IF L >3  THEN L = 3:Y =  VAL(Y$): IF  ABS(Y - INT(Y)) <.01  THEN Y$ =  STR$( INT(Y)):L =  LEN(Y$): IF L >3  THEN L = 3
  268. 2680 X = P% -3.5 *(L -1):P% = YY: GOSUB 1850: NEXT 
  269. 2690  IF G <3  THEN 2750
  270. 2700 TX = XA/D:X = XB: IF H = 3  THEN TX = TX/2
  271. 2710  FOR I = 0 TO D -1: ON H GOTO 2720,2730,2720
  272. 2720 Y = YA -X%(I): GOSUB 1820: IF H = 1  THEN 2740
  273. 2730 Y = YA -Y%(I): ON H GOSUB 1820,1820,1830
  274. 2740  NEXT : GOTO 2810
  275. 2750  FOR I = 1 TO NX:X = XB +(X(I) *(10 ^PX) -ZX) *SX +.5:Y = YA -(Y(I) *(10 ^PY) -ZY) *SY +.5: IF Y > = YB  AND Y < = YA  AND X > = XB  AND X < = XA +XB  THEN  DRAW SB AT X,Y
  276. 2760  NEXT : IF G = 1  THEN 2810
  277. 2770 J = 0: FOR I = 0 TO 1:E%(I) = XB +(T(I) *(10 ^PX) -ZX) *SX +.5: IF E%(I) <XB  OR E%(I) >XA +XB  THEN J = 1
  278. 2780  NEXT : IF J  THEN 2810
  279. 2790  FOR I = 2 TO 3:E%(I) = (T(I) *(10 ^PY) -ZY) *SY +.5: IF YA -E%(I) >YA  OR YA -E%(I) <YB  THEN J = 1
  280. 2800  NEXT : IF   NOT J  THEN  HPLOT E%(0),YA -E%(2) TO E%(1),YA -E%(3)
  281. 2810 ML = 0: GOSUB 270: RETURN 
  282. 2820  REM  PLOT SUB-MENU
  283. 2830  IF NX = 0  AND NY = 0  THEN V$(0) = "The arrays are empty. You must " +K$(2) +" first": GOSUB 1220: RETURN 
  284. 2840  FOR I = 1 TO 6:V$(I) = K$(I +17): NEXT :V$(7) = K$(5):S = 17:T = 8:Q = 16:VS = 8:K = 8: GOSUB 730:VV = 0:G = Q -1: ON Q GOSUB 1920,2850,2850,2920,2960,1970,3020: TEXT : PRINT D$"PR#3": GOTO 2840
  285. 2850 C = (NY >0) +2 *(NX >0): IF C <3  THEN V$(0) = K$(32) +K$(13 +C) +K$(33): GOSUB 1220: RETURN 
  286. 2860  IF GF = 1  THEN  PRINT : PRINT K$(30);: GOSUB 240: IF Q$ = "Y"  OR Q$ = "y"  THEN SB = SB +1 -6 *(SB = 69):VV = 1: GOTO 2890
  287. 2870  IF GF  THEN  GOSUB 1920
  288. 2880  GOSUB 2000: GOSUB 2250
  289. 2890  IF G = 2  THEN  GOSUB 2110
  290. 2900  IF VV  THEN  GOSUB 1880: GOSUB 2750: RETURN 
  291. 2910  GOSUB 2630:GF = 1: RETURN 
  292. 2920  GOSUB 2000: IF GF  THEN  GOSUB 1920
  293. 2930 H = (NX >0) +2 *(NY >0): IF H <3  THEN 2950
  294. 2940  GOSUB 1570:V$(3) = "Both Arrays":K = 4:VS = 8:Q = 21:S = Q:T = 16: GOSUB 730:H = Q
  295. 2950 Q = 3: GOSUB 2440: GOSUB 2630:GF = 2: RETURN 
  296. 2960  IF   NOT GF  THEN V$(0) = "Please " +K$(4) +" first": GOSUB 1220: GOTO 2840
  297. 2970  FOR I = 0 TO 2:E%(I) = I: NEXT : IF GF = 2  THEN E%(2) = 3:E%(1) = 3 +H: IF H = 3  THEN E%(1) = 4:E%(3) = 5
  298. 2980 W = 2 +(H = 3): FOR I = 0 TO W:T(I) =  -1: NEXT : GOSUB 2330:S = 0: FOR I = 0 TO W:S = S +T(I): NEXT : IF S =  -W -1  THEN  RETURN 
  299. 2990 K = 0: FOR I = 0 TO W: IF T(I) > = 0  THEN Y$ = L$(E%(I)) +S$(I):P% = T(I):X = E%(I +4):Y = X: GOSUB 1980: ON I +1 GOSUB 1840,1840,1870,1840
  300. 3000 : NEXT : GOSUB 3020: RETURN 
  301. 3010  REM  TURN ON SCREEN
  302. 3020  GOSUB 1880:ML = 0: GOSUB 270: RETURN 
  303. 3030  REM  HARD COPY (GRAPPLER II+)
  304. 3040  GOSUB 1890: GOSUB 200: PRINT D$"PR#1": PRINT  CHR$(9)"GD2": PRINT D$"PR#0": GOSUB 1890: RETURN 
  305. 3050  HOME : CALL EG: PRINT D$"PR#3": HOME : PRINT : VTAB 10: HTAB 8: INVERSE : PRINT "REPLACE";: NORMAL : PRINT " The program disk with an AppleWorks data disk, please": PRINT 
  306. 3060  PRINT "Leave the data disk in the drive at all times!": PRINT : PRINT "If you replace one data disk with another, and do not then ": PRINT : INVERSE : PRINT K$(0);: NORMAL 
  307. 3070  PRINT " before doing anything else": PRINT : PRINT "the data that you will get will be very strange indeed!": GOSUB 1190: HOME 
  308. 3080  REM  MAIN MENU
  309. 3090  TEXT : PRINT D$"PR#3": FOR I = 1 TO 7:V$(I) = K$(I -1): NEXT :T = 7:VS = 6:K = 8:S = 0
  310. 3100 Q = 9: GOSUB 730: IF C >1  AND F$ = ""  THEN V$(0) = "YOU MUST " +K$(0) +" FIRST": GOSUB 1220: GOTO 3100
  311. 3110  POKE EE,0: HOME : ON Q GOSUB 1730,1640,1600,1010,2830,3020,3040: GOTO 3090
  312. 3120  DATA " ",X,Y,FREQUENCY,X,Y
  313. 3130  DATA Select a file,Display the file,Read the file,Inspect data,Plot a graph,View previous plot,Send screen to printer,End program,Return to Main Menu
  314. 3140  DATA "Main Menu","Read data from:","a Column","a Row","Read data into:","X Array","Y Array"
  315. 3150  DATA "Plot Sub-Menu","Plotting Choices:" ,Clear screen,"Scatter plot","Scatter plot + least squares line","Histogram"
  316. 3160  DATA "Add Titles & Legends","Erase Titles & Legends","Plot Title"," for X-Axis"," for Y-Axis","Key in:"
  317. 3170  DATA "Minimum","Maximum","Overlay previous plot" 
  318. 3180  DATA "Current data disk has no Spread Sheet files","You can't do that. The "," is empty"
  319. 3190  DATA "for X & Y","Input error"
  320. 3200  DATA   "Press Return to continue"  
  321. 3210  DATA 104,168,104,166,223,154,72,152,72,96
  322. 9000  TEXT : HOME : PRINT  CHR$(4)"PR#3": VTAB 23
  323. 9010  IF  PEEK(222) = 133  THEN  PRINT "DIVISION BY ZERO ERROR": PRINT "INSPECT YOUR DATA BEFORE PLOTTING.": GOTO 9030
  324. 9020  PRINT "FATAL ERROR AT LINE "; PEEK(218) +256 * PEEK(219)
  325. 9030  PRINT "PRESS RETURN TO RESTART ";: POKE  -16368,0: GET A$: RUN