home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib36b.dsk / SPREADSHEET.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  270 lines
  1. 10  REM  ************************
  2. 20  REM  *                      *
  3. 30  REM  * SPREADSHEET          *
  4. 40  REM  * BY ROBERT T. YUILLE  *
  5. 50  REM  * COPYRIGHT (C) 1989   *
  6. 60  REM  * MINDCRAFT PUBL. CORP.*
  7. 70  REM  * CONCORD, MA 01742    *
  8. 80  REM  *                      *
  9. 90  REM  ************************
  10. 100  REM   INITIALIZATION
  11. 110 G =  PEEK( -16298)
  12. 120  POKE 8,0: POKE 9,0: REM  NEWF & PRNTF
  13. 130 D$ =  CHR$(4):B$ =  CHR$(7):E$ =  CHR$(27):R$ =  CHR$(13)
  14. 140 Q$ =  CHR$(17):ST = 6:DR = 1:PR$ = "":FL$ = "SPREADSHEET.OBJ"
  15. 150 FADDR = 12299: REM   FILENAME ($300B)
  16. 160 BF = 17220: REM  SSIDCODE($4344)
  17. 170  TEXT : HOME : PRINT E$Q$: POKE 2043,255: VTAB 5: NORMAL 
  18. 180  PRINT : PRINT "          NIBBLE SPREADSHEET"
  19. 190  PRINT : PRINT "          BY ROBERT T. YUILLE"
  20. 200  PRINT : PRINT "          COPYRIGHT (C) 1989 "
  21. 210  PRINT : PRINT "          MINDCRAFT PUBL. CORP."
  22. 220  GOSUB 2240
  23. 230 :
  24. 240  REM   SET HIMEM
  25. 250 :
  26. 260 PD =  PEEK(48896) = 76: ON PD GOTO 280
  27. 270  HIMEM: 11264:D$ = R$ +D$: GOTO 340
  28. 280  POKE 768,32: POKE 769,248: POKE 770,190: POKE 771,169
  29. 290  POKE 772,106: POKE 773,32: POKE 774,245: POKE 775,190
  30. 300  POKE 776,96: CALL 768
  31. 310 :
  32. 320  REM   LOAD SS OBJECT FILE
  33. 330 :
  34. 340  ONERR  GOTO 2700
  35. 350 LK = 1: PRINT D$"BLOAD SPREADSHEET.OBJ"
  36. 360  POKE 216,0: REM  RESET ERROR FLAG
  37. 370 :
  38. 380  REM    INITIALIZE & READ MENU DATA
  39. 390 :
  40. 400  READ MITEMS: FOR J = 0 TO MITEMS: READ MENU$(J): NEXT 
  41. 410  DIM X$(1):X$(0) = "   ":X$(1) = "-->"
  42. 420 :
  43. 430  REM   MAIN MENU
  44. 440 :
  45. 450  TEXT : HOME : GOSUB 2400: ONERR  GOTO 2480
  46. 460 PX = 38:SX = 4:SE = SE +(SE = 0):MX = MITEMS: GOSUB 2320: IF Z = 20  THEN  PRINT B$: GOTO 450
  47. 470  ON SE GOTO 510,660,840,1060,1110,1160,1520,1690
  48. 480 :
  49. 490  REM   START NEW DOCUMENT
  50. 500 :
  51. 510  IF  PEEK(8) = 1  THEN  GOSUB 2180: IF ESCF = 1  THEN 450
  52. 520  GOSUB 1780: IF ESCF = 1  THEN 450
  53. 530  POKE 8,0: REM  SET NEWF FOR NEW FILE
  54. 540  HOME 
  55. 550  PRINT 
  56. 560  PRINT  CHR$(4)"PR#3": PRINT 
  57. 570  ONERR  GOTO 2630
  58. 580  CALL 12288: REM   ENTRY ($3000)
  59. 590 PRF =  PEEK(9): IF PRF = 3  THEN 560
  60. 600  IF PRF = 0  THEN 620
  61. 610  POKE 35,23: GOTO 570
  62. 620  PRINT E$Q$: POKE 2043,255: GOTO 450
  63. 630 :
  64. 640  REM   LOAD NEW DOCUMENT
  65. 650 :
  66. 660  IF  PEEK(8) = 1  THEN  GOSUB 2180: IF ESCF = 1  THEN 450
  67. 670  GOSUB 1780: IF ESCF = 1  THEN 450
  68. 680  POKE 8,0: FOR N = 0 TO 4: POKE (BF +N),0: NEXT 
  69. 690  HTAB 1: VTAB 21: PRINT "LOADING "FL$
  70. 700 LK = 2: ONERR  GOTO 2480
  71. 710  PRINT D$"BLOAD "FL$",A$4344"
  72. 720 SSIDF = 0: FOR N = 0 TO 4  STEP 2
  73. 730  IF  PEEK(BF +N) = 255  THEN  NEXT : GOTO 750
  74. 740 SSIDF = 1:N = 4: NEXT 
  75. 750  FOR N = 1 TO 3  STEP 2
  76. 760  IF  PEEK(BF +N) = 0  THEN  NEXT : GOTO 780
  77. 770 SSIDF = 1:N = 3: NEXT 
  78. 780  POKE 216,0: IF SSIDF = 1  THEN MSG$ = "FILE (" +FL$ +") IS NOT" +R$ +"A SPREADSHEET FILE": HOME : GOSUB 2130: GOTO 670
  79. 790  POKE 8,1: REM  SET NEWF FOR LOADED FILE
  80. 800  GOTO 540
  81. 810 :
  82. 820  REM   SAVE CURRENT DOCUMENT
  83. 830 :
  84. 840  HOME : IF  PEEK(8) = 0  THEN MSG$ = "THERE IS NO CURRENT DOCUMENT": GOSUB 2130: GOTO 450
  85. 850 EF = 256 * PEEK(251) + PEEK(250): REM   MP ($FA)
  86. 860 LN = EF -BF +1
  87. 870  ONERR  GOTO 960
  88. 880  PRINT D$"VERIFY "FL$
  89. 890  HOME : VTAB 5: PRINT "FILE: ("FL$") ALREADY EXISTS"
  90. 900  VTAB 13: PRINT "PRESS 'Y' TO REPLACE EXISTING FILE": PRINT : PRINT "PRESS 'N' TO RENAME FILE": VTAB 10: PRINT "DO YOU WANT TO REPLACE": PRINT "THE EXISTING FILE: (Y/N)? ";
  91. 910  GET A$
  92. 920  IF A$ = "N"  OR A$ = "n"  THEN  POKE 216,0: GOTO 1000
  93. 930  IF A$ < >"Y"  AND A$ < >"y"  THEN  GOTO 910
  94. 940 LK = 2: ONERR  GOTO 2480
  95. 950  PRINT D$"DELETE "FL$
  96. 960  HTAB 1: VTAB 21: PRINT "SAVING "FL$
  97. 970 LK = 2: ONERR  GOTO 2480
  98. 980  PRINT D$"BSAVE "FL$",A$4344,L"LN
  99. 990  POKE 216,0: GOTO 450
  100. 1000  GOSUB 1780: IF ESCF = 1  THEN 450
  101. 1010  GOTO 870
  102. 1020 :
  103. 1030  REM   RENAME CURRENT DOCUMENT
  104. 1040 :
  105. 1050  IF  PEEK(8) = 0  THEN 840
  106. 1060  GOSUB 1780: IF ESCF = 1  THEN 450
  107. 1070  GOTO 540
  108. 1080 :
  109. 1090  REM  CONTINUE WITH CURRENT DOCUMENT
  110. 1100 :
  111. 1110  IF  PEEK(8) = 0  THEN 840
  112. 1120  GOTO 540
  113. 1130 :
  114. 1140  REM   CHANGE PREFIX/SLOT/DRIVE
  115. 1150 :
  116. 1160  HOME : PRINT "THE CURRENT SETTINGS ARE:"
  117. 1170  PRINT : IF PD = 1  THEN  PRINT "PREFIX= "PR$: GOTO 1190
  118. 1180  PRINT "SLOT= "ST"  DRIVE= "DR
  119. 1190  PRINT : PRINT "PRESS THE NUMBER OF THE ITEM YOU WANT"
  120. 1200  PRINT "TO CHANGE OR <ESCAPE> TO RETURN TO": PRINT "MAIN MENU"
  121. 1210  PRINT : PRINT : HTAB 10: PRINT "1. DRIVE"
  122. 1220  PRINT : HTAB 10: PRINT "2. SLOT"
  123. 1230  IF PD = 0  THEN 1250
  124. 1240  PRINT : HTAB 10: PRINT "3. PREFIX"
  125. 1250  PRINT : PRINT : HTAB 10: PRINT "YOUR CHOICE? ";
  126. 1260  GET A$
  127. 1270  IF A$ = E$  THEN 450
  128. 1280  ON  VAL(A$) GOTO 1310,1410
  129. 1290  IF A$ = "3"  AND PD = 1  THEN 1460
  130. 1300  GOTO 1260
  131. 1310  HOME 
  132. 1320  VTAB 14: PRINT "WHICH DRIVE? (1/2) ";
  133. 1330  GET A$
  134. 1340  IF A$ = "1"  OR A$ = "2"  THEN  PRINT A$:DR =  VAL(A$): GOTO 1360
  135. 1350  GOTO 1330
  136. 1360 LK = 3: ONERR  GOTO 2480
  137. 1370  ON PD GOTO 1390
  138. 1380  PRINT D$"VERIFY CHGSD,S"ST",D"DR: GOTO 450
  139. 1390  PRINT D$"PREFIX ,S"ST",D"DR: POKE 216,0
  140. 1400  PRINT D$"PREFIX": INPUT PR$: GOTO 450
  141. 1410  HOME : VTAB 10: PRINT "WHICH SLOT? (2-7) ";
  142. 1420  ON PD GOTO 1430: HOME : VTAB 10: PRINT "WHICH SLOT? (3-6) ";
  143. 1430  GET A$
  144. 1440  IF A$ =  > CHR$(51 -PD)  AND A$ < =  CHR$(54 +PD)  THEN  PRINT A$:ST =  VAL(A$): GOTO 1320
  145. 1450  GOTO 1430
  146. 1460  HOME : VTAB 8: PRINT "BE SURE YOUR PREFIX": PRINT "BEGINS AND ENDS WITH A /": VTAB 11: INPUT "ENTER PREFIX ";PR$
  147. 1470 LK = 3: ONERR  GOTO 2480
  148. 1480  PRINT D$"PREFIX "PR$: POKE 216,0: GOTO 450
  149. 1490 :
  150. 1500  REM   HELP SCREEN
  151. 1510 :
  152. 1520  PRINT D$"PR#3"
  153. 1530  PRINT 
  154. 1540  HOME : HTAB 34: PRINT "HELP SCREEN"
  155. 1550  PRINT : HTAB 6: PRINT "<ESCAPE> - As Indicated on Top": PRINT "Line of Screen"
  156. 1560  PRINT : PRINT "ARROW KEYS - Move Spreadsheet Cursor Among Cells"
  157. 1570  PRINT : HTAB 3: PRINT "<CTRL>-A - Switches Between Automatic & Manual Calculation"
  158. 1580  PRINT : HTAB 3: PRINT "<CTRL>-B - Blanks (Deletes) Current Cell"
  159. 1590  PRINT : HTAB 3: PRINT "<CTRL>-C - Calculates Spreadsheet"
  160. 1600  PRINT : HTAB 3: PRINT "<CTRL>-D - Deletes Current Row or Column"
  161. 1610  PRINT : HTAB 3: PRINT "<CTRL>-F - Switches Between Decimal & Whole Number Format for Values"
  162. 1620  PRINT : HTAB 3: PRINT "<CTRL>-I - Inserts Row or Column BEFORE Current One"
  163. 1630  PRINT : HTAB 3: PRINT "<CTRL>-P - Sends Current Spreadsheet Lines on Screen to Printer"
  164. 1640  PRINT : HTAB 3: PRINT "<CTRL>-W - Enters Change Column Width Mode"
  165. 1650  GOSUB 2240: GOTO 620
  166. 1660 :
  167. 1670  REM   QUIT
  168. 1680 :
  169. 1690  HOME : VTAB 10: PRINT "ARE YOU SURE YOU WANT TO QUIT (Y/N)? ";
  170. 1700  GET A$
  171. 1710  IF A$ = "Y"  OR A$ = "y"  THEN 1740
  172. 1720  IF A$ = "N"  OR A$ = "n"  THEN 450
  173. 1730  GOTO 1700
  174. 1740  HOME : END 
  175. 1750 :
  176. 1760  REM   FILENAME INPUT ROUTINE
  177. 1770 :
  178. 1780  HOME :N$ = "":ESCF = 0
  179. 1790  HTAB 1: VTAB 2: PRINT "ENTER FILENAME FOR DOCUMENT": PRINT : PRINT 
  180. 1800  PRINT "PRESS '?' TO CATALOG DISK": PRINT 
  181. 1810  PRINT "<ESCAPE> ON 1ST CHAR RETURNS TO": PRINT "MAIN MENU": PRINT 
  182. 1820  PRINT "<ESCAPE> ON ANY OTHER CHARACTER": PRINT " CANCELS INPUT AND STARTS OVER": PRINT 
  183. 1830  PRINT "LEFT ARROW MOVES BACK ONE POSITION": PRINT 
  184. 1840  PRINT "<RETURN> ACCEPTS INPUT"
  185. 1850  VTAB 17: PRINT "FILENAME: ";
  186. 1860  GET C$: IF C$ =  CHR$(8)  THEN 1860
  187. 1870  IF C$ = E$  THEN 450
  188. 1880  IF C$ < >"?"  THEN 1910
  189. 1890 LK = 4: ONERR  GOTO 2480
  190. 1900  PRINT D$ LEFT$("CATALOG",7 -4 *PD): GOSUB 2240: GOTO 1780
  191. 1910 AN =  PEEK(49152)
  192. 1920  IF AN >96  AND AN <123  THEN AN = AN -32
  193. 1930  IF AN <65  OR AN >90  THEN MSG$ = "FIRST POSITION MUST BE A LETTER": GOSUB 2130: GOTO 1780
  194. 1940  PRINT  CHR$(AN):N$ =  CHR$(AN)
  195. 1950  FOR K = 1 TO 15
  196. 1960  VTAB 17: HTAB (11 +K): GET C$
  197. 1970  IF C$ = E$  THEN K = 15: NEXT : GOTO 1780
  198. 1980  IF C$ =  CHR$(8)  AND K = 1  THEN K = 15: NEXT : GOTO 1790
  199. 1990  IF C$ =  CHR$(8)  THEN K = K -1: HTAB (11 +K): PRINT " ":N$ =  LEFT$(N$,K): GOTO 1960
  200. 2000  IF C$ = R$  THEN K = 15: GOTO 2050
  201. 2010 AN =  PEEK(49152)
  202. 2020  IF AN >96  AND AN <123  THEN AN = AN -32
  203. 2030  IF (AN <65  OR AN >90)  AND (AN <48  OR AN >57)  AND AN < >46  THEN MSG$ = "CHARACTER CANNOT BE USED IN FILENAME": GOSUB 2130: GOTO 1960
  204. 2040  PRINT  CHR$(AN):N$ = N$ + CHR$(AN)
  205. 2050  NEXT 
  206. 2060  IF C$ < >R$  THEN MSG$ = "FILENAME TOO LONG, LIMIT - 15 CHARACTERS": GOSUB 2130: GOTO 1780
  207. 2070 FL$ = N$
  208. 2080  FOR I = 0 TO 15: POKE FADDR +I,0: NEXT 
  209. 2090  FOR K = 1 TO  LEN(N$): POKE FADDR -1 +K, ASC( MID$ (N$,K,1)) +128: NEXT : RETURN 
  210. 2100 :
  211. 2110  REM   PRINT ERROR MESSAGES
  212. 2120 :
  213. 2130  PRINT B$: HTAB 1: VTAB 19: PRINT MSG$: PRINT : PRINT 
  214. 2140  PRINT "PRESS <RETURN> AND TRY AGAIN: ";: GET A$: HTAB 1: VTAB 19: CALL  -958: RETURN 
  215. 2150 :
  216. 2160  REM   ERASE CURRENT DOCUMENT?
  217. 2170 :
  218. 2180  HOME :ESCF = 0: VTAB 8: PRINT "YOU ARE ABOUT TO ERASE": PRINT "THE CURRENT DOCUMENT."
  219. 2190  VTAB 12: PRINT "ARE YOU SURE YOU": PRINT "WANT TO DO THIS? (Y/N) ";
  220. 2200  GET A$
  221. 2210  IF A$ = "N"  OR A$ = "n"  THEN ESCF = 1: RETURN 
  222. 2220  IF A$ = "Y"  OR A$ = "y"  THEN  RETURN 
  223. 2230  GOTO 2200
  224. 2240  HTAB 1: VTAB 24: PRINT "PRESS <RETURN> TO CONTINUE: ";: GET A$: RETURN 
  225. 2250 :
  226. 2260  REM   DATA FOR MAIN MENU
  227. 2270 :
  228. 2280  DATA  8,MAIN MENU,START NEW DOCUMENT,LOAD DOCUMENT,SAVE CURRENT DOCUMENT,RENAME CURRENT DOCUMENT,CONTINUE WITH CURRENT DOCUMENT,CHANGE PREFIX/SLOT/DRIVE,HELP SCREEN,QUIT
  229. 2290 :
  230. 2300  REM   MENU HANDLER
  231. 2310 :
  232. 2320 SL = SE
  233. 2330 N = SL:OS = SL: GOSUB 2360:Z = 0: VTAB 24: HTAB PX: CALL  -868: POKE  -16368,0
  234. 2340  VTAB 24: HTAB PX: PRINT SL;: WAIT  -16384,128:Z =  PEEK( -16384) -128: IF Z > = 49  AND Z < = MX +48  THEN SL = Z -48:N = OS: GOSUB 2360: GOTO 2330
  235. 2350 Z = (Z = 21  OR Z = 10) -(Z = 8  OR Z = 11) +10 *(Z = 13) +20 *(Z = 27): ON   NOT Z GOTO 2340:SL = SL +Z *(Z <10):SL = SL -MX *(SL >MX) +MX *(SL <1):N = OS: GOSUB 2360: ON Z <10 GOTO 2330:SE = SL: POKE  -16368,0: RETURN 
  236. 2360  VTAB 3 +2 *N: HTAB SX: PRINT X$(SL = OS);: RETURN 
  237. 2370 :
  238. 2380  REM   PRINT A MENU
  239. 2390 :
  240. 2400  HOME :TL$ = MENU$(0)
  241. 2410  VTAB 2: HTAB  INT((40 - LEN(TL$))/2): PRINT TL$
  242. 2420  FOR I = 1 TO MITEMS: VTAB 3 +2 *I: HTAB 8: PRINT I". "MENU$(I): NEXT 
  243. 2430  VTAB 24: HTAB 1: PRINT "USE ARROWS/NUMBERS & PRESS RETURN";
  244. 2440  RETURN 
  245. 2450 :
  246. 2460  REM   DISK ERRORS
  247. 2470 :
  248. 2480  HOME : VTAB 10: POKE 216,0:EN =  PEEK(222):EL =  PEEK(218) +256 * PEEK(219)
  249. 2490  IF EN = 6  AND EL = 1400  THEN  CALL  -3288: GOTO 450
  250. 2500  IF (EN = 6  OR EN = 7)  AND LK = 3  THEN MSG$ = "PREFIX NOT FOUND":PR$ = "": GOTO 2590
  251. 2510  IF (EN = 6  OR EN = 7)  AND LK = 4  THEN MSG$ = "I/O ERROR": GOTO 2590
  252. 2520  IF EN = 3  THEN MSG$ = "NO DEVICE IN SLOT":ST = 6: GOTO 2590
  253. 2530  IF EN = 6  OR EN = 7  THEN MSG$ = "FILE (" +FL$ +")" +R$ +"IS NOT ON THIS DISK.": GOTO 2590
  254. 2540  IF EN = 8  THEN MSG$ = "I/O ERROR": GOTO 2590
  255. 2550  IF EN = 13  THEN MSG$ = "FILE (" +FL$ +")" +R$ +"IS NOT A BINARY FILE.": GOTO 2590
  256. 2560  IF EN = 9  OR EN = 17  THEN MSG$ = "DISK OR DIRECTORY IS FULL.": GOTO 2590
  257. 2570  IF EN = 10  THEN MSG$ = "EXISTING FILE (" +FL$ +") IS LOCKED.": GOTO 2590
  258. 2580  PRINT "A SYSTEM ERROR #"EN" HAS OCCURRED": PRINT "AT LINE #"EL:MSG$ = "":LK = 2
  259. 2590  GOSUB 2130: CALL  -3288: ON LK GOTO 340,450,1160,1780
  260. 2600 :
  261. 2610  REM   FORMULA EVALUATION ERRORS
  262. 2620 :
  263. 2630  POKE 216,0: POKE 1403,0: VTAB 24: CALL  -868
  264. 2640  IF  PEEK(222) = 16  THEN  PRINT "SYNTAX ERROR IN CELL: ";
  265. 2650  IF  PEEK(222) = 53  THEN  PRINT "ILLEGAL QUANTITY IN CELL: ";
  266. 2660  IF  PEEK(222) = 69  THEN  PRINT "NUMBER TOO LARGE IN CELL: ";
  267. 2670  IF  PEEK(222) = 133  THEN  PRINT "DIVISION BY ZERO IN CELL: ";
  268. 2680  PRINT  CHR$( PEEK(238)); PEEK(239)" - PRESS <RETURN> AND CORRECT THE CELL FORMULA ";
  269. 2690  GET A$: CALL  -3288: GOTO 540
  270. 2700  HOME : PRINT "CANNOT FIND SPREADSHEET.OBJ.": VTAB 23: END