home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib26b.dsk / SUPER.SHOPPER3.3.bas < prev    next >
BASIC Source File  |  2023-02-26  |  18KB  |  331 lines
  1. 1  REM *******1.10.86********
  2. 2  REM *   SUPER.SHOPPER    *
  3. 3  REM *   BY STEVEN AND    *
  4. 4  REM *    MARSHA MEUSE    *
  5. 5  REM * COPYRIGHT (C) 1985 *
  6. 6  REM * BY MICROSPARC, INC *
  7. 7  REM * CONCORD, MA  01742 *
  8. 8  REM **********************
  9. 9  REM   "This version DOS 3.3 or ProDOS
  10. 60  GOTO 100
  11. 70 BB$ = "": FOR I = 1 TO  LEN(B$):B =  ASC( MID$ (B$,I,1)):BB$ = BB$ + CHR$(B -(B >96  AND B <123) *32): NEXT I:B$ = BB$: RETURN 
  12. 80  WAIT  -16384,128: GET A$: IF  ASC(A$) >95  THEN A$ =  CHR$( ASC(A$) -32)
  13. 90  RETURN : REM "upshift a lowercase GET, skipping the flashing cursor
  14. 100  TEXT : HOME 
  15. 105 P = 0:C = 0:A = 0:B = 0:D$ =  CHR$(4):HT = 36:F$ = "SHOPPER.DATA"
  16. 110  REM 
  17. 120  REM " If the computer isn't a //e or //c then convert
  18. 130  REM " lowercase program text to uppercase
  19. 140  REM 
  20. 150  IF  PEEK( -1101) < >6  THEN A = 768: FOR B = A TO A +47: READ C: POKE B,C: NEXT : CALL A
  21. 160  DATA 165,103,133,0,165,104,133,1,160,1,177,0,240,33,160,4
  22. 170  DATA 177,0,240,13,48,8,201,96,144,4,41,95,145,0,200,208
  23. 180  DATA 239,160,0,177,0,170,200,177,0,133,1,134,0,208,223,96
  24. 190  GOSUB 1590
  25. 195  PRINT D$"NOMONCIO"
  26. 200  ONERR  GOTO 2950
  27. 205  PRINT D$"UNLOCK"F$: PRINT D$"OPEN"F$",L18": PRINT D$"READ"F$",R0": INPUT CTG: DIM P$(39,40),PR%(39),P%(39,40):LCTG = CTG: POKE 216,0
  28. 210  FOR C = 0 TO CTG -1: FOR P = 0 TO 40: PRINT D$"READ"F$",R"C *41 +P +1: INPUT P$(C,P),P%(C,P): IF   NOT  LEN(P$(C,P))  THEN P = 40
  29. 215  NEXT : NEXT : PRINT D$"CLOSE"
  30. 220  REM 
  31. 230  REM " Printer control codes (currently for Epson MX80)
  32. 240  REM 
  33. 250 PSLOT = 1: REM "Printer slot number
  34. 260 PINIT$ =  CHR$(9) +"81N": REM "Printer initialization string
  35. 270 PFF$ =  CHR$(12): REM "Print a form feed control code
  36. 280 P80$ =  CHR$(18): REM "Print in 80 columns control code
  37. 290 P1$ =  CHR$(15)
  38. 300 PC$ =  CHR$(27) +"-" + CHR$(1): REM "Print category names control code (usu. underline)
  39. 310 PN$ =  CHR$(27) +"-" + CHR$(0): REM "Print normally control code (negates PC$)
  40. 320  REM 
  41. 330  REM " Main Menu
  42. 340  REM 
  43. 350  HOME : GOSUB 1590: VTAB 8: PRINT "You may:": PRINT : PRINT  TAB( 4)"(W) Write lists": PRINT : PRINT  TAB( 4)"(U) Update lists after shopping"
  44. 360  PRINT : PRINT  TAB( 4)"(S) Print a Shopping list": PRINT : PRINT  TAB( 4)"(F) Print the Full list": PRINT 
  45. 370  PRINT  TAB( 4)"(A) Add, Change or Delete categories": PRINT : PRINT  TAB( 4)"(Q) Quit"
  46. 380  HTAB 1: VTAB 22: GOSUB 80:AN$ = A$
  47. 390  IF A$ = "W"  THEN 490
  48. 400  IF A$ = "U"  THEN 660
  49. 410  IF A$ = "S"  THEN 1280
  50. 420  IF A$ = "F"  THEN 1280
  51. 430  IF A$ = "A"  THEN 2430
  52. 440  IF A$ = "Q"  THEN 3100
  53. 450  GOTO 350
  54. 460  REM 
  55. 470  REM " Edit Lists
  56. 480  REM 
  57. 490  GOSUB 2130: HOME 
  58. 500  GOSUB 1770
  59. 510  VTAB 23: PRINT "A)dd, D)elete, C)hange, P)ut on/off listN)ext ctgy, S)elect ctgy, T)idy, <ESC>";
  60. 520  HTAB 1: VTAB 1: GOSUB 80: GOSUB 1600
  61. 530  IF A$ = "S"  THEN 1230
  62. 540  IF A$ = "A"  THEN 800
  63. 550  IF A$ = "D"  AND  LEN(P$(C,1))  THEN 900
  64. 560  IF A$ = "C"  AND  LEN(P$(C,1))  THEN 1020
  65. 570  IF A$ = "P"  AND  LEN(P$(C,1))  THEN 1080
  66. 580  IF A$ = "T"  AND  LEN(P$(C,1))  THEN 1120
  67. 590  IF  ASC(A$) = 27  THEN 350
  68. 600  IF A$ < >"N"  THEN 510
  69. 610 HP = 0:VP = 0:C = C +1: IF C = CTG  THEN C = 0
  70. 620  GOTO 500
  71. 630  REM 
  72. 640  REM " Update lists after shopping
  73. 650  REM 
  74. 660  HOME : VTAB 5: PRINT  TAB( 4)"===============================": PRINT  TAB( 4)"! Update lists after shopping !": PRINT  TAB( 4)"===============================": PRINT : PRINT : REM "31/31 ='S
  75. 670  PRINT "You may:": PRINT : PRINT  TAB( 8)"R)emove all '*' markers": PRINT : PRINT  TAB( 8)"S)elect markers to be removed": PRINT : PRINT  TAB( 8)"<ESC> to menu": PRINT : PRINT : GOSUB 80: IF  ASC(A$) = 27  THEN 350
  76. 680  IF A$ = "S"  THEN 710
  77. 690  IF A$ > <"R"  THEN 660
  78. 700  GOSUB 3190: FOR C = 0 TO CTG -1: FOR P = 1 TO 40: IF P%(C,P)  THEN P%(C,P) = 0: GOSUB 3200
  79. 705  NEXT : NEXT : GOSUB 3210: GOTO 350
  80. 710  FOR C = 0 TO CTG -1: GOSUB 1770: FOR P = 1 TO 40: IF   NOT P%(C,P)  THEN  NEXT : NEXT : GOTO 350
  81. 720  VTAB 23: PRINT  TAB( 8)"Did you buy "P$(C,P)"?": VTAB 24: HTAB 9: PRINT "(Y/N) or <ESC> to menu";: GOSUB 80: GOSUB 1600: IF  ASC(A$) = 27  THEN P = 40:C = CTG: GOTO 760
  82. 730  IF A$ = "Y"  THEN P%(C,P) = 0: GOSUB 1620: GOSUB 3180: GOTO 760
  83. 740  IF A$ = "N"  THEN 760
  84. 750  GOTO 720
  85. 760  NEXT : NEXT : GOTO 350
  86. 770  REM 
  87. 780  REM " Add a product
  88. 790  REM 
  89. 800  IF  LEN(P$(C,40))  THEN  PRINT  CHR$(7)"This list is full.": GOSUB 1610: GOSUB 1600: GOTO 510
  90. 810  GOSUB 1650: IF   NOT  LEN(P$(C,1))  THEN P = 1: GOSUB 3190: GOTO 850
  91. 820  VTAB 23: PRINT  TAB( 4)"Pick a place for the new product":NP = NP +1:P$(C,NP) =  CHR$(27): IF NP = 21  THEN  GOSUB 1770
  92. 830  GOSUB 1890: GOSUB 1600: GOSUB 3190: IF P = NP  THEN 850
  93. 840 A = P: FOR P = NP TO A +1  STEP  -1:P$(C,P) = P$(C,P -1):P%(C,P) = P%(C,P -1): GOSUB 3200: NEXT 
  94. 850 P$(C,P) = B$:P%(C,P) = B: GOSUB 3200: GOSUB 3210: IF P = NP  THEN  GOSUB 1620: GOTO 510
  95. 860  GOTO 500
  96. 870  REM 
  97. 880  REM " Delete a product
  98. 890  REM 
  99. 900  VTAB 23: PRINT  TAB( 9)"Delete which product?": GOSUB 1890: GOSUB 1600
  100. 910  PRINT "Delete "P$(C,P)"? (Y/N) or <ESC>";
  101. 920  GOSUB 80: GOSUB 1600: IF  ASC(A$) = 27  THEN 510
  102. 930  IF A$ = "N"  THEN 900
  103. 940  IF A$ < >"Y"  THEN 920
  104. 950  GOSUB 3190: IF P = NP  THEN VP = VP -1
  105. 960  IF P <40  THEN P$(C,P) = P$(C,P +1):P%(C,P) = P%(C,P +1): GOSUB 3200: IF   NOT  LEN(P$(C,P))  THEN  GOSUB 3210: GOSUB 1600: GOTO 500
  106. 970  IF P = 40  THEN P$(C,P) = "":P%(C,P) = 0: GOSUB 3200: GOSUB 3210: GOSUB 1600: GOTO 500
  107. 980 P = P +1: GOTO 960
  108. 990  REM 
  109. 1000  REM " Change a product name
  110. 1010  REM 
  111. 1020  VTAB 23: PRINT  TAB( 6)"Change which product name?": GOSUB 1890: GOSUB 1600
  112. 1030  GOSUB 1650
  113. 1040 P$(C,P) = B$:P%(C,P) = B: GOSUB 1620: GOSUB 3180: GOTO 510
  114. 1050  REM 
  115. 1060  REM " Change list status of item
  116. 1070  REM 
  117. 1080  GOSUB 1600: PRINT  TAB( 2)"Choose the item to put on/off list": GOSUB 1890:P%(C,P) =   NOT P%(C,P): GOSUB 1600: GOSUB 1620: GOSUB 3180: GOTO 510
  118. 1090  REM  
  119. 1100  REM " Tidy up a list (Alphabetical Insertion Sort)
  120. 1110  REM  
  121. 1120  GOSUB 1600: PRINT "Alphabetize this list? (confirm Y/N) ";: GOSUB 80: IF A$ = "N"  THEN  GOSUB 1600: GOTO 510
  122. 1130  IF A$ < >"Y"  THEN 1120
  123. 1140  GOSUB 1600: PRINT  TAB( 14)"(working...)"
  124. 1150  FOR B = 2 TO 40:A$ = P$(C,B):A = P%(C,B): IF   NOT  LEN(A$)  THEN B = 40: NEXT : GOTO 1190
  125. 1160  FOR P = B -1 TO 1  STEP  -1: IF P$(C,P) <A$  THEN P$(C,P +1) = A$:P%(C,P +1) = A:P = 1: NEXT : NEXT : GOTO 1190
  126. 1170 P$(C,P +1) = P$(C,P):P%(C,P +1) = P%(C,P): NEXT 
  127. 1180 P$(C,P +1) = A$:P%(C,P +1) = A: NEXT 
  128. 1190  GOSUB 1770: GOSUB 3190: FOR P = 1 TO 40: GOSUB 3200: IF   NOT  LEN(P$(C,P))  THEN P = 40
  129. 1195  NEXT : GOSUB 3210: GOTO 510
  130. 1200  REM   
  131. 1210  REM " Search for next category (calculate arrow position)
  132. 1220  REM   
  133. 1230  IF CTG <21  THEN VC = C +1:HC = 0: GOTO 490
  134. 1240 HC = 2 +((C >19) *20):VC = 1 +C -((C >19) *20): GOTO 490
  135. 1250  REM 
  136. 1260  REM " Print shopping list
  137. 1270  REM 
  138. 1280  HOME : VTAB 12: PRINT  TAB( 7)"(A)80 or (B)132 column? ";: GOSUB 80: IF A$ = "B"  THEN CLM = 8: GOTO 1320
  139. 1290  IF A$ =  CHR$(13)  OR A$ =  CHR$(27)  THEN 350
  140. 1300  IF A$ < >"A"  THEN 1280
  141. 1310 CLM = 5
  142. 1320  HOME : VTAB 12: PRINT  TAB( 9)"Printing shopping list": PRINT : PRINT  TAB( 6)"Please turn on the printer."
  143. 1340  PRINT D$"PR#"PSLOT: PRINT : VTAB 14: CALL  -958: PRINT PINIT$: IF A$ = "A"  THEN  PRINT P80$: GOTO 1380
  144. 1350  PRINT P132$
  145. 1380  IF AN$ = "F"  THEN 1500
  146. 1390  POKE HT,CLM *7: PRINT "Shopping List": PRINT : PRINT 
  147. 1400  FOR C = 0 TO CTG -1  STEP CLM: PRINT PC$
  148. 1410 A = C +CLM -1: IF A =  >CTG  THEN A = CTG -1
  149. 1420 NP = 0: FOR B = C TO A
  150. 1430  IF P%(B,PR%(B))  THEN  POKE HT,(B -C) *16: PRINT P$(B,PR%(B));:PR%(B) = PR%(B) +1:NP = 1: NEXT : GOTO 1460
  151. 1440 PR%(B) = PR%(B) +1: IF PR%(B) <41  THEN  IF  LEN(P$(B,PR%(B)))  THEN 1430
  152. 1450 PR%(B) = 40: NEXT 
  153. 1460  IF NP  THEN  PRINT PN$
  154. 1470 NP = 0: FOR B = C TO A: IF PR%(B) <40  THEN NP = 1
  155. 1480  NEXT : IF NP  THEN 1410
  156. 1490  NEXT : PRINT PFF$: PRINT D$"PR#0": FOR B = 0 TO CTG -1:PR%(B) = 0: NEXT : GOTO 350
  157. 1500  PRINT "Here's the whole list!": PRINT : PRINT 
  158. 1510  FOR C = 0 TO CTG -1  STEP CLM: PRINT PC$:A = C +CLM -1: IF A =  >CTG  THEN A = CTG -1
  159. 1520  FOR P = 0 TO 40:NP = 0: FOR B = C TO A: IF   NOT  LEN(P$(B,P))  THEN  NEXT : GOTO 1540
  160. 1530  POKE HT,(B -C) *16: PRINT P$(B,P);:NP = 1: NEXT 
  161. 1540  IF NP  THEN  PRINT PN$
  162. 1550  NEXT : NEXT : PRINT PFF$: PRINT D$"PR#0": GOTO 350
  163. 1560  REM 
  164. 1570  REM " Various subroutines
  165. 1580  REM 
  166. 1590  VTAB 3: PRINT "*****************************************    Super Shopper by Steven Meuse     **  Copyright 1985 by MicroSPARC, Inc.  *****************************************": RETURN : REM "41/2/41 *'S
  167. 1600  VTAB 23: HTAB 1: CALL  -958: RETURN 
  168. 1610  PRINT  TAB( 6)"press <RETURN> to continue...";: GET A$: RETURN 
  169. 1620 B = 3 +(NP <21) *7 +20 *(P >20): HTAB B: VTAB 1 +P -(P >20) *20: IF B = 3  THEN  POKE 33,19
  170. 1630  CALL  -868: POKE 33,40: IF P%(C,P)  THEN  PRINT "*";
  171. 1640  HTAB B +2: PRINT P$(C,P): RETURN 
  172. 1650  PRINT  TAB( 17)"...............";: HTAB 1: POKE 34, PEEK(37): INPUT "Enter new item->";B$: TEXT : GOSUB 1710: GOSUB 1600: IF  LEN(B$) >15  THEN 1650: REM "15 PERIODS
  173. 1660  IF   NOT  LEN(B$)  THEN  POP : GOTO 510
  174. 1670  GOSUB 70: PRINT "Is "B$" on your current": PRINT "shopping list? (Y/N/ESC) ";: GOSUB 80: GOSUB 1600: IF A$ = "Y"  THEN B = 1: RETURN 
  175. 1680  IF A$ = "N"  THEN B = 0: RETURN 
  176. 1690  IF  ASC(A$) = 27  THEN  POP : GOTO 510
  177. 1700  GOTO 1670
  178. 1710  IF   NOT  LEN(B$)  THEN  RETURN 
  179. 1720 A$ = "": FOR B = 1 TO  LEN(B$): IF  ASC( MID$ (B$,B,1)) >31  THEN A$ = A$ + MID$ (B$,B,1)
  180. 1730  NEXT :B$ = A$: RETURN 
  181. 1740  REM 
  182. 1750  REM " Screen product list display
  183. 1760  REM 
  184. 1770 D = 3:NP = 40: IF   NOT  LEN(P$(C,21))  THEN D = 10
  185. 1780  VTAB 1: POKE 35,22: HOME : POKE 35,24: HTAB (39 - LEN(P$(C,0)))/2: INVERSE : PRINT P$(C,0): NORMAL 
  186. 1790  FOR A = 1 TO 20: HTAB D: IF P%(C,A)  THEN  PRINT "*";
  187. 1800  HTAB D +2: PRINT P$(C,A): IF   NOT  LEN(P$(C,A))  THEN NP = A -1:A = 20: NEXT : RETURN 
  188. 1810  NEXT 
  189. 1820  VTAB 2:D = 23: FOR A = 21 TO 40: HTAB D: IF P%(C,A)  THEN  PRINT "*";
  190. 1830  HTAB D +2: PRINT P$(C,A): IF   NOT  LEN(P$(C,A))  THEN NP = A -1:A = 40
  191. 1840  NEXT : RETURN 
  192. 1850  REM 
  193. 1860  REM  " Choose a product (using moving arrow)
  194. 1870  REM 
  195. 1880  GOSUB 1770
  196. 1890  VTAB 24: PRINT "Use arrow keys to select-(RET) to enter";: IF VP <2  THEN VP = 2:HP = 0
  197. 1900  IF NP >20  THEN 1980
  198. 1910  VTAB VP: HTAB 7: PRINT "-->";
  199. 1920  HTAB 1: VTAB 1: GOSUB 80: VTAB VP: HTAB 7: PRINT "   ";
  200. 1930  IF  ASC(A$) = 21  OR  ASC(A$) = 10  THEN VP = VP +1: IF VP = NP +2  THEN VP = 2
  201. 1940  IF  ASC(A$) = 8  OR  ASC(A$) = 11  THEN VP = VP -1: IF VP = 1  THEN VP = NP +1
  202. 1950  IF  ASC(A$) = 13  THEN P = VP -1: RETURN 
  203. 1960  IF  ASC(A$) = 27  THEN P = VP -1: GOTO 2080: REM "save redundant code
  204. 1970  GOTO 1910
  205. 1980  IF HP = 0  THEN HP = 1
  206. 1990  VTAB VP: HTAB HP: PRINT "->";
  207. 2000  HTAB 1: VTAB 1: GOSUB 80: VTAB VP: HTAB HP: PRINT "  ";
  208. 2010  IF  ASC(A$) = 13  THEN P = VP -1 +((HP >1) *20): RETURN 
  209. 2020  IF  ASC(A$) = 21  OR  ASC(A$) = 10  THEN VP = VP +1: IF VP = 22  AND HP = 1  THEN VP = 2:HP = 20
  210. 2030  IF VP +18 = NP  AND HP = 20  THEN VP = 2:HP = 1
  211. 2040  IF  ASC(A$) = 8  OR  ASC(A$) = 11  THEN VP = VP -1: IF VP = 1  AND HP = 1  THEN HP = 20:VP = NP -19
  212. 2050  IF VP = 1  AND HP = 20  THEN VP = 21:HP = 1
  213. 2060  IF  ASC(A$) > <27  THEN 1990
  214. 2070 P = VP -1 +((HP >1) *20)
  215. 2080  GOSUB 1600: POP : IF P$(C,NP) =  CHR$(27)  THEN P$(C,NP) = "":VP = VP -(P = NP):NP = NP -1: IF NP = 20  THEN  GOSUB 1770: REM  "adjust NP and VP if (A)dd changed it
  216. 2090  GOTO 510
  217. 2100  REM 
  218. 2110  REM " Choose a category (using moving arrow)
  219. 2120  REM 
  220. 2130  HOME : VTAB 22: PRINT  TAB( 12)"Which category?"
  221. 2140  PRINT  TAB( 6)"Use arrow keys for selection": PRINT  TAB( 9)"Use (RETURN) to enter";: VTAB 1
  222. 2150 HP = 0:VP = 0: IF VC <1  THEN VC = 1
  223. 2160 B = 12: IF CTG >20  THEN B = 5: GOTO 2280
  224. 2170 HC = 0: FOR C = 0 TO CTG -1: HTAB B: PRINT P$(C,0): NEXT 
  225. 2180  VTAB VC: HTAB 9: PRINT "==>";
  226. 2190  HTAB 35: VTAB 23: GOSUB 80: VTAB VC: HTAB 9: PRINT "   ";
  227. 2200  IF  ASC(A$) = 21  OR  ASC(A$) = 10  THEN VC = VC +1
  228. 2210  IF  ASC(A$) = 8  OR  ASC(A$) = 11  THEN VC = VC -1
  229. 2220  IF VC = 0  THEN VC = CTG
  230. 2230  IF VC = CTG +1  THEN VC = 1
  231. 2240  IF  ASC(A$) = 13  THEN C = VC -1: RETURN 
  232. 2250  IF  ASC(A$) = 27  AND AN$ = "W"  THEN  POP : GOTO 350
  233. 2260  IF  ASC(A$) = 27  THEN  POP : GOTO 2430
  234. 2270  GOTO 2180
  235. 2280  FOR C = 0 TO 19: HTAB B: PRINT P$(C,0): NEXT : VTAB 1:B = 25: FOR C = 20 TO CTG -1: HTAB B: PRINT P$(C,0): NEXT : IF HC = 0  THEN HC = 2
  236. 2290  IF VC = 0  THEN VC = 1:HC = 2
  237. 2300  VTAB VC: HTAB HC: PRINT "==>";
  238. 2310  HTAB 35: VTAB 23: GOSUB 80: VTAB VC: HTAB HC: PRINT "   ";
  239. 2320  IF  ASC(A$) = 13  THEN C = VC -1 +((HC >2) *20): RETURN 
  240. 2330  IF  ASC(A$) = 21  OR  ASC(A$) = 10  THEN VC = VC +1: IF VC = 21  AND HC = 2  THEN VC = 1:HC = 22
  241. 2340  IF HC = 22  AND VC +19 = CTG  THEN VC = 1:HC = 2
  242. 2350  IF  ASC(A$) = 8  OR  ASC(A$) = 11  THEN VC = VC -1: IF VC = 0  AND HC = 2  THEN VC = CTG -20:HC = 22
  243. 2360  IF VC = 0  AND HC = 22  THEN VC = 20:HC = 2
  244. 2370  IF  ASC(A$) = 27  AND AN$ = "W"  THEN  POP : GOTO 350
  245. 2380  IF  ASC(A$) = 27  THEN  POP : GOTO 2430
  246. 2390  GOTO 2300
  247. 2400  REM 
  248. 2410  REM  " Category add, change, & delete menu
  249. 2420  REM 
  250. 2430  HOME : GOSUB 1590
  251. 2440  PRINT : PRINT  TAB( 9)"======================": PRINT  TAB( 9)"! Category utilities !": PRINT  TAB( 9)"======================": REM "22/22 ='S
  252. 2450  PRINT : PRINT "You may:": PRINT : PRINT : PRINT  TAB( 9)"A)dd a category": PRINT : PRINT  TAB( 9)"D)elete a category": PRINT : PRINT  TAB( 9)"C)hange a category": PRINT : PRINT  TAB( 9)"<ESC> to menu"
  253. 2460  GOSUB 80: IF A$ = "D"  THEN 2540
  254. 2470  IF A$ = "C"  THEN 2690
  255. 2480  IF A$ = "A"  THEN 2860
  256. 2490  IF  ASC(A$) = 27  THEN 350
  257. 2500  GOTO 2460
  258. 2510  REM 
  259. 2520  REM " Delete a category
  260. 2530  REM 
  261. 2540  HOME : VTAB 22: PRINT  TAB( 9)"Delete which category?": GOSUB 2140: VTAB 22: HTAB 1: CALL  -958: PRINT : PRINT "Delete "P$(C,0)"?  (confirm Y/N)"
  262. 2550  GOSUB 80: IF A$ = "N"  THEN 2430
  263. 2560  IF  ASC(A$) = 27  THEN 350
  264. 2570  IF A$ > <"Y"  THEN 2550
  265. 2580  HOME : VTAB 12: PRINT  TAB( 9)"Deleting "P$(C,0): GOSUB 3190
  266. 2590  IF C = CTG -1  THEN VC = VC -1: GOTO 2610
  267. 2600  FOR C = C TO CTG -2: FOR P = 0 TO 40: IF P$(C,P) < >P$(C +1,P)  THEN P$(C,P) = P$(C +1,P):P%(C,P) = P%(C +1,P): GOSUB 3200
  268. 2605  NEXT : NEXT 
  269. 2610 CTG = CTG -1:P = 0
  270. 2612  IF  LEN(P$(CTG,P))  THEN P$(CTG,P) = "":P%(CTG,P) = 0: GOSUB 3200:P = P +1: IF P <41  THEN 2612
  271. 2615  GOSUB 3220: GOSUB 3210: IF CTG  THEN 2430
  272. 2620  VTAB 1: PRINT : PRINT D$"UNLOCK"F$: PRINT D$"DELETE"F$
  273. 2630  HOME : GOSUB 1590: PRINT : PRINT : PRINT "You have left all categories unused.": PRINT : PRINT "You may:": PRINT : PRINT  TAB( 9)"A)dd categories": PRINT : PRINT  TAB( 9)"Q)uit": GOSUB 80: IF A$ = "A"  THEN 3000
  274. 2640  IF A$ = "Q"  THEN 3140
  275. 2650  GOTO 2630
  276. 2660  REM 
  277. 2670  REM " Change a category name
  278. 2680  REM 
  279. 2690  HOME : VTAB 22: PRINT  TAB( 6)"Change which category name?": GOSUB 2140
  280. 2700  HTAB 1: VTAB 22: CALL  -958: PRINT : PRINT  TAB( 25)"...............";: HTAB 1: POKE 34,22: INPUT "Enter new category name>";B$: TEXT : GOSUB 1710: GOSUB 1600: IF   NOT  LEN(B$)  THEN 2430: REM "15 PERIODS
  281. 2710  IF  LEN(B$) >15  THEN 2700
  282. 2720  GOSUB 70: PRINT "Change "P$(C,0)" to "B$"?";: VTAB 24: HTAB 13: PRINT "(confirm Y/N)";
  283. 2730  GOSUB 80: IF A$ = "N"  THEN 2430
  284. 2740  IF  ASC(A$) = 27  THEN 350
  285. 2750  IF A$ > <"Y"  THEN 2730
  286. 2760  GOSUB 1600: PRINT  TAB( 12)"K)eep or D)elete": PRINT  TAB( 6)P$(C,0)" list contents?";
  287. 2770  GOSUB 80: IF A$ < >"K"  AND A$ < >"D"  THEN 2770
  288. 2780  HOME : VTAB 12: PRINT  TAB( 9)"Changing category name"
  289. 2790  GOSUB 3190:P$(C,0) = B$:P = 0: GOSUB 3200: IF A$ = "K"  THEN 2820
  290. 2800  FOR P = 1 TO 40: IF   NOT  LEN(P$(C,P))  THEN  NEXT : GOTO 2820
  291. 2810 P$(C,P) = "":P%(C,P) = 0: GOSUB 3200: NEXT 
  292. 2820  GOSUB 3210: GOTO 2430
  293. 2830  REM 
  294. 2840  REM " Add a category
  295. 2850  REM 
  296. 2860  IF CTG <40  THEN 2890
  297. 2870  HOME : GOSUB 1590: VTAB 9: PRINT  CHR$(7)"You have reached the 40-category limit. A new category may be added only after  an existing category is deleted."
  298. 2880  VTAB 23: GOSUB 1610: GOTO 2430
  299. 2890  VTAB 12: HTAB 1: CALL  -958: VTAB 16: PRINT  TAB( 25)"...............";: HTAB 1: POKE 34,15: INPUT "Enter new category name>";B$: TEXT : GOSUB 1710: IF   NOT  LEN(B$)  THEN 2430: REM "15 PERIODS
  300. 2900  IF  LEN(B$) >15  THEN 2890
  301. 2910 C = CTG:P = 0: GOSUB 70:P$(C,0) = B$:P%(C,0) = 1: GOSUB 3190: GOSUB 3200: FOR P = 1 TO 40:P$(C,P) = "":P%(C,P) = 0: GOSUB 3200: NEXT :CTG = CTG +1: GOSUB 3220: GOSUB 3210: GOTO 2430
  302. 2920  REM 
  303. 2930  REM " This is where we go the very first time SHOPPER is run.
  304. 2940  REM 
  305. 2950  POKE 216,0: PRINT : PRINT D$"CLOSE":P =  PEEK(222): IF P <5  OR P >6  THEN  PRINT "ERROR #"P" IN LINE #" PEEK(218) + PEEK(219) *256: END 
  306. 2970  HOME : GOSUB 1590: PRINT : PRINT : PRINT "You may:": PRINT : PRINT  TAB( 8)"E)nter categories": PRINT : PRINT  TAB( 8)"Q)uit": HTAB 1: VTAB 1: GOSUB 80: IF A$ = "Q"  THEN 3140
  307. 2980  IF A$ > <"E"  THEN 2970
  308. 2990  DIM P$(39,40),P%(39,40),PR%(39):CTG = 0
  309. 3000  HOME : GOSUB 1590: PRINT : PRINT  TAB( 11)"=================": PRINT  TAB( 11)"! Shopper setup !": PRINT  TAB( 11)"=================": PRINT : PRINT : PRINT : REM "17/17 ='S
  310. 3010  PRINT  TAB( 22)"...............": PRINT : PRINT  TAB( 9)"Press RETURN to finish": VTAB 15: POKE 34,14: INPUT "Enter category name->";B$: TEXT : GOSUB 1710:P$(CTG,0) = B$: REM "15 PERIODS
  311. 3020  IF   NOT  LEN(P$(CTG,0))  AND CTG  THEN 3065
  312. 3030  IF   NOT  LEN(P$(CTG,0))  THEN 2630
  313. 3040  IF  LEN(P$(CTG,0)) >15  THEN  VTAB 20: PRINT  CHR$(7)"Entry too long.": PRINT : PRINT : GOSUB 1610: GOTO 3000
  314. 3050 B$ = P$(CTG,0): GOSUB 70:P$(CTG,0) = B$:P%(CTG,0) = 1:CTG = CTG +1: IF CTG = 40  THEN 3065
  315. 3060  GOTO 3000
  316. 3065 LCTG = CTG: HOME : VTAB 12: PRINT  TAB( 10)"Creating the file...": GOSUB 3230: GOTO 250
  317. 3070  REM 
  318. 3080  REM " Exits from program
  319. 3090  REM 
  320. 3100  VTAB 1: PRINT : IF CTG =  >LCTG  THEN  PRINT D$"LOCK"F$: GOTO 3140
  321. 3110  HOME : VTAB 12: PRINT  TAB( 8)"Optimizing Shopping Data": GOSUB 3230: PRINT D$"LOCK"F$
  322. 3140  POKE 216,0: HOME : END 
  323. 3150  REM   
  324. 3160  REM   " Disk Writes (DOS version)
  325. 3170  REM   
  326. 3180  GOSUB 3190: GOSUB 3200: GOSUB 3210: RETURN 
  327. 3190  VTAB 1: PRINT : PRINT D$"OPEN"F$",L18": RETURN 
  328. 3200  VTAB 1: PRINT D$"WRITE"F$",R"C *41 +P +1: PRINT P$(C,P): PRINT P%(C,P): RETURN 
  329. 3210  PRINT D$"CLOSE": RETURN 
  330. 3220  PRINT D$"WRITE"F$",R0": PRINT CTG: RETURN 
  331. 3230  GOSUB 3190: GOSUB 3210: PRINT D$"DELETE"F$: GOSUB 3190: GOSUB 3220: FOR C = 0 TO CTG -1: FOR P = 0 TO 40: GOSUB 3200: NEXT : NEXT : GOSUB 3210: RETURN