home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib36a.dsk / MAY.1989 / PROOF.bas < prev    next >
BASIC Source File  |  2023-02-26  |  13KB  |  212 lines
  1. 10  REM  ****************************
  2. 20  REM  * PROOF                    *
  3. 30  REM  * BY RICHARD R. HIATT      *
  4. 40  REM  * COPYRIGHT(C) 1989        *
  5. 50  REM  * BY MINDCRAFT PUBL. CORP. *
  6. 60  REM  * CONCORD, MA 01742        *
  7. 70  REM  ****************************
  8. 80  LOMEM: 24576: TEXT : HOME :D$ =  CHR$(4): PRINT D$"PR#3": PRINT  SPC( 40)"PROOF": HTAB 35: PRINT "BY RICHARD R. HIATT": HTAB 36: PRINT "COPYRIGHT(C) 1989": HTAB 35: PRINT "BY MINDCRAFT PUBL. CORP."
  9. 90  FOR I = 848 TO 857: READ J: POKE I,J: NEXT :D$ =  CHR$(4)
  10. 100  DIM M$(16),VL$(16),SL%(16),DR%(16),V$(8),K$(34): FOR I = 0 TO 34: READ K$(I): NEXT 
  11. 110  ONERR  GOTO 130
  12. 120  GOTO 140
  13. 130  CALL 848: HOME : VTAB 10: PRINT "The disk in the current drive must have the file PROOF.BIN": END 
  14. 140 J = 0: FOR I = 16384 TO 16483:J = J + PEEK(I): NEXT : IF J < >11406  THEN  PRINT D$"BRUN PROOF.BIN": POKE 216,0
  15. 150 ER = 16396:EC = ER +3:LN = EC +3:PL = LN +3:NF = 0:EE = 768:VB = 20480:LD = 48944:DS = 48700: POKE 216,0: DEF  FN CL(X) = X -26 * INT(X/26.01): DEF  FN CH(X) =  INT(X/26.01)
  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): DEF  FN L1(X) = X -16 * INT(X/16): DEF  FN H1(X) =  INT(X/16): DEF  FN DV(X) = 128 *(X -1) +16 *SL%
  17. 170  GOTO 1970
  18. 180  REM  INPUT ROUTINES
  19. 190  REM  GENERAL ALPHANUMERIC
  20. 200 CG = 1:
  21. 210  GOSUB 2120: PRINT  SPC( 37 - LEN(K$(Q)))"Escape: "K$(Q): VTAB 9: PRINT V$(0);: IF CG  THEN  PRINT "  (If there is no additional input before Return is pressed,": PRINT "the main directory will be cataloged.)";
  22. 220  PRINT :PW = 1:ML = 63 - LEN(VL$):P = 858: VTAB 12: PRINT VL$"/";: GOTO 260
  23. 230 CD = 1:ML = 2: GOTO 260
  24. 240 NQ = 1:ML = 1: PRINT "? (Y/N) ";: GOTO 260
  25. 250 NB = 1
  26. 260 Q$ = "":T = 0:SH = 0
  27. 270  GET CR$:Q =  ASC(CR$):Q = Q -32 *(Q >96):CR$ =  CHR$(Q):L =  LEN(Q$): IF Q = 13  AND L = 0  AND ML >0  AND CG = 0  THEN 270
  28. 280  IF Q = 27  AND ML = 0  THEN NB = 0: PRINT : RETURN 
  29. 290  IF Q = 27  AND PW = 1  THEN PW = 0:CG = 0: PRINT : POP : RETURN 
  30. 300  IF Q = 13  THEN  PRINT :NB = 0:CG = 0:CD = 0:PW = 0:NQ = 0:Q =  VAL(Q$): RETURN 
  31. 310  IF L > = ML  AND Q < >8  THEN 270
  32. 320  IF Q < >8  OR L = 0  THEN 360
  33. 330  PRINT  CHR$(8)" " CHR$(8);: IF L = 1  THEN 260
  34. 340  IF PW  THEN K =  ASC( RIGHT$(Q$,1)):T = T -(K < >47): IF K = 47  THEN SH = SH -1:T =  PEEK(P +SH)
  35. 350 L = L -1:Q$ =  LEFT$(Q$,L): GOTO 270
  36. 360  IF NB  AND (Q <48  OR Q >57)  THEN 270
  37. 370  IF NQ  AND (Q < >89  AND Q < >78)  THEN 270
  38. 380  IF PW  THEN 410
  39. 390  IF CD  AND (Q <65  OR Q >90)  THEN 270
  40. 400  PRINT CR$;:Q$ = Q$ +CR$: GOTO 270
  41. 410  IF T = 0  AND (Q <65  OR Q >90)  THEN 270
  42. 420  IF Q = 47  AND L <ML -1  THEN  POKE P +SH,T:SH = SH +1:T = 0: GOTO 400
  43. 430  IF (Q = 46  OR (Q >47  AND Q <58)  OR (Q >64  AND Q <91))  AND T <15  THEN T = T +1: GOTO 400
  44. 440  GOTO 270
  45. 450 P =  PEEK( -16384): IF P <128  THEN 450
  46. 460  POKE  -16368,0: RETURN 
  47. 470  REM  SELECT SLOT/DRIVE
  48. 480 VS = 9: HOME : VTAB 2: CALL LN: VTAB 22: CALL LN: GOSUB 2120: VTAB 1: PRINT  SPC( 12)"Escape: "K$(28): VTAB 6: HTAB 18: PRINT K$(32): PRINT : PRINT : HTAB 18: PRINT "Slot  Drive  Volume"
  49. 490  VTAB 23: PRINT "Use arrow keys to select choice and press Return"
  50. 500  POKE 34,9: POKE 35,19
  51. 510  VTAB 9:J = 0:C = 1:K = 14: IF ND <K -1  THEN K = ND +1
  52. 520  HOME ::C = J +1: FOR I = J +1 TO K -2: HTAB 20: PRINT M$(I): NEXT :V = VS +1: HTAB 20: PRINT M$(K -1);: GOTO 640
  53. 530  GOSUB 450: IF P = 141  THEN 650
  54. 540  IF P = 155  THEN C = 0: GOTO 650
  55. 550 P = P -137: IF P <1  OR P >2  THEN 530
  56. 560  ON P GOTO 610,570
  57. 570 I = C -1: IF I = J  AND J >0  THEN J = J -1:K = K -1
  58. 580  IF I = J  THEN 530
  59. 590  IF I = J +1  THEN 520
  60. 600  VTAB V: HTAB 20: PRINT M$(C);:V = V -1 +(V <7):C = I: GOTO 640
  61. 610 I = C +1: IF I = K  AND K <ND +1  THEN K = K +1:J = J +1
  62. 620  IF I = K  THEN 530
  63. 630  VTAB V: HTAB 20: PRINT M$(C):V = V +1 -(V = 19):C = I
  64. 640  VTAB V: INVERSE : HTAB 20: PRINT M$(C);: NORMAL : GOTO 530
  65. 650  POKE 34,0: POKE 35,24: POKE 36,0: HOME :: IF   NOT C  THEN  POP 
  66. 660  RETURN 
  67. 670  REM  MENU DISPLAY/SELECT
  68. 680  HOME : GOSUB 2120: PRINT  SPC( 37 - LEN(K$(T)))"Escape: "K$(T): FOR I = 1 TO K -1:V$(I) = K$(I +Q): NEXT :V = 2: GOSUB 880
  69. 690 V = 22: GOSUB 880: PRINT "Use arrow keys or numbers to select choice and press Return"
  70. 700 VS = 12 -K:S = 20: VTAB VS -2: HTAB S: PRINT K$(Q)
  71. 710 J = 0:V = VS +1: VTAB V: FOR I = 1 TO K -1: HTAB S: PRINT I". "V$(I): NEXT :C = 1: GOTO 780
  72. 720  GOSUB 450: IF P = 141  THEN  HOME :Q = C: RETURN 
  73. 730  IF P = 155  THEN C = 0: HOME : GOTO 790
  74. 740 Q = P -176: IF Q >J  AND Q <K  THEN I = Q: GOTO 770
  75. 750 Q = P -138: IF Q <0  OR Q >1  THEN 720
  76. 760 Q = Q -(Q = 0):I = C -Q: IF I = K  OR I = J  THEN 720
  77. 770  VTAB V: HTAB S: PRINT C". "V$(C):V = VS +I:C = I
  78. 780  VTAB V: HTAB S: PRINT C". ";: INVERSE : PRINT V$(C): NORMAL : GOTO 720
  79. 790  IF T < >0  THEN  POP : RETURN 
  80. 800  HOME :: VTAB 10: PRINT  SPC( 23)"Do you really want to quit";: GOSUB 240: IF Q$ = "N"  THEN  RETURN 
  81. 810  HOME : END 
  82. 820  HOME : GOSUB 2120: PRINT  SPC( 15)"Escape: Return to Analyze Menu": PRINT "Analyzing:";: HTAB 20: IF H = 1  THEN  PRINT "Column "C$;: HTAB 32: PRINT "From Row "R1" to "R2;: GOTO 840
  83. 830  PRINT "Row "R;: HTAB 30: PRINT "From "C$;: HTAB 38: PRINT "to "C1$;
  84. 840  IF DE  THEN  HTAB 53: PRINT "Not";
  85. 850  HTAB 57: PRINT "Displaying empty cells"
  86. 860 V = 3: GOSUB 880:V = 22: GOSUB 880: PRINT : POKE 34,4: IF HC  THEN  PRINT D$"PR#1"
  87. 870  RETURN 
  88. 880  VTAB V: CALL LN: RETURN 
  89. 890  REM  UTILITY ROUTINES
  90. 900 C = (80 - LEN(V$(0)))/2: IF C <0  THEN C = 0
  91. 910  RETURN 
  92. 920  VTAB 22
  93. 930  PRINT K$(15);:ML = 0: GOSUB 250: RETURN 
  94. 940 V$(0) = K$(16)
  95. 950  CALL PL: CALL PL: GOSUB 900
  96. 960  HOME :: VTAB 10: PRINT  SPC( C)V$(0): GOSUB 920: HOME :: RETURN 
  97. 970 I =  FN CL(Q):J =  FN CH(Q):Q$ =  CHR$(I +64): IF J >0  THEN Q$ =  CHR$(J +64) +Q$
  98. 980  RETURN 
  99. 990  GOSUB 900: VTAB 10: PRINT  SPC( C)V$(0): RETURN 
  100. 1000  IF  PEEK(EE) = 255  THEN  TEXT : HOME :: PRINT D$"PR#0": PRINT D$"PR#3": POP : POP : POP 
  101. 1010  RETURN 
  102. 1020  REM  READ DATA ROUTINES
  103. 1030  REM  CHOOSE A COL
  104. 1040  PRINT "From";: GOTO 1060
  105. 1050  PRINT "To";
  106. 1060  PRINT " What Column? ("S$"-"T$") ";: GOSUB 230: RETURN 
  107. 1070 I =  LEN(Q$):J =  ASC(Q$) -64: IF I >1  THEN I =  ASC( RIGHT$(Q$,1)) -64:J = 26 *J +I
  108. 1080  RETURN 
  109. 1090  REM  GET A ROW
  110. 1100  PRINT "From";: GOTO 1120
  111. 1110  PRINT "To";
  112. 1120  PRINT " What Row # ("I"-"J") ";:ML = 3: GOSUB 250: RETURN 
  113. 1130  REM  CHOOSE A COLUMN
  114. 1140 Q = NC: GOSUB 970:S$ = Q$:Q = MC: GOSUB 970:T$ = Q$
  115. 1150  GOSUB 1060: GOSUB 1070:C = J: IF J <NC  OR J >MC  THEN  GOSUB 940: GOTO 1150
  116. 1160  REM  CHOOSE FROM-TO ROW
  117. 1170  HOME ::I = NR:J = MR
  118. 1180  GOSUB 1100:R1 = Q: PRINT :I = Q:J = MR
  119. 1190  GOSUB 1110:R2 = Q: IF R1 >R2  OR R1 <NR  OR R2 >MR  THEN  GOSUB 940: GOTO 1170
  120. 1200  RETURN 
  121. 1210  REM  DO COL C FROM R1 TO R2
  122. 1220  POKE 26,C: POKE 27, FN L(R1): POKE 28, FN H(R1): POKE 29, FN L(R2): POKE 30, FN H(R2): POKE 255,56
  123. 1230  CALL EC: GOSUB 1000: RETURN 
  124. 1240  REM  CHOOSE A ROW
  125. 1250 I = NR:J = MR: GOSUB 1120:R = Q: IF Q <I  OR Q >J  THEN  GOSUB 940: GOTO 1250
  126. 1260  REM  CHOOSE FROM-TO COLUMN
  127. 1270  HOME :Q = NC: GOSUB 970:S$ = Q$:Q = MC: GOSUB 970:T$ = Q$
  128. 1280  GOSUB 1040: GOSUB 1070:C1 = J:Q = J: GOSUB 970:S$ = Q$: GOSUB 1050: GOSUB 1070:C2 = J: IF C1 >C2  OR C1 <NC  OR C2 >MC  THEN  GOSUB 940: GOTO 1270
  129. 1290  RETURN 
  130. 1300  REM  DO ROW R FROM C1 TO C2
  131. 1310  POKE 26, FN L(R): POKE 27, FN H(R): POKE 28,C1: POKE 29,C2: POKE 255,56
  132. 1320  CALL ER: GOSUB 1000: RETURN 
  133. 1330  REM  ANALYZE SELECTION
  134. 1340 K = 5:Q = 5:T = 4: GOSUB 680:H = C
  135. 1350 HC = 0: PRINT "Do you want hard copy";: GOSUB 240: IF Q$ = "Y"  THEN HC = 1
  136. 1360 DE = 0: POKE 234,DE: PRINT "Display empty cells";: GOSUB 240: IF Q$ = "N"  THEN DE = 1: POKE 234,DE
  137. 1370  POKE 231,HC: HOME : ON C GOSUB 1410,1450,1480,1480: GOTO 1340
  138. 1380  PRINT : POKE 34,0: IF HC  THEN  PRINT D$"PR#0": PRINT D$"PR#3"
  139. 1390  RETURN 
  140. 1400  REM  COLUMN
  141. 1410  GOSUB 1140:Q = C: GOSUB 970:C$ = Q$: GOSUB 820
  142. 1420  GOSUB 1220: IF   NOT HC  THEN  GOSUB 1580
  143. 1430  GOTO 1380
  144. 1440  REM  ROW
  145. 1450  GOSUB 1250:Q = C1: GOSUB 970:C$ = Q$:Q = C2: GOSUB 970:C1$ = Q$: GOSUB 820
  146. 1460  GOSUB 1310: IF   NOT HC  THEN  GOSUB 1580
  147. 1470  GOTO 1380
  148. 1480 K = 3:T = 17:Q = 18: GOSUB 680: IF H = 4  THEN C1 = NC:C2 = MC:R1 = NR:R2 = MR:H = 3 -C: GOTO 1500
  149. 1490 H = H -C: GOSUB 1170: HOME : GOSUB 1270
  150. 1500 Q = C1: GOSUB 970:C$ = Q$: IF H = 2  THEN Q = C2: GOSUB 970:C1$ = Q$
  151. 1510 R = R1:C = C1: GOSUB 820: IF H = 2  THEN 1550
  152. 1520  FOR C = C1 TO C2: IF   NOT HC  THEN Q = C: GOSUB 970: VTAB 2: HTAB 27: PRINT Q$;: VTAB 4: PRINT : HOME 
  153. 1530  GOSUB 1220: IF   NOT HC  THEN  GOSUB 1580
  154. 1540  PRINT : NEXT : GOTO 1380
  155. 1550  FOR R = R1 TO R2: IF   NOT HC  THEN  VTAB 2: HTAB 24: PRINT R;: VTAB 4: PRINT : HOME 
  156. 1560  GOSUB 1310: IF   NOT HC  THEN  GOSUB 1580
  157. 1570 : PRINT : NEXT : GOTO 1380
  158. 1580  IF  PEEK(34) = 0  THEN  PRINT :C = C2:R = R2: RETURN 
  159. 1590  CALL PL: CALL PL: CALL PL: VTAB 24: PRINT K$(15)" ";
  160. 1600  GOSUB 450: IF P < >141  AND P < >155  THEN 1600
  161. 1610  PRINT : IF P = 155  THEN  POKE 34,0: POP 
  162. 1620  RETURN 
  163. 1630  REM  GET ACTIVE DEVICES/VOLUME
  164. 1640  VTAB 2: CALL LN: VTAB 22: CALL LN:V$(0) = "Checking Drives/Volume": GOSUB 990
  165. 1650  FOR I = VB TO VB +255: POKE I,0: NEXT : POKE 10,DV: CALL 16387: IF   NOT DV  THEN 1680
  166. 1660 Q =  FN L1( PEEK(VB)): IF   NOT Q  THEN V$(0) = K$(33): GOTO 950
  167. 1670 VL$ = "/": FOR I = 1 TO Q:VL$ = VL$ + CHR$( PEEK(VB +I)): NEXT : RETURN 
  168. 1680 ND = 0: FOR P = VB TO VB +250  STEP 16:K =  PEEK(P):Q =  FN L1(K): IF   NOT Q  THEN 1710
  169. 1690 :ND = ND +1:VL$(ND) = "": FOR I = 1 TO Q:VL$(ND) = VL$(ND) + CHR$( PEEK(P +I)): NEXT :Q =  FN H1(K):Q% = Q/8:SL%(ND) = Q -8 *Q%:DR%(ND) = Q% +1
  170. 1700 M$(ND) =  STR$(SL%(ND)) +"    " + STR$(DR%(ND)) +"    " +VL$(ND)
  171. 1710  NEXT : RETURN 
  172. 1720  REM  SELECT SLOT/DRIVE
  173. 1730 T = DV:DV = 0: GOSUB 1640:DV = T: IF   NOT ND  THEN V$(0) = K$(12): GOTO 950
  174. 1740 Q = 29: GOSUB 480:SL% = SL%(C):DR% = DR%(C):DV =  FN DV(DR%): PRINT D$"PREFIX,S"SL%",D"DR%: RETURN 
  175. 1750  REM  ENTER PATHNAME
  176. 1760  GOSUB 1640: HOME :V$(0) = K$(22):Q = 4: VTAB 2: CALL LN: VTAB 22: CALL LN: VTAB 1: GOSUB 210: VTAB 2: CALL LN: VTAB 22: CALL LN: POKE P +SH,T: IF  RIGHT$(Q$,1) = "/"  THEN Q$ =  LEFT$(Q$,L -1):SH = SH -1
  177. 1770 T$ = VL$ +"/" +Q$:T$ =  CHR$( LEN(T$)) +T$: POKE 804,0: POKE 807,0:V$(0) = "Checking pathname": GOSUB 990:T$ = T$: CALL 16390:Q =  PEEK(804): HOME : IF Q  THEN 1790
  178. 1780 Q =  PEEK(3):T = (Q = 68) +2 *(Q = 70): PRINT :V$(0) = K$(29 +T): GOTO 950
  179. 1790  IF Q < >27  THEN V$(0) = "That is not a spread sheet file": GOTO 950
  180. 1800  IF  PEEK(807) < >2  THEN V$(0) = "That is not a sapling file": GOTO 950
  181. 1810 NF = 0:V$(0) = "Finding key block of the file, loading it and scanning file dimensions": GOSUB 990: POKE 11,2: POKE 12,0:I =  -1:K = 1
  182. 1820 I = I +1: IF I >SH  THEN  PRINT "Something wrong here": GOSUB 920: RETURN 
  183. 1830 L =  PEEK(P +I):T$ =  MID$ (Q$,K,L): POKE 227,15 +12 *(I = SH):K = K +L +1: POKE 10,DV:T$ = T$: CALL 16393: IF I <SH  THEN 1820
  184. 1840  GOSUB 1000:NF = 1:MC =  PEEK(27):NC =  PEEK(26):MR =  FN D(30):NR =  FN D(28): HOME : VTAB 2: CALL LN: VTAB 22: CALL LN: GOSUB 2120: VTAB 1: HTAB 53: PRINT "Escape: Return to main menu"
  185. 1850  VTAB 8: PRINT  SPC( 15)"File Parameters": PRINT : HTAB 30: PRINT "Col" SPC( 13)"Row"
  186. 1860 Q = NC: GOSUB 970: PRINT  SPC( 15)K$(10);: HTAB 31: PRINT Q$;: HTAB 47: PRINT NR:Q = MC: GOSUB 970: PRINT  SPC( 15)K$(11);: HTAB 31: PRINT Q$;: HTAB 47: PRINT MR: PRINT : VTAB 23: GOSUB 930: RETURN 
  187. 1870  REM  SELECT FILE OPTIONS
  188. 1880 K = 4:Q = 21:T = 4: GOSUB 680: IF C = 1  THEN  GOSUB 1760: RETURN 
  189. 1890  ON C -1 GOSUB 1730,1900: GOTO 1880
  190. 1900  VTAB 6:K = 3:Q = 25:T = 28: GOSUB 680
  191. 1910  ONERR  GOTO 1960
  192. 1920  ON C GOSUB 1930,1940: POKE 216,0: RETURN 
  193. 1930 K = 33: PRINT D$"CATALOG": GOSUB 930: RETURN 
  194. 1940  GOSUB 1640:K = 34: HOME :V$(0) = "Complete pathname":Q = 28: VTAB 2: CALL LN: VTAB 22: CALL LN: VTAB 1: GOSUB 200: HOME : IF   NOT L  THEN 1930
  195. 1950 T$ = VL$ +"/" +Q$: PRINT D$"CATALOG"T$: GOSUB 930: RETURN 
  196. 1960  POKE 216,0: CALL 848: HOME :V$(0) = K$(K): GOSUB 950: POP : GOTO 1900
  197. 1970  PRINT : PRINT : PRINT :DV = 16 * FN H1( PEEK(LD)): VTAB 8: PRINT  SPC( 10)"You may replace the program disk with an Appleworks data disk": PRINT  SPC( 14)"or/and put data disks in any other drives available."
  198. 1980 Q =  FN H1(DV):DR% = Q/8 +1:SL% = Q -8 *(DR% -1): PRINT : PRINT  SPC( 13)"After selecting Slot/Drive/File, please leave the disk": PRINT  SPC( 21)"in that drive until finished analyzing."
  199. 1990  PRINT : PRINT  SPC( 21)"Current slot = "SL%".   Current drive = "DR%".": GOSUB 920: HOME :SS% = SL%:DD% = DR%:DV% = DV
  200. 2000  REM  MAIN MENU
  201. 2010 K = 3:T = 0:Q = 1: GOSUB 680: IF C >1  AND NF = 0  THEN V$(0) = "You must " +K$(2) +" First": GOSUB 950: GOTO 2010
  202. 2020  POKE EE,0: HOME : ON Q GOSUB 1880,1340: GOTO 2010
  203. 2030  DATA 104,168,104,166,223,154,72,152,72,96 
  204. 2040  DATA End Program,Main Menu,Select a File,Analyze the File  
  205. 2050  DATA Return to Main Menu,"Analyze:",A Column,A Row,A Block,Entire File 
  206. 2060  DATA "Minimum","Maximum"
  207. 2070  DATA No disks in active devices,That is not a spread sheet file,That is not a sapling file
  208. 2080  DATA Press Return to Continue,Input error
  209. 2090  DATA Return to Analyze Menu,"Analyze:",By Rows,By Columns  
  210. 2100  DATA Select File Menu,Enter pathname for file,Change slot/drive,Catalog disk,"Catalog:",Main directory,By pathname,Return to Select file Menu
  211. 2110  DATA I/O error,Path to file's subdirectory is bad,File not found in specified directory,Select slot/drive,No disk in active drive,Pathname not found
  212. 2120  VTAB 1: HTAB 1: PRINT "PROOF (C) 1989 by MicroSPARC, INC.";: RETURN