home *** CD-ROM | disk | FTP | other *** search
Wrap
10 ' *********** 20 ' * Rolodex * 30 ' *********** 40 KEY OFF:WIDTH 80:GOSUB 1950:LOCATE ,,0 50 A$="a":Z$="z":AC$="A":ZC$="Z":B$=" " 60 CV%=ASC(AC$)-ASC(A$) 70 DIM NUM%(26) 80 DEF FNCAP$(C$)=CHR$(ASC(C$)+CV%*(C$>=A$)*(C$<=Z$)) 90 ' Disk file is Rolodex.dat with a length of 128 100 ' Each address is contained on one record 110 ' The first 16 characters is the last name 120 ' The next 22 characters is the first name or names 130 ' The next 3 sets of 20 characters is the street or mailing address 140 ' The next 9 characters is the zip code 150 ' The next 20 characters is the phone number 160 ' The last character is a sub code 170 OPEN "Rolodex.dat" AS #1 LEN=128 180 FIELD #1,16 AS LAST.NAME$,22 AS FIRST.NAME$,20 AS ADDRESS1$,20 AS ADDRESS2$,20 AS ADDRESS3$,9 AS ZIP.CODE$,20 AS PHONE.NUMBER$,1 AS SUB.CODE$ 190 FIELD #1,128 AS GOT$ 200 IF LOF(1)>0 THEN 320 210 LOCATE 5:PRINT "The disk in drive A: doesn't have a rolodex data file on it." 220 PRINT "Rolodex requires a data file that will take up most of the space" 230 PRINT "of a single sided disk. Do you want the data file opened and initia-" 240 PRINT "ed, or would you rather not at this moment. It is suggested that" 250 PRINT "you have only DOS, BASIC, ROLODEX, and it's data file on the disk" 260 PRINT:PRINT "Do you want to 1 Initialize the disk or 2 stop here"; 270 INPUT " (1 or 2)";WHICH 280 IF WHICH<1 OR WHICH>2 THEN 260 ELSE IF WHICH=2 THEN CLOSE:KILL"Rolodex.dat":END 290 LOCATE 14,14:PRINT "Initializing the address data file" 300 LSET GOT$="" 310 FOR I=1 TO 850:PUT #1,I:NEXT I 320 GOSUB 2280: ' Wave a little flag for Clay Jones 330 GOSUB 1950:LOCATE 5,,0:PRINT "A = Enter new addresses" 340 PRINT:PRINT "B = Edit existing addresses" 350 PRINT:PRINT "C = List addresses" 360 PRINT:PRINT "D = End" 370 PRINT:PRINT:PRINT "Press the key for the option you want" 380 L$="ABCD" 390 CMD$=INKEY$:IF CMD$="" THEN 390 400 CMD$=FNCAP$(CMD$) 410 CMD%=INSTR(L$,CMD$):IF CMD%=0 THEN SOUND 1000,1:SOUND 2000,2:BEEP:GOTO 390 420 SOUND 1000,1:SOUND 2000,2:SOUND 3000,2:ON CMD% GOTO 430,660,970,1840 430 GOSUB 1960:LOCATE 5,13:COLOR 0,7:PRINT "End adding":COLOR 7,0:LOCATE 24,1:PRINT "[PgUp] to start over entering"; 440 LOCATE 5,13:MAX.IN=16:GOSUB 2070 450 IF IN$="" THEN GOTO 330 460 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LAST$=IN$ 470 IF FNCAP$(IN$)<"A" OR FNCAP$(IN$)>"Z" THEN LOCATE 5,30:PRINT "That is an invalid last name":GOSUB 1920:GOTO 430 480 LOCATE 7,13:MAX.IN=22:GOSUB 2070 490 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE FIRST$=IN$ 500 LOCATE 9,13:MAX.IN=20:GOSUB 2070 510 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LINE1$=IN$ 520 LOCATE 11,13:MAX.IN=20:GOSUB 2070 530 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LINE2$=IN$ 540 LOCATE 13,13:MAX.IN=20:GOSUB 2070 550 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LINE3$=IN$ 560 LOCATE 15,13:MAX.IN=9:GOSUB 2070 570 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE ZIP$=IN$ 580 LOCATE 17,13:MAX.IN=20:GOSUB 2070 590 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE PHONE$=IN$ 600 LOCATE 19,13:MAX.IN=1:GOSUB 2070 610 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE CODE$=FNCAP$(IN$+" ") 620 START%=(ASC(FNCAP$(LEFT$(LAST$,1)))-ASC(AC$)) 630 START%=START%*30+1 640 GET #1,START%:IF ASC(FIRST.NAME$)<>ASC(B$) AND ASC(FIRST.NAME$)<>ASC("*") THEN START%=START%+1:GOTO 640 650 NUMBER=START%:GOSUB 1760:GOTO 430 660 GOSUB 1950:LOCATE 5:PRINT "Last name ";:COLOR 0,7:PRINT ":End editing"SPC(5):COLOR 7,0 670 LOCATE 7,1:PRINT "Terminate with a ? to search for part of a name":PRINT "ie. ";:COLOR 0,7:PRINT ":A? ";:COLOR 7,0:PRINT " will search for all last names starting with A" 680 LOCATE 5,13:MAX.IN=16:GOSUB 2070:IF IN$="" THEN 330 690 GOSUB 1850:IF NUM=-1 THEN LOCATE 5,30:PRINT "Invalid name":GOSUB 1920:GOTO 660 700 IF NUM=0 THEN LOCATE 5,30:PRINT "No such last name on file":GOSUB 1920:GOTO 660 710 IF NUM=1 THEN NUMBER=NUM%(1):GOTO 750 720 GOSUB 1950:PRINT:FOR I=1 TO NUM:PRINT I;:GET #1,NUM%(I):PRINT LAST.NAME$;FIRST.NAME$:NEXT I 730 INPUT "Which one";W:IF W=0 THEN 660 ELSE IF W<1 OR W>NUM THEN 710 740 NUMBER=NUM%(W) 750 GOSUB 1670:GOSUB 1960:LOCATE 24,1:PRINT "[PgUp] to redisplay address - [PgDn] to end without corredtions"; 760 COLOR 0,7:LOCATE 5,13:PRINT LAST$;:COLOR 7,0:PRINT " Enter an * here to delete":COLOR 0,7:LOCATE 7,13:PRINT FIRST$:LOCATE 9,13:PRINT LINE1$ 770 LOCATE 11,13:PRINT LINE2$:LOCATE 13,13:PRINT LINE3$:LOCATE 15,13:PRINT ZIP$:LOCATE 17,13:PRINT PHONE$ 780 LOCATE 19,13:PRINT CODE$:COLOR 7,0 790 MAX.IN=16:LOCATE 5,13:GOSUB 2070:IF IN$="*" THEN LAST$="*":GOTO 950 ELSE PRINT SPC(30) 800 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 810 IF IN$<>"" THEN IF LEFT$(IN$,1)<>LEFT$(LAST$,1) THEN PRINT "You can`t change the first letter of the last name":FOR I=1 TO 1000:NEXT I:GOTO 710 ELSE LAST$=IN$ 820 MAX.IN=22:LOCATE 7,13:GOSUB 2070 830 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN FIRST$=IN$ 840 LOCATE 9,13:MAX.IN=20:GOSUB 2070 850 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN LINE1$=IN$ 860 LOCATE 11,13:GOSUB 2070 870 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN LINE2$=IN$ 880 LOCATE 13,13:GOSUB 2070 890 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN LINE3$=IN$ 900 LOCATE 15,13:MAX.IN=10:GOSUB 2070 910 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN ZIP$=IN$ 920 LOCATE 17,13:MAX.IN=20:GOSUB 2070 930 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN PHONE$=IN$ 940 LOCATE 19,13:MAX.IN=1:GOSUB 2070 950 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN CODE$=FNCAP$(IN$) 960 GOSUB 1760:GOTO 660 970 GOSUB 1950:LOCATE 5:PRINT "A = Print only 1 address" 980 PRINT:PRINT "B = Print addresses with a specific last name" 990 PRINT:PRINT "C = Print all addresses":PRINT:PRINT "D = Print according to sub code" 1000 PRINT:PRINT "E = End Printing" 1010 PRINT:PRINT:PRINT "Press the key for your choice" 1020 CMD$=INKEY$:IF CMD$="" THEN 1020 ELSE CMD%=INSTR("ABCDE",FNCAP$(CMD$)):IF CMD%=0 THEN SOUND 1000,1:SOUND 2000,1:BEEP:GOTO 1020 1030 SOUND 1000,1:SOUND 2000,2:SOUND 3000,2:IF CMD%=5 THEN 330 ELSE IF CMD%>1 THEN 1150 1040 GOSUB 1950:PRINT:PRINT "List addresses":LOCATE 5:PRINT "Last name ";:COLOR 0,7:PRINT ":End "SPC(5):COLOR 7,0 1050 LOCATE 7,1:PRINT "Terminate with a ? to search for part of a name":PRINT "ie. ";:COLOR 0,7:PRINT ":A? ";:COLOR 7,0:PRINT " will search for all last names starting with A" 1060 LOCATE 5,13:MAX.IN=16:GOSUB 2070:PRINT:PRINT:IF IN$="" THEN 970 1070 GOSUB 1850:IF NUM=-1 THEN LOCATE 5,30:PRINT "Invalid name":GOSUB 1920:GOTO 1040 1080 IF NUM=0 THEN LOCATE 5,30:PRINT "No such last name on file":GOSUB 1920:GOTO 1040 1090 IF NUM=1 THEN NUMBER=NUM%(1):GOTO 1140 1100 GOSUB 1950:PRINT:FOR I=1 TO NUM:PRINT I;:GET #1,NUM%(I):PRINT LAST.NAME$;FIRST.NAME$:NEXT I 1110 INPUT "Which one";W:IF W=0 THEN 970 ELSE IF W<1 OR W>NUM THEN 1090 1120 NUMBER=NUM%(W) 1130 GOSUB 1630:IF WHICH=-1 THEN 1040 1140 GOSUB 1670:GOSUB 1480:FOR I=1 TO 2000:NEXT I:GOTO 970 1150 IF CMD%>2 THEN 1230 1160 GOSUB 1950:LOCATE 3:PRINT "List addresses":LOCATE 5:PRINT "Last name ";:COLOR 0,7:PRINT ":End";SPC(13):COLOR 7,0 1170 LOCATE 7,1:PRINT "Terminate with a ? to search for part of a name":PRINT "ie. ";:COLOR 0,7:PRINT ":A? ";:COLOR 7,0:PRINT " will search for all last names starting with A" 1180 LOCATE 5,13:MAX.IN=16:GOSUB 2070:IF IN$="" THEN 970 1190 PRINT:PRINT:GOSUB 1850:IF NUM<0 THEN LOCATE 5,30:PRINT "Invalid":GOSUB 1920:GOTO 1160 1200 IF NUM=0 THEN LOCATE 5,30:PRINT "None saved under that name":GOSUB 1920:GOTO 1160 1210 GOSUB 1630:IF WHICH=-1 THEN 1160 1220 FOR L=1 TO NUM:NUMBER=NUM%(L):GOSUB 1670:GOSUB 1480:NEXT L:FOR I=1 TO 3000:NEXT I:GOTO 970 1230 IF CMD%=4 THEN 1350 1240 GOSUB 1950:LOCATE 3:PRINT "List all addresses on file":GOSUB 1630:P=0 1250 GOSUB 1630:IF WHICH=-1 THEN 970 1260 FOR LTR=ASC("A") TO ASC("Z") 1270 IN$=CHR$(LTR)+"?":GOSUB 1850 1280 IF NUM=0 THEN 1320 1290 P=P+NUM:FOR L=1 TO NUM 1300 NUMBER=NUM%(L):GOSUB 1670:GOSUB 1480 1310 NEXT L 1320 NEXT LTR 1330 IF P=0 THEN PRINT "None saved on file" ELSE PRINT P;"addresses saved." 1340 FOR L=1 TO 3000:NEXT L:GOTO 970 1350 GOSUB 1950:LOCATE 5:PRINT "What sub codes ";:COLOR 0,7:PRINT ":";SPC(10);:COLOR 7,0 1360 PRINT:PRINT:PRINT "All names with the entered codes will be printed (space is a code also).":LOCATE 5,17:MAX.IN=10:GOSUB 2070 1370 IF IN$=CHR$(1) OR IN$=CHR$(2) OR IN$="" THEN 970 ELSE GOSUB 2060:LOOK.CODE$=IN$ 1380 GOSUB 1630:P=0:IF WHICH=-1 THEN 1350 1390 FOR LTR=ASC("A") TO ASC("Z") 1400 IN$=CHR$(LTR)+"?":GOSUB 1850 1410 IF NUM=0 THEN 1450 1420 FOR L=1 TO NUM 1430 NUMBER=NUM%(L):GOSUB 1670:IF INSTR(LOOK.CODE$,CODE$)<>0 THEN P=P+1:GOSUB 1480 1440 NEXT L 1450 NEXT LTR 1460 IF P=0 THEN PRINT "None saved under that code" ELSE PRINT P;"saved under that code" 1470 FOR L=1 TO 3000:NEXT L:GOTO 970 1480 IF WHICH=1 THEN 1560 1490 FOR I=LEN(FIRST$) TO 1 STEP -1:IF MID$(FIRST$,I,1)<>B$ THEN 1500 ELSE NEXT I 1500 LPRINT TAB(T);LEFT$(FIRST$,I);" ";LAST$:LPRINT TAB(T);LINE1$:LPRINT TAB(T);LINE2$; 1510 FOR I=LEN(LINE3$) TO 1 STEP -1:IF MID$(LINE3$,I,1)<>B$ THEN 1520 ELSE NEXT I:LPRINT " ";ZIP$:GOTO 1530 1520 LPRINT:LPRINT TAB(T);LINE3$;" ";ZIP$ 1530 IF PHONE=1 THEN LPRINT TAB(T);PHONE$ ELSE LPRINT 1540 LPRINT:IF I=0 THEN LPRINT 1550 IF WHICH=2 THEN RETURN 1560 FOR I=LEN(FIRST$) TO 1 STEP -1:IF MID$(FIRST$,I,1)<>B$ THEN 1570 ELSE NEXT I 1570 PRINT TAB(T);LEFT$(FIRST$,I);" ";LAST$:PRINT TAB(T);LINE1$:PRINT TAB(T);LINE2$; 1580 FOR I=LEN(LINE3$) TO 1 STEP -1:IF MID$(LINE3$,I,1)<>B$ THEN 1590 ELSE NEXT I:PRINT " ";ZIP$:GOTO 1600 1590 PRINT:PRINT TAB(T);LINE3$;" ";ZIP$ 1600 IF PHONE=1 THEN PRINT TAB(T);PHONE$ ELSE PRINT 1610 PRINT:IF I=0 THEN PRINT 1620 RETURN 1630 LOCATE 10,1:INPUT "1 = on screen 2 = on printer (labels) 3 = both";WHICH$:IF WHICH$="" THEN WHICH=-1:RETURN ELSE WHICH=VAL(WHICH$) 1640 IF WHICH=0 THEN WHICH=1 1650 PRINT:INPUT "0 = Don't print phone number 1 = Do print phone number";PHONE$:IF PHONE$="" THEN 1630 ELSE PHONE=VAL(PHONE$) 1660 RETURN 1670 GET #1,NUMBER 1680 LAST$=LAST.NAME$:FIRST$=FIRST.NAME$ 1690 LINE1$=ADDRESS1$ 1700 LINE2$=ADDRESS2$ 1710 LINE3$=ADDRESS3$ 1720 ZIP$=ZIP.CODE$ 1730 PHONE$=PHONE.NUMBER$ 1740 CODE$=SUB.CODE$ 1750 RETURN 1760 LSET LAST.NAME$=LAST$:LSET FIRST.NAME$=FIRST$ 1770 LSET ADDRESS1$=LINE1$ 1780 LSET ADDRESS2$=LINE2$ 1790 LSET ADDRESS3$=LINE3$ 1800 LSET ZIP.CODE$=ZIP$ 1810 LSET PHONE.NUMBER$=PHONE$ 1820 LSET SUB.CODE$=CODE$ 1830 PUT #1,NUMBER:RETURN 1840 CLEAR:END 1850 START%=ASC(FNCAP$(LEFT$(IN$,1)))-ASC(AC$):NUM=0 1860 START%=START%*30+1:LSET LAST.NAME$=IN$:IN$=LAST.NAME$:NUM=0:GOSUB 2060:F$=IN$ 1870 IF START%<0 OR START%>3000 THEN NUM=-1:RETURN 1880 DIST%=INSTR(F$,"?")-1:IF DIST%<0 THEN DIST%=LEN(F$) 1890 GET #1,START%:IF ASC(LAST.NAME$)=32 THEN RETURN 1900 IN$=LAST.NAME$:GOSUB 2060:IF LEFT$(IN$,DIST%)<>LEFT$(F$,DIST%) THEN START%=START%+1:GOTO 1890 1910 NUM=NUM+1:NUM%(NUM)=START%:START%=START%+1:GOTO 1890 1920 SOUND 2000,1:SOUND 1000,1 1930 FOR I=1 TO 1000:NEXT I 1940 RETURN 1950 CLS:PRINT TAB(30);"Rolodex":RETURN 1960 GOSUB 1950 1970 LOCATE 5 :PRINT "Last name ";:COLOR 0,7:PRINT ":";SPC(16):COLOR 7,0 1980 PRINT:PRINT:PRINT "First name ";:COLOR 0,7:PRINT ":";SPC(22):COLOR 7,0 1990 PRINT:PRINT:PRINT "Address ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0 2000 PRINT:PRINT:PRINT "Address ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0 2010 PRINT:PRINT:PRINT "Address ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0 2020 PRINT:PRINT:PRINT "Zip Code ";:COLOR 0,7:PRINT ":";SPC(9):COLOR 7,0 2030 PRINT:PRINT:PRINT "Phone ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0 2040 PRINT:PRINT:PRINT "Sub Code ";:COLOR 0,7:PRINT ": ":COLOR 7,0 2050 RETURN 2060 FOR I=1 TO LEN(IN$):MID$(IN$,I,1)=FNCAP$(MID$(IN$,I,1)):NEXT I:RETURN 2070 LFT=POS(0):IN$="" 2080 LOCATE ,,1,5,5:COLOR 0,7 2090 CMD$=INKEY$:IF CMD$="" THEN 2090 2100 IF LEN(CMD$)=1 THEN 2180 2110 IF RIGHT$(CMD$,1)<>CHR$(83) THEN 2140 2120 IF RIGHT$(IN$,1)=B$ OR POS(0)=LFT THEN 2090 ELSE LOCATE ,POS(0)-1:PRINT SPC(1);:LOCATE ,POS(0)-1:IN$=LEFT$(IN$,LEN(IN$)-1):GOTO 2090 2130 CMD$=CHR$(8):GOTO 2220 2140 IF RIGHT$(CMD$,1)<>CHR$(73) THEN 2160 2150 IN$=CHR$(1):GOTO 2200 2160 IF RIGHT$(CMD$,1)<>CHR$(81) THEN 2090 2170 IN$=CHR$(2):GOTO 2200 2180 IF CMD$=CHR$(27) THEN COLOR 7,0:LOCATE ,,,7,7:STOP 2190 IF CMD$<>CHR$(13) THEN 2220 2200 LOCATE ,LFT+MAX.IN:LOCATE ,,0,7,7:COLOR 7,0 2210 RETURN 2220 IF CMD$=CHR$(8) AND POS(0)=LFT THEN 2090 2230 IF CMD$=CHR$(8) THEN LOCATE ,POS(0)-1:PRINT SPC(1);:LOCATE ,POS(0)-1:IN$=LEFT$(IN$,LEN(IN$)-1):GOTO 2090 2240 IF POS(0)=LFT+MAX.IN THEN BEEP:GOTO 2090 2250 IF POS(0)=LFT THEN PRINT SPC(MAX.IN);:LOCATE ,LFT 2260 IN$=IN$+CMD$:PRINT CMD$; 2270 GOTO 2090 2280 ' ****************************************************************** 2290 ' * Subroutine to tell everyone that Clay Jones wrote this program * 2300 ' ****************************************************************** 2310 SCREEN 1:FOR I=6 TO 94 STEP 8:LINE (I,I)-(319-I,199-I),,B:SOUND 32+5*I,2:NEXT I 2320 FOR I=82 TO 2 STEP -8:LINE (I,I)-(319-I,199-I),,B:SOUND 32+5*I,2:NEXT I 2330 FOR I=4 TO 84 STEP 8:LINE (I,I)-(319-I,199-I),,B:SOUND 32+5*I,2:NEXT I 2340 LOCATE 13,16:PRINT "Clay Jones" 2350 FOR I=1 TO 20:FOR L=1 TO 20:NEXT L:LINE (120,104)-(198,104),2*(I MOD 2):NEXT I 2360 LOCATE 13,16:PRINT " Rolodex " 2370 LOCATE 24,8:PRINT " press any key to begin "; 2380 IF INKEY$<>"" THEN SOUND 1000,1:SOUND 2000,1:SOUND 1000,1:SOUND 2000,1:SCREEN 0:WIDTH 80:RETURN 2390 I=(I=0):FOR L=1 TO 20:NEXT L:LINE (128,104)-(182,104),-2*I:GOTO 2380