Grocery List and Coupon Manager keeps a sorted list of up to 300 grocery items and the coupons you hold for them. Each item can carry a coupon expiry month (13 for coupons that never expire), and when you start the program and give the current month, coupons that expire this month are shown in inverse video. You page through the list 18 items at a time and press S to put an item on the shopping list or C to record a coupon. The shopping list can be shown on screen or printed on the TS2040, marking items with coupons ($>) and coupons about to expire (EXP>), and the whole list can be printed grouped by first letter.
The program is dated 9/2/84 in its first line and carries no author’s name; it is by Bob Swoger. It still gives its original cassette instructions: the item list is kept on a separate “FOOD LIST” tape and loaded at start-up.
Program Analysis
Structure
Line 6 dimensions the arrays: G$(300,20) for item names, F(300) for coupon months, O$ and Q for the shopping list, and Z$ for the item being deleted. The subroutine at 900 loads G$() and F() with LOAD ... DATA, and the end of the list is marked by an item called “X” (line 45). The main menu at 800 offers seven choices; adding items (400) ends with a Shell sort (3140 onwards) that keeps the coupon months in step with the names, and deleting (3400) blanks the matching entries and then closes the gaps. Option 7 saves both arrays with SAVE ... DATA.
Notable Techniques
- A Shell sort with a halving gap, sorting two parallel arrays together.
- Coupons due this month are highlighted with
INVERSE 1and anOVER 1marker, and the month number is overprinted at the right edge. - The end of a sort or deletion is announced with a rising chime from the TS2068 sound chip (
SOUND 7,62;8,15and a loop on register 0).
Potential Issues
- Line 3494 blanks
G$(X)using an X left over from start-up, rather than the last item, when the list is closed up after a deletion. - The program was saved to start at line 10, which skips the DIM statements on line 6, so it depended on its saved arrays. The tape version starts at line 6.
This copy came from a Larken disk. For tape, the disk prefixes on the LOAD and SAVE of the two arrays were removed, the save prompt now says tape, the start line was moved to 6, and the program’s saved item list was cleared: the two arrays that follow it on the tape hold an empty list, ready for your own items. Tested in ZEsarUX: items added, sorted and listed.
Image Gallery
Source Code
5 REM GROCERIES--9/2/84
6 DIM G$(300,20): DIM F(300): DIM Z$(1,20): DIM O$(300,20): DIM Q(300)
8 REM ** Z$ IS DYNAMIC STORAGE FOR ITEMS BEING DELETED.
9 REM O$ IS OUTPUT FILE FORSHOPPING LIST; Q=FILE TO SHOW WHILE O$ HAVE COUPONS
10 REM LOAD FOOD ITEMS
20 GO SUB 900
30 CLS : INPUT "CURRENT MONTH? (1-12) ";C
39 REM SUBR FINDS NUMBER OF LAST GROCERY ITEM ON THE TAPE
40 GO SUB 1600
45 FOR X=1 TO 300: IF G$(X,1)="X" THEN GO TO 55
50 NEXT X
55 LET LAST=X-1: LET COUNT=0
58 REM PRINT MENU
59 LET ADD=0
60 GO SUB 800
70 IF MENUCHOICE=1 OR MENUCHOICE=3 THEN GO TO 500
80 IF MENUCHOICE=2 THEN GO TO 3000
95 IF MENUCHOICE=4 THEN GO TO 2000
100 IF MENUCHOICE=5 THEN GO TO 1200
110 IF MENUCHOICE=6 THEN GO TO 1300
120 IF MENUCHOICE=7 THEN GO TO 3660
200 GO TO 3600
299 REM SUBR BUILDS SHOPPING LIST OUTPUT FILE O$
300 LET COUNT=COUNT+1: LET O$(COUNT)=G$(B): LET Q(COUNT)=F(B)
390 GO TO 660
399 REM SUBR ADDS ITEMS
400 CLS : PRINT "ENTER X AS ITEM NAME TO EXIT"
405 LET J=LAST
410 INPUT "ENTER ITEM NAME OR ZZZ TO ENTER"'"COUPON DATA FOR LAST ITEM"'R$
420 IF R$="X" THEN GO TO 440
425 IF R$="ZZZ" THEN INPUT "EXPIRATION MONTH (0-13)?";F(J): GO TO 410
430 LET J=J+1: LET G$(J)=R$: GO TO 410
440 LET LAST=J: LET X=J+1: LET G$(X)=R$
450 LET ADD=1
490 GO TO 3140
499 REM ENTER COUPON DATA OR SELECT ITEMS FOR SHOPPING LIST
500 GO SUB 1000
510 LET J=-17
520 LET J=J+18
530 CLS : LET L=-1: FOR B=J TO J+17: IF B>LAST THEN GO TO 570
535 LET L=L+1
540 IF F(B)<>C THEN PRINT AT L,2;G$(B): GO TO 555
550 INVERSE 1: PRINT AT L,2;G$(B): INVERSE 0: OVER 1: PRINT AT L,0;" "
555 IF F(B)>0 AND F(B)<10 THEN OVER 1: PRINT AT L,31;F(B): OVER 0
557 IF F(B)>9 THEN OVER 1: PRINT AT L,30;F(B): OVER 0
560 NEXT B
570 LET B=J: FOR E=0 TO L
580 PRINT AT E,0;"->"
585 INPUT "S=ADD TO SHOPPING LIST:"'"C=COUPON: ENTER=NEXT ITEM:"'"X=EXIT: P=NEXT PAGE: Q=START"'"WITH CERTAIN LETTER",R$
590 IF R$="S" THEN BEEP .2,0: GO TO 300
600 IF R$="C" THEN GO TO 625
605 IF R$="X" THEN GO TO 60
610 IF R$="Q" THEN GO TO 621
618 IF R$="P" THEN GO TO 520
620 GO TO 660
621 INPUT "START LISTING WITH WHAT LETTER?",R$
622 GO SUB 1600
623 FOR I=1 TO 300: IF G$(I,1)=R$ THEN LET J=I: GO TO 530
624 NEXT I
625 INPUT "EXPIRATION MONTH (0-13)?";F(B): PRINT AT E,30;" "
630 IF F(B)=C THEN INVERSE 1: PRINT AT E,2;G$(B): INVERSE 0: OVER 1: PRINT AT E,0;" ": GO TO 635
632 PRINT AT E,2;G$(B)
634 IF F(B)=0 THEN GO TO 650
635 IF F(B)>0 AND F(B)<10 THEN OVER 1: PRINT AT E,31;F(B): OVER 0: GO TO 650
637 IF F(B)>9 THEN OVER 1: PRINT AT E,30;F(B): OVER 0
660 LET B=B+1: PRINT AT E,0;" "
670 NEXT E
680 IF B<=LAST THEN GO TO 520
690 GO TO 1200
799 REM SUBR TO PRINT MENU
800 CLS : PRINT : PRINT "ENTER A NUMBER:"
810 PRINT : PRINT "1 -- CHOOSE ITEMS FOR SHOPPING"'" LIST"
820 PRINT "2 -- CHANGE LIST OF GROCERIES"
830 PRINT "3 -- CHANGE COUPON DATA"
835 PRINT "4 -- PRINT SHOPPING LIST"
840 PRINT "5 -- DISPLAY SHOPPING LIST"'" ON THE SCREEN"
850 PRINT "6 -- PRINT ENTIRE GROCERY LIST"
855 PRINT "7 -- SAVE DATA ONTO TAPE"
860 PRINT "10-- EXIT"
880 INPUT MENUCHOICE
890 RETURN
899 REM SUBR LOAD FOOD ITEMS
900 CLS : PRINT : PRINT "THE TAPE THAT CONTAINS THE"'"GROCERY ITEMS SAYS"'"""FOOD LIST"" ON IT."
910 PRINT : PRINT "PUT THAT TAPE INTO THE"'"CASSETTE PLAYER."
920 PRINT : PRINT "PRESS ""PLAY"" ON THE"'"CASSETTE PLAYER."
930 PRINT : PRINT "THEN WAIT FOR THE NEXT"'"INSTRUCTIONS."
940 LOAD "Garray.A$" DATA G$(): LOAD "Farray.A1" DATA F()
960 CLS : PRINT : FLASH 1: PRINT "REWIND THE ""FOOD LIST"" TAPE"'"AND PUT IT AWAY.": FLASH 0
970 GO SUB 1270
990 GO TO 30
999 REM DIRECTIONS TO ENTER OR CHANGE COUPON DATA
1000 CLS : PRINT AT 2,0;"FOLLOWING IS A LIST OF GROCERY"'"ITEMS."
1002 PRINT : PRINT "WHEN THE ARROW APPEARS BESIDE AN"'"ITEM, TYPE ""S"" TO INCLUDE THE"'"ITEM ON YOUR SHOPPING LIST."
1005 PRINT : PRINT "TO ENTER OR CHANGE COUPON DATA"'"TYPE ""C"". YOU WILL THEN BE"'"ASKED FOR THE NUMERICAL VALUE"'"OF THE EXPIRATION MONTH."
1010 PRINT : PRINT "(FOR COUPONS WITH NO EXPIRATION"'"DATE, ENTER 13 AS THE MONTH.)"
1015 PRINT : PRINT "TYPE ONLY ""ENTER"" TO SKIP TO"'"THE NEXT ITEM."
1018 PRINT : PRINT "TYPE ""P"" TO GO TO THE NEXT"'"PAGE OF ITEMS."
1020 INPUT "PRESS ENTER WHEN YOU ARE READY.",R$: RETURN
1199 REM SUBR DISPLAYS SHOPPING LIST
1200 CLS : PRINT AT 2,0;"FOLLOWING IS YOUR SHOPPING LIST."
1205 PRINT : PRINT "IF THE LIST IF LONGER THAN ONE"'"SCREEN, THE MESSAGE ""scroll?"""
1210 PRINT "WILL APPEAR AT THE BOTTOM OF THE"'"SCREEN. TO SEE THE NEXT"
1220 PRINT "SCREENFUL, JUST PUSH ENTER."
1222 PRINT : PRINT "ITEMS WITH $> ARE THE ONES THAT"'"HAVE COUPONS."
1223 PRINT : PRINT "THE ONES WITH EXP> HAVE COUPONS"'"THAT EXPIRE THIS MONTH."
1225 GO SUB 1250
1230 CLS : FOR J=1 TO COUNT: IF Q(J)=0 THEN PRINT TAB 4;O$(J): GO TO 1240
1233 IF Q(J)=C THEN PRINT "EXP>";O$(J): GO TO 1240
1235 PRINT TAB 2;"$>";O$(J)
1240 NEXT J
1250 GO SUB 1270
1260 GO TO 60
1270 INPUT "Press ENTER to continue "; LINE R$: RETURN
1299 REM SUBR PRINTS ENTIRE GROCERY LIST
1300 GO SUB 1500
1340 IF F(1)=0 THEN LPRINT TAB 5;"< >";G$(1): GO TO 1350
1343 IF F(1)=C THEN LPRINT "EXP> < >";G$(1): GO TO 1350
1345 LPRINT TAB 2;"$> < >";G$(1)
1350 FOR J=2 TO LAST: IF G$(J,1)<>G$(J-1,1) THEN LPRINT
1355 IF F(J)=0 THEN LPRINT TAB 5;"< >";G$(J): GO TO 1370
1358 IF F(J)=C THEN LPRINT "EXP> < >";G$(J): GO TO 1370
1360 LPRINT TAB 2;"$> < >";G$(J)
1370 NEXT J
1380 FOR J=1 TO 5: LPRINT
1390 NEXT J
1395 GO TO 60
1499 REM PRINTS CURRENT MONTH NUMBER
1500 INPUT "TURN PRINTER ON AND PRESS"'"""ENTER"" ON THE COMPUTER.",R$
1510 LPRINT "THE CURRENT MONTH NUMBER IS ";C
1520 FOR I=1 TO 5: LPRINT : NEXT I
1530 RETURN
1599 REM PRINTS ""WAIT"" MESSAGE
1600 CLS : FLASH 1: PRINT AT 10,10;"PLEASE WAIT": FLASH 0
1610 RETURN
1699 REM ANNOUNCES END OF SORT OR DELETING BLANKS ROUTINE
1700 SOUND 7,62;8,15: FOR I=10 TO 150: SOUND 0,I: PAUSE 1: NEXT I: SOUND 8,0: GO TO 3000
1999 REM SUBR PRINTS SHOPPING LIST
2000 GO SUB 1500
2035 IF Q(1)=C THEN LPRINT "EXP> < >";O$(1): GO TO 2050
2038 IF Q(1)<>0 THEN LPRINT TAB 2;"$> < >";O$(1): GO TO 2050
2040 LPRINT TAB 5;"< >";O$(1)
2050 FOR J=2 TO COUNT: IF O$(J,1)<>O$(J-1,1) THEN LPRINT
2055 IF Q(J)=0 THEN LPRINT TAB 5;"< >";O$(J): GO TO 2070
2056 IF Q(J)=C THEN LPRINT "EXP> < >";O$(J): GO TO 2070
2060 LPRINT TAB 2;"$> < >";O$(J)
2070 NEXT J
2080 FOR J=1 TO 5: LPRINT
2090 NEXT J
2095 GO TO 60
2999 REM PRINTS SUPERSORT MENU
3000 CLS : PRINT : PRINT "ENTER A NUMBER"
3010 PRINT : PRINT "1 -- DELETE ITEM(S)"
3020 PRINT "2 -- ADD ITEM(S)"
3030 PRINT "10-- EXIT"
3040 INPUT SUPERCHOICE
3050 IF SUPERCHOICE=1 THEN GO TO 3400
3060 IF SUPERCHOICE=2 THEN GO TO 400
3065 IF SUPERCHOICE<>10 THEN GO TO 3040
3070 GO TO 60
3099 REM SUBR TO DO SORTING
3140 CLS : FLASH 1: PRINT AT 11,11;"SORTING": FLASH 0
3200 LET B=1
3210 LET B=2*B
3220 IF B<=LAST THEN GO TO 3210
3230 LET B=INT (B/2)
3240 IF B<>0 THEN GO TO 3250
3245 GO TO 1700
3250 FOR J=1 TO LAST-B: LET I=J
3260 LET D=I+B
3280 IF G$(I)<=G$(D) THEN GO TO 3340
3290 LET Z$(1)=G$(I): LET HOLD=F(I): LET G$(I)=G$(D): LET F(I)=F(D): LET G$(D)=Z$(1): LET F(D)=HOLD: LET I=I-B
3330 IF I>0 THEN GO TO 3260
3340 NEXT J
3350 LET ADD=0
3360 GO TO 3230
3399 REM SUBR TO DELETE ITEMS
3400 LET DELETE=0
3402 CLS : PRINT AT 1,0;"TO EXIT, ENTER X AS ITEM NAME.": PRINT
3403 LET J=1
3405 INPUT "ENTER ITEM NAME"'Z$(1)
3410 IF Z$(1,1)="X" THEN GO TO 3480
3415 LET I=J
3420 FOR J=I TO LAST: IF G$(J)<>Z$(1) THEN GO TO 3460
3430 LET G$(J)=" "
3440 PRINT Z$(1);" DELETED."
3445 LET DELETE=DELETE+1
3450 GO TO 3405
3460 NEXT J
3462 IF I=1 THEN GO TO 3470
3465 LET I=1: GO TO 3420
3470 PRINT Z$(1);" NOT FOUND.": GO TO 3405
3480 IF DELETE=0 THEN GO TO 3000
3485 CLS : FLASH 1: PRINT AT 11,6;"DELETING BLANKS": FLASH 0
3488 LET K=1: REM NECESSARY BECAUSE "LAST" IN NEXT LOOP CANNOT BE CHANGED WHILE RUNNING LOOP!
3490 FOR J=K TO LAST: IF G$(J,1)<>" " THEN GO TO 3496
3492 FOR I=J TO LAST: LET G$(I)=G$(I+1): LET F(I)=F(I+1): NEXT I
3494 LET G$(X)=" ": LET X=LAST: LET LAST=LAST-1
3495 LET K=J: GO TO 3490
3496 NEXT J
3498 GO TO 1700
3589 REM SAVES DATA ONTO TAPE AND/OR EXITS AND ADDS SOME LINE FEEDS
3590 FOR J=1 TO 5: LPRINT : NEXT J
3600 INPUT "Want to SAVE DATA onto tape? "; LINE R$: IF R$<>"Y" THEN GO TO 3700
3640 REM SAVE "Garray" DATA G$(): SAVE "Farray" DATA F()
3650 REM GO TO 3640
3660 SAVE "Garray.A$" DATA G$(): SAVE "Farray.A1" DATA F()
3670 IF MENUCHOICE<>10 THEN GO TO 60
3700 CLS : PRINT AT 2,0;"TEAR OFF YOUR LIST."
3710 PRINT : PRINT "TURN THE COMPUTER AND LIGHT"'"SWITCH OFF."
4000 REM END OF PROGRAM
9987 REM removed (LKDOS-only)
9988 STOP
9996 SAVE "GROCER.B1" LINE 6
9998 REM removed (LKDOS-only)Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.