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