home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib29a.dsk / DECEMBER.1986 / AW.BAR.CHARTS.bas next >
BASIC Source File  |  2023-02-26  |  11KB  |  235 lines
  1. 10  REM  ************************
  2. 20  REM  * AW.BAR.CHARTS        *
  3. 30  REM  * BY DAVID PERLMAN     *
  4. 40  REM  * COPYRIGHT (C) 1986   *
  5. 50  REM  * BY MICROSPARC, INC.  *
  6. 60  REM  * CONCORD, MA  01742   *
  7. 70  REM  ************************
  8. 80 D$ =  CHR$(4)
  9. 90  ONERR  GOTO 2310: REM  READ PARAMETER FILE
  10. 100  PRINT D$"VERIFY PARAMETERS"
  11. 110  PRINT D$"OPEN PARAMETERS"
  12. 120  PRINT D$"READ PARAMETERS"
  13. 130  INPUT PFX$: REM  PREFIX
  14. 140  INPUT GMAX: REM  MAXIMUM GRADE
  15. 150  INPUT NF: REM  MAXIMUM NUMBER OF ENTRIES
  16. 160  INPUT PM$: REM  PRINTER TYPE
  17. 170  INPUT SLT: REM  PRINTER SLOT
  18. 180  INPUT L6: REM  PRINTER CODE FOR 6 LINES/INCH
  19. 190  INPUT L8: REM  PRINTER CODE FOR 8 LINES/INCH
  20. 200  INPUT PS: REM  PRINTER CODE FOR DISABLE END OF PAPER SENSOR
  21. 210  INPUT DIV: REM   NUMBER OF GRADE DIVISIONS
  22. 220  PRINT D$"CLOSE": POKE 216,0:NE = NF
  23. 230  DIM G(NE +1),B(22)
  24. 240  ONERR  GOTO 2150
  25. 250  HOME : HTAB 11: PRINT "Appleworks Bar Charts": HTAB 12: PRINT "By David E. Perlman": HTAB 5: PRINT "Copyright 1986 by MicroSPARC, Inc."
  26. 260  VTAB 6: PRINT  TAB( 6)"1. LOAD DATA": PRINT  TAB( 6)"2. ALTER PARAMETERS": PRINT  TAB( 6)"3. QUIT": PRINT : PRINT "SELECT ";: POKE  -16368,0: GET A$: PRINT : POKE  -16368,0
  27. 270 A =  VAL(A$): IF A <1  OR A >3  THEN 260
  28. 280  ON A GOTO 300,1570,290
  29. 290  TEXT : HOME : END 
  30. 300  HOME : PRINT "CURRENT PREFIX: ";PFX$: VTAB 6: PRINT "ENTER PATHNAME OF FILE TO LOAD:": INPUT "";F$
  31. 310 PTH$ = F$: IF  LEFT$(F$,1) < >"/"  THEN PTH$ = PFX$ +F$
  32. 320  GOTO 600
  33. 330  REM 
  34. 340  REM  ***** LINE PRINT SUBROUTINE
  35. 350  FOR X = 1 TO DIV +1
  36. 360 BLANK$ = "   ": REM   THREE SPACES
  37. 370  IF B(X) <(YMAX +1 -Y)  THEN  PRINT BLANK$;: GOTO 390
  38. 380  PRINT "EEE";
  39. 390  NEXT X
  40. 400  PRINT : REM      ******  ADVANCES ONE SPACE FOR NEXT LINE.
  41. 410  RETURN 
  42. 420  REM 
  43. 430  REM  *****  SHELL-METZNER SORT
  44. 440 J1 = 0
  45. 450 S1 = NE
  46. 460 S1 =  INT(S1/2)
  47. 470  IF S1 = 0  THEN 580
  48. 480 S2 = NE -S1:J1 = 1
  49. 490 K1 = J1
  50. 500 K2 = K1 +S1
  51. 510  IF G(K1) < = G(K2)  THEN 550
  52. 520 T1 = G(K1):G(K1) = G(K2)
  53. 530 G(K2) = T1:K1 = K1 -S1
  54. 540  IF K1 > = 1  THEN 500
  55. 550 J1 = J1 +1: IF J1/10 =  INT(J1/10)  THEN  PRINT ".   ";: REM  3 SPACES,SHOWS SORT IS IN PROGRESS
  56. 560  IF J1 < = S2  THEN 490
  57. 570  GOTO 460
  58. 580  RETURN 
  59. 590  REM 
  60. 600  REM   *****  READING DATA
  61. 610  PRINT D$"VERIFY"PTH$
  62. 620  PRINT D$"OPEN"PTH$
  63. 630  PRINT D$"READ"PTH$
  64. 640 I = 1:M = 0
  65. 650  INPUT GD$
  66. 660  IF GD$ = ""  THEN 650: REM  IGNORES BLANKS
  67. 670  IF  VAL(GD$) = 0  AND GD$ < >"0"  THEN 650: REM  ACCEPTS ONLY NUMBERS
  68. 680  IF GD$ = ".01"  THEN  PRINT " NO SHOW":M = M +1: GOTO 650
  69. 690  PRINT GD$
  70. 700 G(I) =  VAL(GD$)
  71. 710  IF G(I) >GMAX  THEN  PRINT D$"CLOSE": PRINT  CHR$(7);"A DATA ENTRY EXCEEDS MAXIMUM, GMAX": PRINT : PRINT  SPC( 3)"CURRENTLY, GMAX = ";GMAX:ER = 500: PRINT "PRESS RETURN TO ALTER GMAX ";: GET A$: PRINT : HOME : GOTO 1580
  72. 720  IF G(I) <.01  THEN  PRINT D$"CLOSE": INVERSE : PRINT  CHR$(7);"A DATA ENTRY LESS THAN .01 EXISTS": NORMAL : PRINT "PLEASE CHECK YOUR DATA AND TRY AGAIN": PRINT "PRESS RETURN TO CONTINUE ": POKE  -16368,0: GET A$: PRINT : GOTO 240
  73. 730 I = I +1
  74. 740  IF I >NF +1  THEN  PRINT D$"CLOSE": PRINT  CHR$(7);"NUMBER OF ENTRIES EXCEEDS MAX": PRINT  SPC( 3)"CURRENTLY, MAX = ";NF:ER = 600: PRINT : PRINT "PRESS RETURN TO ALTER MAX ";: GET A$: PRINT : HOME : GOTO 1660
  75. 750  GOTO 650
  76. 760  PRINT D$"CLOSE"
  77. 770  REM    ******  GRADE GRAPH MODULE
  78. 780  HOME 
  79. 790  PRINT "SORTING"
  80. 800  GOSUB 430
  81. 810 NG = DIV +1: REM  ******  NUMBER OF GRADE GROUPS
  82. 820  REM    ******   CLEAR THE ARRAY B(K)
  83. 830  FOR K = 1 TO NG:B(K) = 0: NEXT K
  84. 840  REM    ******  GROUP SORT
  85. 850 YMAX = 0
  86. 860  FOR I = 1 TO NE
  87. 870  PRINT ". ";
  88. 880 DG = GMAX/DIV
  89. 890  FOR K = 11 TO NG
  90. 900  IF G(I) > = DG *(K -1)  AND G(I) <DG *K  THEN B(K) = B(K) +1: GOTO 940
  91. 910  NEXT K
  92. 920  FOR K = 1 TO 10
  93. 930  GOTO 900
  94. 940 B = B(K): IF B >YMAX  THEN YMAX = B: REM    ******    RETURNS LARGEST ORDINATE.
  95. 950  NEXT I
  96. 960  REM    ******   PRINT MODULE
  97. 970 SUM = 0:BSUM = 0
  98. 980 PR = 1: HOME : VTAB 8: PRINT "OUTPUT MODE:"
  99. 990  PRINT : PRINT  TAB( 5)"1. PRINTER": PRINT  TAB( 5)"2. SCREEN": PRINT  TAB( 5)"3. MAIN MENU": PRINT : PRINT : PRINT "SELECT: ";: POKE  -16368,0: GET A$: PRINT 
  100. 1000  IF A$ = "1"  THEN 1050
  101. 1010  IF A$ = "2"  AND DIV = 20  THEN  HOME : PRINT D$"PR#3": GOTO 1100
  102. 1020  IF A$ = "2"  THEN  HOME : GOTO 1100
  103. 1030  IF A$ = "3"  THEN 240
  104. 1040  GOTO 980
  105. 1050  HOME :PR = 10: VTAB 7: PRINT "Turn on Printer": PRINT : PRINT "PRESS RETURN WHEN READY ";: POKE  -16368,0: GET CH$: PRINT : POKE  -16368,0
  106. 1060  PRINT D$"PR#";SLT: PRINT  CHR$(0)
  107. 1070  HOME : PRINT  CHR$(9)"80N"
  108. 1080  PRINT  CHR$(27) CHR$(L8); CHR$(27) CHR$(PS): REM    8 LINES/INCH AND PAPER ERROR DETECTOR OFF
  109. 1090  HTAB 23: PRINT "GRADE DISTRIBUTION FOR ";F$: PRINT : PRINT 
  110. 1100  IF YMAX <10  THEN  PRINT  TAB( PR)" "YMAX; CHR$(95)"|": GOTO 1120
  111. 1110  PRINT  TAB( PR)YMAX; CHR$(95)"|"
  112. 1120  FOR Y = 1 TO YMAX
  113. 1130  PRINT  TAB( PR)"   |";: REM  3 SPACES
  114. 1140  GOSUB 340
  115. 1150 LC = YMAX -Y
  116. 1160  IF LC > = 10  THEN  PRINT  TAB( PR)LC; CHR$(95)"|";: GOTO 1190
  117. 1170  IF LC = 0  THEN  PRINT  TAB( PR)"   |";: GOTO 1190: REM  3 SPACES
  118. 1180  PRINT  TAB( PR)" "LC; CHR$(95)"|";
  119. 1190  GOSUB 340: REM      ******  REPEATS TRACE FOR EACH VALUE OF Y.
  120. 1200  NEXT Y
  121. 1210  REM      ******  LABEL BOTTOM LINE
  122. 1220  HTAB (PR +3)
  123. 1230  PRINT "-";
  124. 1240  FOR I = 1 TO DIV +1
  125. 1250  PRINT "+--";
  126. 1260  NEXT I
  127. 1270  PRINT : HTAB (PR +4)
  128. 1280  FOR I = 1 TO DIV +1  STEP 2
  129. 1290  PRINT (I -1) *GMAX/(DIV *10);: POKE 36,(PR +6 +I *3)
  130. 1300  NEXT I
  131. 1310 SP = 30: IF DIV = 10  THEN SP = 14
  132. 1320  PRINT : PRINT  TAB( PR +SP)"GRADE RANGE/10"
  133. 1330  REM    ******  STATISTICS
  134. 1340  REM    ******  AVERAGE
  135. 1350 SUM = 0
  136. 1360  FOR K = 1 TO NE:SUM = SUM +G(K): NEXT K
  137. 1370 UV = SUM/NE: GOSUB 1530:MEAN$ = TS$:UV = G(NE): GOSUB 1530:MX$ = TS$:UV = G(1): GOSUB 1530:MN$ = TS$
  138. 1380  REM    ******   MEDIAN
  139. 1390 R =  INT(NE/2)
  140. 1400  IF R *2 = NE  THEN UV = (G(R) +G(R +1))/2: GOSUB 1530:MDN$ = TS$: GOTO 1420
  141. 1410 UV = G(R +1): GOSUB 1530:MDN$ = TS$
  142. 1420  IF DIV = 10  THEN  PRINT : PRINT  TAB( PR +3)"NUMBER="NE SPC( 3)"MEAN="MEAN$ SPC( 3)"MEDIAN="MDN$: PRINT  TAB( PR +13)"MAX="MX$ SPC( 3)"MIN="MN$: GOTO 1440
  143. 1430  PRINT : PRINT  TAB( PR +9)"NUMBER="NE SPC( 3)"MEAN="MEAN$ SPC( 3)"MEDIAN="MDN$ SPC( 3)"MAX="MX$ SPC( 3)"MIN="MN$
  144. 1440 SP = 13: IF A$ = "2"  THEN SP = 4
  145. 1450  IF M >0  THEN  PRINT : HTAB SP: PRINT "There are ";M" missing grades"
  146. 1460 SP = 12: IF PR = 10  THEN  PRINT  CHR$(27) CHR$(L6): PRINT D$"PR#0": GOSUB 1490: GOTO 1500: REM        BACK TO 6 LINES/IN AND PRINTER OFF.
  147. 1470  IF DIV = 20  THEN SP = 28: GOSUB 1490: PRINT  CHR$(17): GOTO 1500: REM   TURN OFF 80 COLUMN CARD
  148. 1480  GOSUB 1490: GOTO 1500
  149. 1490  VTAB 23: PRINT : PRINT  TAB( SP)"<R>epeat     <Q>uit ";: GET A$: PRINT : RETURN 
  150. 1500  IF A$ = "R"  OR A$ =  CHR$(112)  THEN SUM = 0: GOTO 980
  151. 1510  IF A$ < >"Q"  AND A$ < > CHR$(113)  THEN  HOME : VTAB 19:SP = 12: GOSUB 1490: GOTO 1500
  152. 1520  GOTO 240
  153. 1530  REM    ******    FORMATTING- 2 DECIMAL PLACES; ASSUME NUMBER ALWAYS IS <100.
  154. 1540 TS$ =  LEFT$( STR$(UV),5)
  155. 1550  RETURN 
  156. 1560  REM    ***** ALTER PARAMETERS
  157. 1570  HOME 
  158. 1580  REM   ****** MAX ENTRY
  159. 1590  VTAB 5: PRINT "MAXIMUM ENTRY VALUE: ";: CALL  -868: INVERSE : POKE 36,21: PRINT GMAX;: NORMAL : IF ENTRY = 1  THEN ENTRY = 0: GOTO 1650
  160. 1600  HTAB 27: CALL  -958: INPUT "";A$
  161. 1610  IF A$ = ""  THEN 1650
  162. 1620  IF  VAL(A$) <10  OR  VAL(A$) >999  THEN  VTAB 5: CALL  -958: INVERSE : PRINT "MUST BE >= 10 AND <=999": NORMAL : PRINT "PRESS RETURN TO CONTINUE "; CHR$(7);: POKE  -16368,0: GET A$: POKE  -16368,0: PRINT : GOTO 1590
  163. 1630 GMAX =  VAL(A$):ENTRY = 1
  164. 1640  GOTO 1590
  165. 1650  IF ER = 500  THEN ER = 0: GOTO 1990
  166. 1660  REM  ***** MAX NUMBER OF ENTRIES
  167. 1670  VTAB 7: POKE 36,0: PRINT "MAX NUMBER OF ENTRIES: ";: CALL  -958: INVERSE : POKE 36,23: PRINT NF;: NORMAL : IF ENTRY = 1  THEN ENTRY = 0: GOTO 1730
  168. 1680  HTAB 29: INPUT "";A$
  169. 1690  IF A$ = ""  THEN 1730
  170. 1700  IF  VAL(A$) >200  OR  VAL(A$) <1  THEN  VTAB 7: CALL  -958: INVERSE : PRINT "MUST BE >=1 AND  <= 200": NORMAL : PRINT "PRESS RETURN TO CONTINUE"; CHR$(7);: POKE  -16368,0: GET A$: POKE  -16368,0: PRINT : GOTO 1670
  171. 1710 NF =  VAL(A$):ENTRY = 1:NE = NF
  172. 1720  GOTO 1670
  173. 1730  IF ER = 600  THEN ER = 0: GOTO 1990
  174. 1740  REM  ****** SELECT PRINTER
  175. 1750  VTAB 9: POKE 36,0: PRINT "<I>MAGEWRITER OR <E>PSON: ";: CALL  -868: INVERSE : POKE 36,26: PRINT PM$;: NORMAL : IF ENTRY = 1  THEN ENTRY = 0: GOTO 1820
  176. 1760  HTAB 30: INPUT "";A$
  177. 1770  IF A$ = ""  THEN 1820
  178. 1780  IF A$ < >"E"  AND A$ < >"I"  THEN  PRINT  CHR$(7);: GOTO 1750
  179. 1790  IF A$ = "E"  THEN L6 = 50:L8 = 48:PS = 56
  180. 1800  IF A$ = "I"  THEN L6 = 65:L8 = 66:PS = 79
  181. 1810 PM$ = A$:ENTRY = 1
  182. 1820  VTAB 10: CALL  -868: HTAB 7: INVERSE : PRINT SLT;: NORMAL : HTAB 1: PRINT "SLOT? ";: HTAB 9: INPUT "";SL$: IF SL$ = ""  THEN 1840
  183. 1830 SLT =  VAL(SL$): IF SLT <1  OR SLT >6  THEN SLT = 1: PRINT  CHR$(7);: GOTO 1820
  184. 1840  VTAB 12: POKE 36,0: PRINT "DIVIDE GMAX INTO 10 OR 20 PARTS:";: CALL  -868: INVERSE : POKE 36,33: PRINT DIV;: NORMAL : IF ENTRY = 1  THEN ENTRY = 0: GOTO 1910
  185. 1850  HTAB 37: POKE  -16368,0: INPUT "";A$
  186. 1860  IF A$ = ""  THEN 1910
  187. 1870  IF A$ < >"10"  AND A$ < >"20"  THEN  PRINT  CHR$(7);: GOTO 1840
  188. 1880 DIV =  VAL(A$):ENTRY = 1
  189. 1890  GOTO 1840
  190. 1900  REM   ****** SELECT PREFIX
  191. 1910  VTAB 14: POKE 36,0: PRINT "PREFIX: ";: CALL  -958: INVERSE : POKE 36,8: PRINT PFX$;: NORMAL : IF ENTRY = 1  THEN ENTRY = 0: GOTO 1980
  192. 1920  HTAB ( LEN(PFX$) +10): INPUT "";A$
  193. 1930  IF A$ = ""  THEN 1980
  194. 1940  IF  LEFT$(A$,1) < >"/"  OR  RIGHT$(A$,1) < >"/"  THEN  VTAB 17: INVERSE : POKE 36,0: PRINT "NEED SLASH MARKS";: NORMAL : PRINT "PRESS RETURN TO CONTINUE ";: GET A$: PRINT : VTAB 16: CALL  -958: GOTO 1910
  195. 1950  ONERR  GOTO 2140
  196. 1960  PRINT  CHR$(4);"PREFIX"A$
  197. 1970 PFX$ = A$:ENTRY = 1
  198. 1980  PRINT : PRINT : PRINT "STORING PARAMETERS": ONERR  GOTO 2150
  199. 1990  REM  ****** WRITE PARAMETER FILE
  200. 2000  PRINT D$"OPEN"PFX$"PARAMETERS"
  201. 2010  PRINT D$"WRITE"PFX$"PARAMETERS"
  202. 2020  PRINT PFX$
  203. 2030  PRINT GMAX
  204. 2040  PRINT NE
  205. 2050  PRINT PM$
  206. 2060  PRINT SLT
  207. 2070  PRINT L6
  208. 2080  PRINT L8
  209. 2090  PRINT PS
  210. 2100  PRINT DIV
  211. 2110  PRINT D$"CLOSE"
  212. 2120  CLEAR : GOTO 80
  213. 2130  REM   ***** ERROR HANDLING
  214. 2140  VTAB 14: CALL  -958: PRINT "ERROR IN PREFIX "A$: PRINT "PRESS RETURN TO CONTINUE ";: POKE  -16368,0: GET A$: PRINT : POKE  -16368,0: CALL  -3288: GOTO 1910
  215. 2150 ER =  PEEK(222)
  216. 2160  IF ER = 5  THEN NE = I -1: GOTO 760
  217. 2170  IF ER = 6  OR ER = 7  OR ER = 13  OR ER = 16  THEN  CALL  -3288: GOTO 2200
  218. 2180  HOME : VTAB 10: PRINT : PRINT "ERROR # ";ER" IN LINE "; PEEK(219) *256 + PEEK(218)
  219. 2190  END 
  220. 2200  HOME : VTAB 5: CALL  -3288: PRINT "CAN'T FIND PATH SPECIFIED:"
  221. 2210  VTAB 7: PRINT  TAB( 8)"1. TRY AGAIN": PRINT  TAB( 8)"2. CATALOG": PRINT  TAB( 8)"3. MAIN MENU"
  222. 2220  VTAB 11: PRINT "SELECT: ";: POKE  -16368,0: GET A$: PRINT : POKE  -16368,0
  223. 2230  IF A$ < >"1"  AND A$ < >"2"  AND A$ < >"3"  THEN  GOTO 2210
  224. 2240  IF  VAL(A$) = 3  THEN  GOTO 240
  225. 2250  IF  VAL(A$) = 1  THEN  HOME : GOTO 300
  226. 2260  IF  VAL(A$) = 2  THEN  HOME : PRINT D$"CAT"
  227. 2270  PRINT : PRINT "PRESS RETURN TO CONTINUE ";: POKE  -16368,0: GET A$: PRINT 
  228. 2280  GOTO 300
  229. 2290  ONERR  GOTO 2150
  230. 2300  GOTO 2210
  231. 2310  PRINT D$"PREFIX": INPUT PFX$
  232. 2320  PRINT D$"OPENPARAMETERS"
  233. 2330  PRINT D$"WRITEPARAMETERS"
  234. 2340  PRINT PFX$: PRINT 100: PRINT 200: PRINT "I": PRINT 1: PRINT 65: PRINT 66: PRINT 79: PRINT 20
  235. 2350  PRINT D$"CLOSE": GOTO 110