10 'This program uses direct addressing to create a mail-listing file
20 'with names, addresses and phone numbers.
30 '
40 'Each record contains 111 bytes and is formatted as follows:
50 '    Bytes  Description
60 '     1     Code Field          Indicates if the record is active
70 '     3     Record Number       Used to access records in the
80 '                               change and delete routines
90 '     30    Name
100 '    25    Address (Line 1)
110 '    25    Address (Line 2)
120 '    30    City, State and Zip Code
130 '    12    Phone Number
140 '
150 'This routine displays the main menu and all other routines return here
160 '
170 CLS : PRINT@(9,33),"Mailing List"	'Print Program Title
180 PRINT @(12,31),"Version 01.01.00"	'Print Version
190 GOSUB 2780   'Allow the titles to be read
200 CLS : PRINT@(3,28),"Model 4 - Mailing List"
210 PRINT@(4,35),"Main Menu"
220 '   Describe the options
230 PRINT@(6,30),"1. Add Entry"' to the file
240 PRINT@(8,30),"2. Change Entry"		
250 PRINT@(10,30),"3. Delete Entry"		
260 PRINT@(12,30),"4. List to Screen"		
270 PRINT@(14,30),"5. List to Printer"		
280 PRINT@(16,30),"6. Return to TRSDOS" 
290 PRINT@(20,30),"Enter Selection ....";
300 GOSUB 2670                      'Get a character from the keyboard
310 IF ENT%=0 OR ENT%>6 THEN 360    'Make sure the character was valid
320 PRINT AN$                       'Echo the character that was typed
330 '   Jump to the proper subroutine based on the entry
340 ON ENT% GOSUB 410,740,1440,1910,2360,3000 : GOTO 200
350  '    Print an error message for invalid entries
360 PRINT@(22,30), "You must enter a number (1-6)." : GOTO 290
370 '
380 '   This is the add routine.  It allows the user to insert records into
390 '   the mailing list data file.
400 '
410 GOSUB 2940                                  'Open the data file
420 REC=LOF(1)		'Get current end-of-file
430 REC=REC+1           'Move to next record
440 CLS : PRINT@(2,32),"Add Entry"	'Display Template to fill
450 PCOL%=40
460 PRINT@(5,10),"Name";TAB(41);STRING$(25,46); : PRINT@(5,PCOL%),;
470 LINE INPUT N$
480 IF LEN(N$)=0 THEN REC=REC-1 : GOTO 680
490 PRINT@(5,PCOL%+LEN(N$)),CHR$(30);     'Erase the trailing dots
500 PRINT@(6,10),"Addr. (Line 1):";TAB(41);STRING$(30,46); : PRINT@(6,PCOL%),;
510 LINE INPUT A1$
520 PRINT@(6,PCOL%+LEN(A1$)),CHR$(30);
530 PRINT@(7,10),"Addr. (Line 2):";TAB(41);STRING$(30,46); : PRINT@(7,PCOL%),;
540 LINE INPUT A2$
550 PRINT@(7,PCOL%+LEN(A2$)),CHR$(30);
560 PRINT@(8,10),"City, State, Zip Code:";TAB(41);STRING$(30,46); : PRINT@(8,PCOL%),"";
570 LINE INPUT C$
580 PRINT@(8,PCOL%+LEN(C$)),CHR$(30);
590 PRINT@(9,10),"Phone (nnn-nnn-nnnn):";TAB(41);STRING$(12,46); : PRINT@(9,PCOL%),;
600 LINE INPUT P$
610 PRINT@(9,PCOL%+LEN(P$)),CHR$(30);
620 '	Set the record Number field = current record #
630 LSET RECNUM$ = MKI$(REC)
640 '	These lines move the data to the buffer to be written to disk
650 LSET NAM$=N$ : LSET ADDR1$=A1$ : LSET ADDR2$=A2$
660 LSET CITY$=C$ : LSET PHONE$=P$ : LSET CODE$="Y"  'Mark active
670 PUT #1,REC				'Write the record
680 PRINT@(16,5),"Press <ENTER> to add another entry or <M> to return to the Main Menu."
690 GOSUB 2880 : IF NOT REPLY% THEN 430 'Get a response from the user
700 CLOSE #1 : RETURN                   'Close the data file and exit to menu
710 '
720 '   This routine allows fields in a record to be modified.
730 '
740 GOSUB 2940                         'Open the data file
750 CLS		'CLEAR THE SCREEN
760 PRINT@ (3,28), "Change Entry"    	'PRINT THE MODULE TITLE
770 PRINT@ (5,9), STRING$(1,32);     'POSITION THE CURSOR
780 INPUT "Enter the number of the entry you want to change..." , AN$
790 ENT%=VAL(AN$)			'STORE THE NUMERICAL VALUE OF ENTRY #
800 '   Look for alphabetic entry
810 IF ENT%=0 THEN PRINT@(20,10),; : GOSUB 2730 : GOTO 750
820 '   Is rec # > End-of-file
830 IF ENT%>LOF(1) THEN 1380 ELSE REC=ENT% : GET #1,REC  'Read record if valid
840 '   Print an error if record is deleted
850 IF CODE$ = "N" THEN 1380
860 '   Display the record
870 PRINT@(7,10),"Entry No.: ";ENT% 	
880 PRINT@(10,10),"Line 1: ";NAM$
890 PRINT@(11,10),"Line 2: ";ADDR1$
900 PRINT@(12,10),"Line 3: ";ADDR2$	
910 PRINT@(13,10),"Line 4: ";CITY$	
920 PRINT@(14,10),"Line 5: ";PHONE$	
930 PRINT@(16,10),"Type the number of the line you want to change...";
940 GOSUB 2670 : IF ENT%=0 OR ENT%>5 THEN 1070 ELSE PRINT AN$'Get an entry
950 '   Set width of input field
960 IF ENT%=1 OR ENT%=4 THEN X=30
970 IF ENT%=2 OR ENT%=3 THEN X=25
980 IF ENT%=5 THEN X=12
990 PRINT@(18,10),"Line";ENT%;":"; STRING$(X,46) 'Show how much can be typed
1000 PRINT@ (18,18), STRING$(1,32); 'Move the cursor
1010 LINE INPUT NDAT$
1020 '
1030 '  These routines determine which field was changed and update the file.
1040 '
1050    ON ENT% GOTO 1100,1140,1180,1220,1260
1060 '  Print an error if number is out of range
1070 PRINT@(18,10),"You must enter a number 1-5." : GOSUB 2780
1080 PRINT@(18,10),CHR$(30); : GOTO 930
1090 PRINT@(16,10),STRING$(47,32);
1100 LSET NAM$=NDAT$
1110 PRINT@(10,18),STRING$(30,32);
1120 PRINT@(10,18),NDAT$;
1130 GOTO 1290
1140 LSET ADDR1$=NDAT$
1150 PRINT@(11,18),STRING$(25,32);
1160 PRINT@(11,18),NDAT$;
1170 GOTO 1290
1180 LSET ADDR2$=NDAT$
1190 PRINT@(12,18),STRING$(25,32);
1200 PRINT@(12,18),NDAT$;
1210 GOTO 1290
1220 LSET CITY$=NDAT$
1230 PRINT@(13,18),STRING$(30,32);
1240 PRINT@(13,18),NDAT$;
1250 GOTO 1290
1260 LSET PHONE$=NDAT$
1270 PRINT@(14,18),STRING$(25,32);
1280 PRINT@(14,18),NDAT$;
1290 PRINT@(18,10),STRING$(60,32)	'Print spaces over prompting messages
1300 PRINT@(16,10),STRING$(60,32);
1310 PRINT@(16,10),"Do you want to change another line ? (Y/N) ";
1320 GOSUB 2800 : IF REPLY% THEN 930 ELSE 1330
1330 PUT #1,REC
1340 PRINT@(18,10),"Press <ENTER> to change another entry or <M> to return to the Main Menu."
1350 GOSUB 2880                         'Get a response from the user
1360 IF REPLY% THEN CLOSE #1 : RETURN ELSE 750    'Exit or change another entry
1370 'Move the cursor and print an error message
1380 PRINT@(18,10),; : GOSUB 2720 : GOTO 750
1390 '
1400 'THIS MODULE DELETES RECORDS. THE RECORDS ARE NOT REALLY DELETED. THE CODE
1410 '	FEILD IS CHANGED  TO INDICATE AN INACTIVE RECORD. THE  USER COULD
1420 '	REACTIVATE THE RECORDS BY CHANGING THE CODE BACK TO "Y".
1430 '
1440 GOSUB 2940                         'Open the data file
1450 CLS : PRINT@(3,33),"Delete Entry"	'PRINT MODULE TITLE
1460 PRINT@(5,14),STRING$(1,32);	'Position the cursor
1470 INPUT "Enter the number of the entry you want to delete...", AN$ 
1480 'PRINT AN ERROR MESSAGE FOR REQUESTING AN INVALID ENTRY
1490 ENT%=VAL(AN$)		'STORE THE NUMERICAL VALUE OF THE ANSWER
1500 IF ENT%=0 THEN PRINT@(22,15),; : GOSUB 2730 : GOTO 1450
1510 'GOTO PRINT AN ERROR MESSAGE IF A RECORD > EOF WAS REQUESTED
1520 IF ENT%>LOF(1) THEN 1830	'REQUESTED AN ENTRY PAST END OF FILE
1530 REC=ENT%			'SET RECORD = RECORD REQUESTED
1540 GET #1,REC
1550 'Make sure records not deleted
1560 IF CODE$="N" THEN 1830
1570 'Display the requested record
1580 PRINT@(8,26),"Entry No.: ";REC
1590 PRINT@(10,26),NAM$
1600 PRINT@(11,26),ADDR1$
1610 R=12		'Set the row number
1620 'Skip Addr2 if it is blank
1630 IF ADDR2$<>STRING$(25,32) THEN PRINT@(R,26),ADDR2$ : R=R+1
1640 PRINT@(R,26),CITY$ : R=R+1
1650 PRINT@(R,26),PHONE$
1660 PRINT@(16,15),"Are you sure you want to delete Entry ";ENT%;"? (Y/N)"
1670 GOSUB 2820 : IF REPLY% THEN 2870 ELSE 1760
1680 LSET CODE$="N"	'Mark this record "Deleted"
1690 PUT #1,REC
1700 'PRINT MESSAGES TO THE USER ABOUT THE STATUS OF THE RECORD
1710 PRINT@(18,26),"Entry ";REC;"has been DELETED from"
1720 PRINT@(19,26),"your mailing list. Press <ENTER> to"
1730 PRINT@(20,26),"delete another entry or <M> to"
1740 PRINT@(21,26),"return to the Main Menu."
1750 GOTO 1800
1760 PRINT@(18,26),"Entry ";REC;"has NOT been deleted"
1770 PRINT@(19,26),"from your mailing list. Press"
1780 PRINT@(20,26),"<ENTER> to delete a different entry"
1790 PRINT@(21,26),"or <M> to return to the Main Menu."
1800 GOSUB 2880                         'Get a response from the user
1810 IF REPLY% THEN CLOSE #1 : RETURN ELSE 1450   'Exit or delete another entry
1820 'Print error messages
1830 PRINT@(20,15),; : GOSUB 2720 : GOTO 1450
1840 PRINT@(22,15),; : GOSUB 2730 : GOTO 1450
1850 CLOSE #1		'CLOSE THE FILE
1860 RETURN		'EXIT THE MODULE
1870 '
1880 '  Displays the mailing records on the screen.
1890 '  The user must specify which entry is to be displayed.
1900 '
1910 GOSUB 2940                         'Open the data file
1920 'ENTER THE ENTRY NUMBER YOU WANT TO SEE OR GET OUT OF THE ROUTINE.
1930 CLS : PRINT@ (3,36), "List to Screen"	'PRINT MODULE TITLE
1940 X=5
1950 PRINT@ (X,26), "Enter the number of the entry you" 
1960 PRINT@ (X+1,26), "want to see or press <M> <ENTER>"
1970 PRINT@ (X+2,26),; 	'POSITION THE CURSOR
1980 INPUT "to return to the Main Menu..." , AN$
1990 IF AN$="M" OR AN$="m"  THEN CLOSE #1 : RETURN
2000 'IF JUST ENTER IS PRESSED IT WILL GET THE NEXT SEQUENTIAL RECORD IN THE FILE
2010 IF LEN(AN$)=0 THEN 2080
2020 ENT%=VAL(AN$)		'STORE THE NUMERICAL VALUE OF ANSWER
2030 IF ENT%=0 THEN 2290	'ALPHA ENTERED GOTO PRINT ERROR MESSAGE
2040 'REQUESTED AN ANSWER PAST EOF - PRINT ERROR MESSAGE
2050 IF ENT%>LOF(1) THEN 2270		'REQUESTED A RECORD PAST END OF FILE
2060 REC=ENT%		'SET RECORD = RECORD REQUESTED
2070 GOTO 2100		'BRANCH AROUND NEXT SEQUENTIAL RECORD REQUEST
2080 REC=REC+1         'POINT TO NEXT RECORD
2090 IF REC>LOF(1) THEN 2310		'REQUESTED A RECORD PAST END OF FILE
2100 GET #1, REC
2110 'CHECK TO SEE IF RECORD HAS BEEN DELETED
2120 IF CODE$="N" THEN ENT%=REC : GOTO 2270
2130 PRINT@(5,26),STRING$(35,32)    'THESE LINES PRINT BLANKS
2140 PRINT@(6,26),STRING$(35,32)       'ON SCREEN IN PREVIOUSLY USED 
2150 PRINT@(7,26),STRING$(30,32)    'AREAS 
2160 'THESE LINES PRINT THE RECORD REQUESTED TO THE SCREEN
2170 PRINT@(5,26),"Entry Number ";REC
2180 PRINT@(7,26),NAM$
2190 PRINT@(8,26),ADDR1$
2200 R=9				'SET ROW NUMBER
2210 ' IF ADDR2 IS BLANK DONT PRINT A BLANK LINE
2220 IF ADDR2$<>STRING$(25,32) THEN PRINT@(R,26),ADDR2$ : R=R+1
2230 PRINT@(R,26),CITY$ : R=R+1
2240 PRINT@(R,26),PHONE$
2250 X=13 : GOTO 1950
2260 'Print error messages for bad records
2270 CLS:PRINT@ (3,36), "List to Screen"
2280 PRINT@(17,36),; : GOSUB 2720 : GOTO 1930
2290 PRINT@ (18,26), "You must enter <M> or a valid entry number."
2300 GOSUB 2780 : GOTO 1930
2310 PRINT@ (19,26),"End of Entries": GOSUB 2780 : GOSUB 2780 : GOTO 1930
2320 '
2330 '  This routine allows the mailing labels to be printed on standard
2340 '  Radio Shack mailing labels.  Phone numbers are printed optionally.
2350 '
2360 GOSUB 2940                         'Open the data file
2370 CLS
2380 PRINT@(7,31),"List to Printer"
2390 PRINT@(9,17), "Do you want to include phone numbers ? (Y/N)"
2400 GOSUB 2820 : GOTO 2410
2410 FOR REC=1 TO LOF(1)
2420 GET #1,REC
2430 '  Check for the record being deleted
2440 IF CODE$="N" THEN 2530
2450 LPRINT TAB(5);NAM$ : LPRINT TAB(5);ADDR1$
2460 '  If only one address line was used, skip the second
2470 IF ADDR2$<>STRING$(25,32) THEN LPRINT TAB(5);ADDR2$
2480 LPRINT TAB(5);CITY$
2490 '  If phone numbers are to be omitted, don't display them
2500 IF REPLY% THEN LPRINT TAB(5);PHONE$ ELSE LPRINT
2510 LPRINT		'The number of LPRINT statements needed may have to
2520 LPRINT		'changed depending on the labels you are using
2530 NEXT REC		'Do the next record
2540 '	After printing the records, return to the main menu
2550 CLS : PRINT@(7,30),"List to Printer"
2560 PRINT@(9,20),"Press <M> to return to the Main Menu."
2570 GOSUB 2880                         'Get a response from the user
2580 IF NOT REPLY% THEN 2570      	'Exit or else ask again
2590 CLOSE #1			'CLOSE THE FILE
2600 RETURN			'EXIT MODULE
2610 '
2620 '   This routine watches the keyboard and waits for a key
2630 '   to be pressed.  When a key is pressed, the character
2640 '   is returned to the part of the program that wanted the
2650 '   character.
2660 '
2670 AN$=INKEY$    'Get a keystroke from the keyboard
2680 IF LEN(AN$)=0 THEN 2670   'If nothing was typed, ask again
2690 ENT%=VAL(AN$)   'If it was a number, convert it
2700 RETURN                             'Return to the caller
2710 '  Error Messages
2720 PRINT "Entry ";ENT%;" not found" : GOTO 2780
2730 PRINT "You must enter a valid entry number."
2740 '
2750 '   This routine pauses the system so that the contents of
2760 '   the screen may be read
2770 '
2780 FOR DELAY%=1 TO 2000 : NEXT DELAY% : RETURN
2790 '
2800 '   This routine asks and waits for a Y/N or y/N response
2810 '
2820 GOSUB 2670                      'Ask for a character
2830 IF AN$="Y" OR AN$="y" THEN REPLY%=-1 : RETURN
2840 IF AN$="N" OR AN$="n" THEN REPLY%=0 : RETURN ELSE 2820
2850 '
2860 '   This routine accepts a M/m or <Enter> from the keyboard
2870 '
2880 GOSUB 2670                         'Ask for a character
2890 IF AN$="M" OR AN$="m" THEN REPLY%=-1 : RETURN
2900 IF AN$=CHR$(13) THEN REPLY%=0 : RETURN ELSE 2880
2910 '
2920 '      This routine opens the mailing list
2930 '
2940 OPEN "d",#1,"MAILLIST/DAT"
2950 FIELD #1,1 AS CODE$,3 AS RECNUM$,30 AS NAM$,25 AS ADDR1$,25 AS ADDR2$,30 AS CITY$, 12 AS PHONE$
2960 RETURN
2970 '
2980 '	This is the end of the program
2990 '
3000 SYSTEM     'Return to TRSDOS Ready
3010 END
