home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib35b.dsk / SHAPE.LIBRARIAN.bas < prev    next >
BASIC Source File  |  2023-02-26  |  20KB  |  259 lines
  1. 10  REM  *************************
  2. 20  REM  * SHAPE.LIB.PARTA       *
  3. 30  REM  * BY JAMES BRODSKY      *
  4. 40  REM  * COPYRIGHT(C) 1989     *
  5. 50  REM  * MINDCRAFT PUBL. CORP. *
  6. 60  REM  * CONCORD, MA 01742     *
  7. 70  REM  *************************
  8. 80  TEXT : HOME : PRINT  CHR$(4)"PR#0": PRINT  CHR$(4)"IN#0": PRINT  CHR$(21): VTAB 12:A$ = "SHAPE.LIBRARIAN": GOSUB 830: IF  PEEK(104) < >96  THEN  POKE 103,1: POKE 104,96: POKE 24576,0: PRINT  CHR$(4)"RUN SHAPE.LIBRARIAN"
  9. 90 X =  PEEK(175) +256 * PEEK(176) -1654: IF  PEEK(X) = 160  AND  PEEK(X +1) = 0  THEN  CALL X
  10. 100 I = 0:J = 0:T = 0:D$ =  CHR$(4):E$ =  CHR$(27):KB% =  -16384:KR% =  -16368:V1$ =  CHR$(91):V2$ =  CHR$(93):R1$ = V1$ +"RETURN" +V2$:R$ = "PRESS " +R1$
  11. 110  SCALE= 1: ROT= 0: HCOLOR= 3:ESCAPE = 6: POKE 230,64:PRODOS =  PEEK(48896) = 76:C$ = "CATALOG":DOS = 43616:SL =  PEEK(43626):DR =  PEEK(43624)
  12. 120  IF PRODOS  THEN C$ = "CAT": PRINT D$"PREFIX": INPUT PF$:SL =  PEEK(48700):DR =  PEEK(48701):DOS = 48840: POKE 48996,255: GOTO 140
  13. 130  IF  PEEK(978) < >157  THEN  HOME : VTAB 12: PRINT "CAN'T RUN WITH DOS AT THIS LOCATION": PRINT : PRINT "BYE...": PRINT D$"FP"
  14. 140  DEF  FN HI(X) =  INT(X/256): DEF  FN LO(X) = X -256 * FN HI(X): DEF  FN PTR(X) =  PEEK(X) +256 * PEEK(X +1):CLR =  -958:B$ =  CHR$(8):SAVFLAG% = 0:Q$ =  CHR$(34)
  15. 150  DIM M$(10,3),ES$(8),LD%(2),PR$(4): FOR J = 1 TO 3: READ IT%(J): READ M$(0,J): FOR I = 1 TO IT%(J): READ M$(I,J): NEXT : NEXT : FOR I = 2 TO 8: READ ES$(I): NEXT : FOR I = 1 TO 4: READ PR$(I): NEXT 
  16. 160  VTAB 17: PRINT : HTAB 13: PRINT "BY JAMES BRODSKY": PRINT : HTAB 12: PRINT "COPYRIGHT (C) 1988": HTAB 12: PRINT "MINDCRAFT PUBL. CORP."
  17. 170  PRINT : HTAB 8: PRINT "PRESS RETURN TO CONTINUE": POKE KR%,0: WAIT KB%,128: POKE (KR%),0
  18. 180  GOSUB 200: GOTO 1030
  19. 190  REM MISC. SUBS
  20. 200  POKE 34,0: HOME : & MOVE,1024,2047 TO 2048: RETURN : REM CLEAR TEXT PAGE 2
  21. 210  &  LENK:SB =  FN PTR(6):SE =  FN PTR(8): RETURN : REM SHAPE START & END
  22. 220  REM TOOLONG
  23. 230  ON LD%(2) GOTO 290: GOSUB 200: GOSUB 860: VTAB 12:A$ = "ACTION NOT COMPLETED": GOSUB 830: PRINT : PRINT : PRINT "TABLES TOO LONG": PRINT 
  24. 240  ON OP% < >1 GOTO 260: PRINT "SHAPE NOT ";OP$;"ED": IF SAVFLAG% <2  THEN SAVFLAG% = 5
  25. 250  GOTO 280
  26. 260  IF I >1  THEN  PRINT "SHAPES ";L;" THRU ";L +I -1;" ";OP$;"ED": GOTO 280
  27. 270  PRINT "SHAPE ";L;" ";OP$;"ED"
  28. 280  GOSUB 450:I = J: POKE ESCAPE,1: RETURN 
  29. 290  POKE 34,0: IF OP% = 1  THEN  GOSUB 200: GOSUB 860
  30. 300  VTAB 14:LD%(2) = 0:X = 24560 -NL: & MOVE,NS,NS +NL TO X:NS = X: GOSUB 840: POKE ESCAPE,0: RETURN 
  31. 310  GOSUB 980: PRINT "IT WAS NECESSARY TO REMOVE": PRINT : PRINT "> ";NW$: PRINT : PRINT "FROM MEMORY IN ORDER TO FINISH ";OP$;"ING": PRINT : PRINT "TO > ";OLD$: PRINT : GOSUB 450: RETURN 
  32. 320  GOSUB 200: GOSUB 860: GOSUB 770: VTAB 9: PRINT : PRINT OP$;" SHAPES "L" THROUGH "T1: PRINT : PRINT : PRINT :OPT = 0: GOSUB 400: IF ANSWER < >1  THEN  POP : RETURN 
  33. 330 A$ = "-> WORKING <-": HOME : VTAB 12: GOSUB 830: RETURN 
  34. 340  REM  "ARE YOU SURE?"
  35. 350  GOSUB 380:ANSWER = (I = 89) +2 *(I = 78) +3 *(I = 27) +4 *(I = 13): ON   NOT ANSWER GOTO 350: IF ANSWER = 4  AND   NOT OPT  THEN 350
  36. 360  RETURN 
  37. 370  REM  CONV. LC
  38. 380  FLASH : PRINT " ";: NORMAL : PRINT B$;: POKE KR%,0: WAIT KB%,128: POKE KR%,0:I =  PEEK(KB%):I = I -32 *(I >90):K$ =  CHR$(I): PRINT " ";B$;: RETURN 
  39. 390  HOME : VTAB 21
  40. 400  PRINT "ARE YOU SURE  ?? ==> (Y/N) ";: FLASH : PRINT " ";: NORMAL : PRINT B$;: GOSUB 2080: GOSUB 350: RETURN 
  41. 410  REM  FIX TABLE DATA
  42. 420 SA =  FN PTR(2):LN =  FN PTR(4) +1 -SA:NUM =  PEEK(SA): IF SAVFLAG% <2  THEN SAVFLAG% = 2
  43. 430  RETURN 
  44. 440  REM  PROMPT
  45. 450  PRINT "PRESS RETURN:";: GET K$: PRINT : RETURN 
  46. 460  REM  ARRANGE
  47. 470  IF L >K  THEN T = L:L = K:K = T
  48. 480  RETURN 
  49. 490  REM GET FILE NAME
  50. 500  PRINT :C = 0:T = M%:T1 =  PEEK(37) +(T1 = 0): VTAB 23: PRINT Q$"?"Q$" FOR CATALOG": GOSUB 770: VTAB T1 -2: PRINT : PRINT "> ";: &  INPUT IN$: IF IN$ < >"?"  OR  PEEK(ESCAPE)  THEN  RETURN 
  51. 510 IN$ = "": TEXT :X% = 4: ONERR  GOTO 2390
  52. 520 C = 1:M% = 6: HOME : ON   NOT PRODOS GOTO 590: GOSUB 770: VTAB 12: PRINT : PRINT "CATALOG BY DRIVE OR PATHNAME (D/P)? ";
  53. 530  GOSUB 380:I = (I = 68) +2 *(I = 80): ON I GOTO 590,550: IF K$ < >E$  THEN 520
  54. 540 M% = T:C = 2: HOME : POKE 6,0: RETURN 
  55. 550 M% = 8: GOSUB 770: VTAB 14: PRINT : PRINT "ENTER FULL CATALOG PATHNAME:": PRINT : PRINT R$" FOR:": PRINT PF$: PRINT : PRINT "> ";: &  INPUT PN$:M% = T: ON  PEEK(ESCAPE) GOTO 520: IF PN$ = ""  THEN PN$ = PF$: GOTO 580
  56. 560  IF  LEFT$(PN$,1) < >"/"  THEN PN$ = "/" +PN$
  57. 570  IF PN$ < >PF$  THEN  PRINT : PRINT "DO YOU WANT TO SET PRODOS PREFIX TO": PRINT PN$" (Y/N)? ";: GOSUB 350: ON ANSWER >1 GOTO 580: PRINT : PRINT D$"PREFIX"PN$:PF$ = PN$
  58. 580 C1$ = C$ +PN$: GOTO 650
  59. 590  HOME : GOSUB 770: GOSUB 670: GOSUB 680: VTAB 11: PRINT : PRINT "CHANGE SLOT OR DRIVE (Y/";: INVERSE : PRINT "N";: NORMAL : PRINT ") ? ";
  60. 600 OPT = 1: GOSUB 350:OPT = 0: ON ANSWER GOTO 610,640,540,640
  61. 610  VTAB 11: PRINT : HTAB 23: INVERSE : PRINT "Y";: NORMAL : PRINT "/N)  ":T1 = M%:M% = 7: GOSUB 770:M% = T1
  62. 620  GOSUB 670: PRINT B$;: GET K$: ON K$ = E$ GOTO 590: ON K$ =  CHR$(13) GOTO 630: PRINT K$:T1 = SL:SL =  VAL(K$): IF SL <1  OR SL >7  THEN SL = T1: GOTO 620
  63. 630  GOSUB 680: PRINT B$;: GET K$: ON K$ = E$ GOTO 590: ON K$ =  CHR$(13) GOTO 640: PRINT K$:T1 = DR:DR =  VAL(K$): IF DR <1  OR DR >4  THEN DR = T1: GOTO 630
  64. 640 C1$ = C$ +",S" + STR$(SL) +",D" + STR$(DR)
  65. 650  HOME : PRINT : PRINT D$;C1$: PRINT : PRINT : PRINT :M% = T:X% = 0: IF   NOT PRODOS  THEN  RETURN 
  66. 660  PRINT D$"PREFIX,S" + STR$(SL) +",D" + STR$(DR): RETURN 
  67. 670  VTAB 14: PRINT : PRINT "SLOT => ";SL;: RETURN 
  68. 680  VTAB 16: PRINT : PRINT "DRIVE => ";DR;: RETURN 
  69. 690  REM MENU
  70. 700  HOME :A$ = M$(0,M%): GOSUB 830
  71. 710  VTAB (13 -IT%(M%) +4 *(M% = 3)): FOR I = 1 TO IT%(M%): PRINT  CHR$(I +64);") ";M$(I,M%): IF M% < >3  THEN  PRINT 
  72. 720  NEXT : GOSUB 770:
  73. 730  VTAB 21: PRINT : PRINT "SELECT BY LETTER => ";: GET K$: IF K$ = E$  THEN X = 0: PRINT : RETURN 
  74. 740 K =  ASC(K$):K = K -32 *(K >96  AND K <123):K$ =  CHR$(K)::X =  ASC(K$) -64: IF X <1  OR X >IT%(M%)  THEN 730
  75. 750  PRINT : RETURN 
  76. 760  GOSUB 770: VTAB 11: PRINT : RETURN 
  77. 770  IF ES$(M%) < >""  THEN  VTAB 24: HTAB 1: CALL  -868: PRINT V1$;"ESC";V2$;": ";ES$(M%);
  78. 780  RETURN 
  79. 790  REM VECTOR
  80. 800  POKE 8, FN LO(SX): POKE 9, FN HI(SX):X = SX +LX +1: POKE 0, FN LO(X): POKE 1, FN HI(X): &  DATA   : IF   NOT  PEEK(6)  THEN  RETURN 
  81. 810 SX = SX -4: POKE SX,1: POKE SX +1,0: POKE SX +2,4: POKE SX +3,0: RETURN 
  82. 820  HOME :T = M%:M% = 6: GOSUB 770:M% = T: VTAB 11: PRINT : PRINT "INSERT THE DISK CONTAINING": PRINT "> ";: RETURN 
  83. 830  HTAB (42 - LEN(A$))/2: INVERSE : PRINT A$: NORMAL : PRINT : RETURN 
  84. 840  POKE 233, FN HI(NS): POKE 232, FN LO(NS):SX = NS:LX = NL:NX = NM:EX = NS +NL: RETURN : REM VIEW TABLE 2 
  85. 850  POKE 233, FN HI(SA): POKE 232, FN LO(SA):SX = SA:LX = LN:NX = NUM:EX = SA +LN: RETURN : REM VIEW TABLE 1
  86. 860  POKE  -16303,0: POKE  -16300,0: RETURN : REM SET TEXT
  87. 870  POKE  -16297,0: POKE  -16301,0: POKE  -16299,0: POKE  -16304,0: RETURN : REM SET GRAPHICS
  88. 880  GOSUB 760: PRINT "INSERT DISK AND ";R$: GET K$: PRINT : RETURN 
  89. 890  REM  SAVE SHAPE
  90. 900 OP$ = "EXTRACT AND SAVE": GOSUB 1980: ON   NOT K GOTO 970: GOSUB 210: HOME : TEXT : & MOVE,SB,SE TO 16384
  91. 910  GOSUB 200: GOSUB 860: VTAB 12: PRINT "SHAPE WILL BE SAVED AS A VECTOR FILE"
  92. 920  VTAB 22: PRINT : PRINT "ENTER FILE NAME FOR SHAPE": PRINT : GOSUB 500: IF  PEEK(ESCAPE)  THEN  RETURN 
  93. 930  ON C GOTO 920: IF IN$ = ""  THEN 910
  94. 940 X% = 5: ONERR  GOTO 2390
  95. 950  HOME : PRINT "VECTOR FILE:": PRINT IN$: GOSUB 880: IF K$ = E$  THEN  RETURN 
  96. 960 X = SE -SB +1: PRINT : PRINT D$"BSAVE"IN$",A16384,L";X
  97. 970 X% = 0: RETURN 
  98. 980  TEXT : HOME : VTAB 12:A$ = "   >>> WARNING <<<   ": GOSUB 830: PRINT : RETURN 
  99. 990  POKE 8, FN LO(EX): POKE 9, FN HI(EX): &  FRE:NX =  PEEK(6): POKE 6,0: POKE SX,NX:K = NX: GOSUB 210:LX = SE -SX +1
  100. 1000  GOSUB 980: PRINT "LENGTH OF": PRINT K$: ON (NX = 255  OR   NOT NX) GOTO 1010: PRINT "IS SUCH THAT SHAPES ABOVE # ";NX: PRINT "HAVE BEEN LOPPED OFF": PRINT : GOSUB 450: HOME : RETURN 
  101. 1010  PRINT "IS TOO GREAT FOR AVAILABLE MEMORY": PRINT K$: PRINT "NOT LOADED":LD%(2) = 0: GOSUB 450: HOME : RETURN 
  102. 1020  REM  MAIN MENU
  103. 1030 M% = 1: TEXT : GOSUB 700:OP% = X:M% = 2: ON X GOTO 1040,1070,1100,2290: GOTO 1030
  104. 1040  IF   NOT LD%(1)  THEN 1060
  105. 1050  GOSUB 1160: ON ANSWER GOTO 1060,1240,1030
  106. 1060  GOSUB 1270: GOTO 1240
  107. 1070  IF   NOT LD%(1)  THEN 1140
  108. 1080  IF   NOT LD%(2)  THEN  GOSUB 1160: ON ANSWER GOTO 1140,1150,1030
  109. 1090  GOSUB 1160: ON ANSWER GOTO 1140,1250,1030
  110. 1100 M% = 2: IF LD%(1)  THEN  GOSUB 1160: ON ANSWER GOTO 1110,1030,1030
  111. 1110  TEXT : HOME : VTAB 22
  112. 1120  PRINT "ENTER NAME FOR NEW TABLE": PRINT : GOSUB 500: ON  PEEK(ESCAPE) GOTO 1030: ON C < >0 GOTO 1120: IF IN$ = ""  THEN 1030
  113. 1130 OLD$ = IN$:SA = 5200: POKE SA,0: POKE SA +1,0: POKE SA +2,2: POKE SA +3,0:NUM = 0:LN = 2:SAVFLAG% = 3: GOSUB 1390:LD%(1) = 1: GOTO 1150
  114. 1140  GOSUB 1270
  115. 1150  GOSUB 1420: ON  PEEK(ESCAPE) GOTO 1030: GOTO 1250
  116. 1160  HOME : VTAB 12: PRINT "DO YOU WANT TO REMOVE": PRINT "==> ";OLD$: PRINT "FROM MEMORY (Y/N) ? "
  117. 1170  GOSUB 770
  118. 1180  VTAB 19: PRINT : IF   NOT SAVFLAG%  THEN  PRINT "YOU MADE NO CHANGES": GOTO 1210
  119. 1190  VTAB 20: PRINT "CHANGES YOU MADE HAVE ";: IF SAVFLAG% < >1  THEN  INVERSE : PRINT "NOT";: NORMAL : PRINT " ";
  120. 1200  PRINT "BEEN SAVED"
  121. 1210  VTAB 14: HTAB 24:OPT = 0: GOSUB 350: RETURN 
  122. 1220  IF   NOT PRODOS  THEN X =  FRE(0): RETURN 
  123. 1230  PRINT D$"FRE": RETURN 
  124. 1240  GOSUB 1220: GOTO 1550
  125. 1250  GOSUB 1220: GOTO 1580
  126. 1260  REM LOAD MAIN TABLE
  127. 1270  TEXT : HOME :M% = 2: VTAB 12:X% = 0
  128. 1280  PRINT "WHAT IS THE NAME OF THE SHAPE TABLE": IF OP% = 1  THEN  PRINT "YOU WANT TO EDIT?": GOTO 1300
  129. 1290  PRINT "TO WHICH YOU WANT TO ADD?"
  130. 1300  PRINT : GOSUB 500: ON  PEEK(ESCAPE) GOTO 1400: ON C GOTO 1280,1270: IF IN$ = ""  THEN 1270
  131. 1310  GOSUB 820: PRINT IN$: PRINT "AND ";R$: GET K$: PRINT : ON K$ = E$ GOTO 1270
  132. 1320 X% = 1:LD%(1) = 0:OLD$ = "": ONERR  GOTO 2370
  133. 1330 M% = 2:SA = 5200: PRINT D$;"BLOAD"IN$;",A";SA: &  ABSIN$,OLD$
  134. 1340 LD%(1) = 1:LD%(2) = 0:SAVFLAG% = 0:NUM =  PEEK(SA):LN =  FN PTR(DOS): REM  SHAPES & LENGTH
  135. 1350  GOSUB 850: GOSUB 800: IF  PEEK(6)  THEN SA = SA -4:LN = LN +4:NUM = 1: POKE 6,0
  136. 1360  GOSUB 1390
  137. 1370  IF SA +LN > = 16384  THEN K$ = OLD$: &  DEL NUM: GOSUB 420:NX = NUM: GOTO 1370
  138. 1380  ON SAVFLAG% = 2 GOSUB 1000
  139. 1390  POKE 2, FN LO(SA): POKE 3, FN HI(SA):X = SA +LN -1: POKE 4, FN LO(X): POKE 5, FN HI(X): RETURN : REM START & END ADR
  140. 1400  POP : GOTO 1030
  141. 1410  REM LOAD 2D TABLE
  142. 1420  HOME : VTAB 12
  143. 1430  IF   NOT PRODOS  THEN  VTAB 5: PRINT : PRINT "DON'T LOAD A FILE LONGER THAN": PRINT  INT((20480 -SA -LN)/256);" SECTORS": VTAB 12
  144. 1440  PRINT "NAME OF FILE CONTAINING SHAPES TO ADD": PRINT "TO "OLD$: PRINT : GOSUB 500: ON  PEEK(ESCAPE) GOTO 1530: ON C GOTO 1440,1420: IF IN$ = ""  THEN 1420
  145. 1450  GOSUB 820: PRINT IN$: PRINT "AND ";R$: GET K$: PRINT : ON K$ = E$ GOTO 1420
  146. 1460 NS = SA +LN +100:LD%(2) = 0:NW$ = ""
  147. 1470  ONERR  GOTO 2370
  148. 1480 M% = 2:X% = 2: PRINT D$"BLOAD"IN$",A";NS: &  ABSIN$,NW$
  149. 1490 NL =  FN PTR(DOS):NM =  PEEK(NS): IF   NOT NM  THEN LD%(2) = 0: GOTO 1920: REM NEW TABLE LENGTH, NUMBER OF SHAPES
  150. 1500  GOSUB 840: GOSUB 800: IF  PEEK(6)  THEN NS = NS -4:NL = NL +4:NM = 1: POKE 6,0: GOSUB 840
  151. 1510 LD%(2) = 1: IF NS +NL < = 16380  THEN X = 16380 -NL: & MOVE,NS,NS +NL TO X:NS = X: RETURN 
  152. 1520  GOSUB 840:K$ = NW$: GOSUB 990:NM = NX:NL = LX
  153. 1530  RETURN 
  154. 1540  REM SINGLE TABLE
  155. 1550  HOME : GOSUB 200: GOSUB 860: PRINT "TABLE: ";OLD$: POKE 34,2:M% = 2:LD%(2) = 0: GOSUB 700
  156. 1560  ON   NOT X GOTO 1030:M% = 4:PR% = 1: GOSUB 850: ON X GOSUB 2100,900,1710,1820,1850: GOTO 1550
  157. 1570  REM 2TABLES
  158. 1580  ON   NOT LD%(2) GOTO 1240:M% = 3: GOSUB 200: PRINT "ADD TO: ";OLD$: PRINT "FROM:   ";NW$: PRINT : POKE 34,3: GOSUB 860: GOSUB 700
  159. 1590 M% = 5:PR% = 1: GOSUB 840: ON X = 0 GOTO 1030: ON X GOSUB 1610,1660,1710,1820,1850,2100,1870,900,1730,1780: GOTO 1580
  160. 1600  REM  ADD ONE
  161. 1610  GOSUB 1900:OP$ = "ADD":OP% = 1: GOSUB 1980: ON   NOT K GOTO 1640:OPT = 0: GOSUB 390: ON ANSWER < >1 GOTO 1640
  162. 1620  &  STORE K AT  END : IF  PEEK(ESCAPE)  THEN  GOSUB 230: IF   NOT  PEEK(ESCAPE)  THEN 1620
  163. 1630  IF   NOT  PEEK(ESCAPE)  AND   NOT LD%(2)  THEN  GOSUB 310
  164. 1640  GOSUB 420: RETURN 
  165. 1650  REM  ADD RANGE
  166. 1660 OP$ = "ADD": GOSUB 1930: GOSUB 320: FOR I = 0 TO J
  167. 1670  &  STORE L +I AT  END : IF  PEEK(ESCAPE)  THEN  GOSUB 230: IF   NOT  PEEK(ESCAPE)  THEN 1670
  168. 1680  PRINT ".";: NEXT 
  169. 1690  GOSUB 420: ON   NOT LD%(2) GOSUB 310: RETURN 
  170. 1700  REM VIEW
  171. 1710  ON   NOT NUM GOTO 1920:OP$ = "VIEW": GOSUB 850: GOSUB 1980: RETURN 
  172. 1720  REM  INSERT ONE
  173. 1730  GOSUB 1900: ON   NOT NUM GOTO 1610:OP$ = "INSERT":OP% = 1: GOSUB 1980:L = K: ON   NOT K GOTO 1760: GOSUB 850:PR% = 4: GOSUB 1980: ON   NOT K GOTO 1760:OPT = 0: GOSUB 390: ON ANSWER < >1 GOTO 1760: GOSUB 840
  174. 1740  &  STORE L AT K: IF  PEEK(ESCAPE)  THEN  GOSUB 230: IF   NOT  PEEK(ESCAPE)  THEN 1740
  175. 1750  IF   NOT  PEEK(ESCAPE)  AND   NOT LD%(2)  THEN  GOSUB 310
  176. 1760  GOSUB 420: RETURN 
  177. 1770  REM  INSERT RANGE
  178. 1780 OP$ = "INSERT": GOSUB 1930: GOSUB 850:PR% = 4: GOSUB 1980: ON   NOT K GOTO 1830: GOSUB 840: GOSUB 320: FOR I = 0 TO J
  179. 1790  &  STORE L +I AT K +I: IF  PEEK(ESCAPE)  THEN  GOSUB 230: IF   NOT  PEEK(ESCAPE)  THEN 1790
  180. 1800  GOTO 1680
  181. 1810  REM  DELETE ONE
  182. 1820  ON   NOT NUM GOTO 1920:OP$ = "DELETE": GOSUB 850: GOSUB 1980: ON   NOT K GOTO 1830: GOSUB 390: ON (ANSWER = 2  OR ANSWER = 3) GOTO 1830: &  DEL K: GOSUB 420
  183. 1830  RETURN 
  184. 1840  REM  DELETE RANGE
  185. 1850  ON   NOT NUM GOTO 1920:OP$ = "DELETE": GOSUB 850: GOSUB 1940: GOSUB 320: GOSUB 330: FOR I = 1 TO (K -L +1): &  DEL L: PRINT ".";: NEXT : GOSUB 420: RETURN 
  186. 1860  REM TABLE2
  187. 1870  HOME : GOSUB 760: PRINT "ARE YOU SURE YOU WANT TO REMOVE": PRINT "==> ";NW$: PRINT "FROM MEMORY? (Y/N) ?";:OPT = 0: GOSUB 350: IF ANSWER >1  THEN  RETURN 
  188. 1880  GOSUB 1420: RETURN 
  189. 1890  POKE 34,0: HOME : TEXT : VTAB 12: PRINT "A TABLE CAN ONLY CONTAIN 255 SHAPES": PRINT : PRINT "THIS WOULD MAKE "NUM +K -L +1: PRINT : GOSUB 450: POP : RETURN 
  190. 1900  IF NUM = 255  THEN  HOME : VTAB 12: PRINT "TABLE FULL...": PRINT : GOSUB 450: POP 
  191. 1910  RETURN 
  192. 1920  HOME : VTAB 12: PRINT "NO SHAPES IN TABLE...": PRINT : GOSUB 450: RETURN 
  193. 1930  ON NUM = 255 GOTO 1900
  194. 1940 PR% = 2:OP% = 2: GOSUB 1980:L = K: ON   NOT K GOTO 1960:PR% = 3: GOSUB 1980: ON   NOT K GOTO 1960: GOSUB 470:T1 = K:J = K -L: IF NUM +J +1 >255  AND OP$ < >"DELETE"  THEN 1890
  195. 1950  RETURN 
  196. 1960  POP : RETURN 
  197. 1970  REM DISPLAY SHAPES
  198. 1980  POKE 34,0: HOME : GOSUB 2080: CALL  -3086: GOSUB 870: HCOLOR= 3
  199. 1990  IF NX = 1  THEN K = 1:X = 0: GOTO 2020
  200. 2000 K = 0: GOSUB 770: VTAB 20: PRINT : PRINT "NUMBER OF SHAPES:";NX: PRINT "WHAT IS THE NUMBER OF THE ";PR$(PR%): PRINT "YOU WISH TO ";OP$;" ==> ";: HTAB 33: PRINT "#";: GOSUB 2080
  201. 2010  &  INPUT K$,3: ON  PEEK(ESCAPE) GOTO 2070:X = 0:K =  VAL(K$):K = K +(K = 0): IF K >NX  THEN K = 1
  202. 2020  DRAW K AT 140,75: ON X GOTO 2040: HOME : GOSUB 770: VTAB 20: PRINT : IF NX >1  THEN  PRINT "HIGHER ";V1$;"-->";V2$;"  ";: FLASH : PRINT " ";: NORMAL : PRINT "  ";V1$;"<--";V2$;" LOWER";: GOSUB 2080
  203. 2030  PRINT : IF OP$ < >"VIEW"  THEN  PRINT R1$;" IF THIS IS THE ";PR$(PR%): PRINT "YOU WANT TO "OP$: GOSUB 2080
  204. 2040 X = 1: VTAB 24: HTAB 33: PRINT "# ";K;"  ";: GOSUB 2080
  205. 2050  GET K$: ON K$ =  CHR$(13) GOTO 2070: IF K$ = E$  THEN K = 0: RETURN 
  206. 2060 T = K -(K$ =  CHR$(8)) +(K$ =  CHR$(21)):T = T *(T < = NX) +NX *(T <1) +(T >NX): ON T = K GOTO 2050: HCOLOR= 0: DRAW K AT 140,75:K = T: HCOLOR= 3: GOTO 2020
  207. 2070  RETURN 
  208. 2080  & MOVE,1616,2047 TO 2640: RETURN : REM MOVE TEXT PAGE 1 TO PAGE 2
  209. 2090  REM SAVE TABLE
  210. 2100  TEXT : HOME : VTAB 5: PRINT OLD$;" NOW": PRINT "CONTAINS ";NUM;" SHAPES.": PRINT "AND IS ";LN;" BYTES LONG":X = 25: IF PRODOS  THEN X = 10
  211. 2110 FL$ = OLD$: IF  LEN(OLD$) >4  THEN  IF  MID$ (OLD$, LEN(OLD$) -3,3) = "REV"  THEN 2150
  212. 2120  IF SAVFLAG% = 3  THEN 2170
  213. 2130  IF  LEN(FL$) >X  THEN FL$ =  LEFT$(FL$,X)
  214. 2140 FL$ = FL$ +".REV1": GOTO 2170
  215. 2150 T =  VAL( RIGHT$(OLD$,1)): IF T = 9  AND  LEN(OLD$) = X +5  THEN X = X -1:FL$ =  LEFT$(FL$,X) + RIGHT$(FL$,5)
  216. 2160 T =  VAL( RIGHT$(FL$,1)):T = T +1:FL$ =  LEFT$(FL$, LEN(FL$) -1) + STR$(T)
  217. 2170  VTAB 10: CALL CLR: GOSUB 770: VTAB 22: POKE 36,0: PRINT "OR"Q$"?"Q$" FOR CATALOG";: VTAB 20: PRINT : PRINT "OR ENTER NEW FILE NAME": VTAB 13: PRINT : PRINT R$;" FOR:": PRINT 
  218. 2180  PRINT "> ";FL$;: HTAB 2: &  INPUT IN$: ON  PEEK(ESCAPE) GOTO 2270: ON IN$ = "" GOTO 2250: IF IN$ = "?"  THEN  GOSUB 510: GOTO 2220
  219. 2190 FL$ = IN$: GOTO 2240
  220. 2200  HOME : VTAB 11: PRINT 
  221. 2210  PRINT "ENTER NEW NAME UNDER WHICH TO SAVE": PRINT "YOUR REVISED VERSION OF": PRINT OLD$: PRINT : GOSUB 500
  222. 2220  ON  PEEK(ESCAPE) GOTO 2270: ON C GOTO 2210,2200:FL$ = IN$: IF FL$ = ""  THEN 2200
  223. 2230  HOME : GOSUB 880: IF K$ = E$  THEN  POKE ESCAPE,1: GOTO 2270
  224. 2240  ONERR  GOTO 2390
  225. 2250 X% = 3: PRINT : PRINT D$"BSAVE"FL$",A";SA;",L";LN: IF SAVFLAG%  THEN SAVFLAG% = 1
  226. 2260  &  ABSFL$,OLD$
  227. 2270  GOSUB 1220: RETURN 
  228. 2280  REM  QUIT
  229. 2290  HOME :M% = 2: GOSUB 760: IF SAVFLAG% <2  THEN 2330
  230. 2300  PRINT "YOU CHANGED:": PRINT : PRINT "==> ";OLD$: PRINT : PRINT "DO YOU WANT TO SAVE THE CHANGES": PRINT "BEFORE YOU QUIT (Y/N) ";:OPT = 0: GOSUB 350: ON ANSWER GOTO 2310,2320,1030
  231. 2310  GOSUB 2100: ON  PEEK(ESCAPE) GOTO 1030
  232. 2320  HOME :M% = 2: GOSUB 760
  233. 2330 A$ = " QUIT PROGRAM ": GOSUB 830: PRINT : PRINT "ARE YOU SURE (Y/N) => ";:OPT = 0: GOSUB 350: IF ANSWER < >1  THEN 1030
  234. 2340  IF PRODOS  THEN  POKE 48996,0
  235. 2350  HOME : END 
  236. 2360  REM  ONERR
  237. 2370  CALL  -3288: GOSUB 2510: ON ER < >6 GOTO 2400:M% = 6: GOSUB 770: GOSUB 2500: ON K$ = E$ GOTO 2380: ON X% GOTO 1320,1470
  238. 2380  ON X% GOTO 1270,1420
  239. 2390  CALL  -3288: GOSUB 2510
  240. 2400  VTAB 11: PRINT : IF ER = 4  THEN  PRINT "DISK WRITE-PROTECTED": GOTO 2490
  241. 2410  IF (PRODOS  AND ER = 16)  OR (  NOT PRODOS  AND ER = 11)  THEN  PRINT Q$;IN$;Q$: PRINT "IS NOT A LEGAL FILE NAME":IN$ = "": GOSUB 2520: ON X% GOTO 1270,1420,2100: IF X% = 5  THEN 910
  242. 2420  IF ER = 9  THEN  PRINT "DISK FULL": GOTO 2490
  243. 2430  IF ER = 8  OR ER = 3  THEN  PRINT "I/O ERROR...   CHECK DISK DRIVE": GOTO 2490
  244. 2440  IF ER = 13  THEN  PRINT "FILE TYPE MISMATCH": GOTO 2490
  245. 2450  IF ER = 255  THEN  PRINT "PLEASE EXIT THROUGH MENU": RESUME 
  246. 2460  IF ER = 12  AND PRODOS  THEN  PRINT "TABLE TOO LONG TO LOAD": GOSUB 2520:LD%(X%) = 0: ON X% GOTO 1270,1420
  247. 2470  IF ER = 90  OR ER = 16  AND   NOT PRODOS  THEN  PRINT "TABLE TOO LONG - OVERWROTE PROGRAM": PRINT : PRINT "RUN PROGRAM AGAIN AND DELETE SOME SHAPES": PRINT : PRINT  CHR$(4)"FP": END 
  248. 2480  PRINT "ERROR NUMBER ";ER;" AT LINE "; FN PTR(218)
  249. 2490  GOSUB 2520: ON X% GOTO 1310,1450,2230,510,910: RESUME 
  250. 2500  VTAB 9: PRINT : PRINT Q$; LEFT$(IN$,38);Q$: PRINT "IS NOT ON THIS DISK": PRINT "PUT IN THE RIGHT DISK AND PRESS ANY KEY": GET K$: PRINT : RETURN 
  251. 2510 ER =  PEEK(222): PRINT  CHR$(7): TEXT : HOME : RETURN 
  252. 2520  PRINT : PRINT : PRINT R$;" TO CONTINUE ==> ";: GET K$: PRINT : RETURN 
  253. 2530  REM MENU
  254. 2540  DATA 4,MAIN MENU,EDIT A SINGLE TABLE,WORK WITH TWO TABLES,START A NEW TABLE,QUIT
  255. 2550  DATA 5,SINGLE TABLE MENU,SAVE MAIN SHAPE TABLE,SAVE A SHAPE AS A VECTOR FILE,SEE SHAPES IN TABLE,DELETE A SHAPE,DELETE RANGE OF SHAPES 
  256. 2560  DATA 10,TWO TABLE MENU,ADD A SHAPE TO MAIN TABLE,ADD RANGE OF SHAPES,SEE SHAPES IN MAIN TABLE,DELETE A SHAPE FROM MAIN TABLE,DELETE RANGE OF SHAPES
  257. 2570  DATA SAVE MAIN SHAPE TABLE,GET NEW SECOND TABLE,SAVE A SHAPE FROM SECOND TABLE,INSERT A SHAPE IN MAIN TABLE,INSERT RANGE OF SHAPES
  258. 2580  DATA MAIN MENU,MAIN MENU,SINGLE TABLE MENU,TWO TABLES MENU,ENTER FILENAME,CHANGE SLOT/DRIVE,DRIVE/PATHNAME 
  259. 2590  DATA SHAPE,FIRST SHAPE,LAST SHAPE,SHAPE WHERE