    REM "PHONEBOOK" PROGRAM
    REM KEEPS TRACK OF PEOPLE, THEIR ADDRESS AND PHONE NUMBER,...
    REM AND THE COMPANY FOR WHICH THEY WORK.
    REM USES KEY PACKAGE TO INDEX ON PEOPLE AND COMPANY NAMES.

    DIM CLEARSCREEN$/:C,0,0,0,0/,BACKSPACE$/:8/
    DIM COMMAND$(80),PERSONKEY$(80)/""/
    REM PERSONRECORD
    DIM PERSONNAMESAMELINK/0/,PERSONCOMPANYSAMELINK/0/
    DIM PERSONNAME$(25),PERSONTITLE$(20)
    DIM PERSONCOMPANY$(20),PERSONSTREET$(25)
    DIM PERSONCITY$(20),PERSONSTATECOUNTRY$(20),PERSONZIP$(9)
    DIM PERSONPHONE$(15)

    INCLUDE "KEY.BAS"

SUBROUTINE READPERSONRECORD
    READ #1@PERSONRECORD,PERSONNAMESAMELINK,PERSONCOMPANYSAMELINK,...
&                        PERSONNAME$,PERSONTITLE$,...
&                        PERSONCOMPANY$,PERSONSTREET$,...
&                        PERSONCITY$,PERSONSTATECOUNTRY$,PERSONZIP$,...
&                        PERSONPHONE$
    RETURN SUBROUTINE
END

SUBROUTINE PAD(PAD$)
    FOR PADINDEX=LEN(PAD$)+1 TO MAXLEN(PAD$) DO PAD$[PADINDEX]=0
    LET LEN(PAD$)=MAXLEN(PAD$)
    RETURN SUBROUTINE
END

SUBROUTINE WRITEPERSONRECORD
    PAD(PERSONNAME$)
    PAD(PERSONTITLE$)
    PAD(PERSONCOMPANY$)
    PAD(PERSONSTREET$)
    PAD(PERSONCITY$)
    PAD(PERSONSTATECOUNTRY$)
    PAD(PERSONZIP$)
    PAD(PERSONPHONE$)
    WRITE #1@PERSONRECORD,PERSONNAMESAMELINK,PERSONCOMPANYSAMELINK,...
&                        PERSONNAME$,PERSONTITLE$,...
&                        PERSONCOMPANY$,PERSONSTREET$,...
&                        PERSONCITY$,PERSONSTATECOUNTRY$,PERSONZIP$,...
&                        PERSONPHONE$
    RETURN SUBROUTINE
END

SUBROUTINE PRINTPERSONRECORD(WHERE)
    PRINT #WHERE,PERSONNAME$
    PRINT #WHERE,PERSONTITLE$
    PRINT #WHERE,PERSONCOMPANY$
    PRINT #WHERE,PERSONSTREET$
    PRINT #WHERE,PERSONCITY$
    PRINT #WHERE,PERSONSTATECOUNTRY$
    PRINT #WHERE,PERSONZIP$
    PRINT #WHERE,PERSONPHONE$
    PRINT #WHERE
    RETURN SUBROUTINE
END

DEF FINDANDDISPLAYPERSON
    REM THIS FUNCTION RETURNS FALSE IF "PERSONKEY$" CANNOT BE FOUND
    REM ELSE RETURNS TRUE AFTER DISPLAYING RECORD ABOUT PERSON
    IF ERROR WHEN
       PERSONRECORD=KEY(1,1,PERSONKEY$)
    THEN IF ERR=1075 THEN NOSUCHPERSON ELSE ERROR
    PRINT CLEARSCREEN$
    READPERSONRECORD
    PRINTPERSONRECORD(0)
    RETURN TRUE

NOSUCHPERSON: REM CAN'T FIND THE PERSON DESIRED, TRY KEYNEXT
    PERSONNAMESAMELINK=0
NEXTPERSON: REM TRY FOR NEXT PERSON
    IF PERSONNAMESAMELINK<>0
    THEN
        REM MORE THAN ONE GUY WITH THE SAME NAME
        PERSONRECORD=PERSONNAMESAMELINK
        GOTO DISPLAYNEXTPERSON
    FI
    IF ERROR WHEN
        PERSONRECORD=KEYNEXT(1,1,PERSONKEY$)
    THEN IF ERR=1001
         THEN
             PRINT "CAN'T FIND PERSON SELECTED."
             PERSONRECORD=0\COMMAND$=""\RETURN FALSE
         ELSE ERROR

DISPLAYNEXTPERSON:
    PRINT CLEARSCREEN$;"PERHAPS YOU MEANT: "
    PRINT
    READPERSONRECORD
    PRINTPERSONRECORD(0)
    INPUT 'ENTER "YES" OR "NO", <CR> MEANS "NEXT" ' COMMAND$
    IF COMMAND$="" THEN NEXTPERSON
    ELSEIF UPPERCASE$(COMMAND$)="YES" THEN COMMAND$=""\RETURN TRUE
    ELSEIF UPPERCASE$(COMMAND$)="NO"
        THEN
            COMMAND$=""
            PERSONRECORD=0
            RETURN FALSE
    ELSE PERSONRECORD=0\RETURN FALSE
END

SUBROUTINE ADDRECORD
    REM THIS SUBROUTINE ADDS A PERSON RECORD TO THE DATABASE
    REM BY INSERTING BOTH PERSONNAME$ AND PERSONCOMPANY$ AS KEYS
    REM IN KEY INDEXES 1 AND 2, RESPECTIVELY.
    REM IF A KEY ALREADY EXISTS, THE RECORD IS SIMPLY ADDED TO A CHAIN
    REM OF RECORDS THAT HAVE IDENTICAL KEYS. THIS WAY
    REM ALL PEOPLE IN THE SAME COMPANY ARE EASILY FOUND, AS
    REM ARE ALL PEOPLE WITH THE SAME NAME.
    PERSONNAMESAMELINK=0 \ REM ASSUME NO OTHER IDENTICAL NAMES
    PERSONCOMPANYSAMELINK=0 \ REM ASSUME NO OTHER IDENTICAL COMPANIES
    LET PERSONRECORD=GETSPACE(1,221)
    REM ADD PERSON TO NAME INDEX
    IF ERROR WHEN
        KEYINSERT(1,1,PERSONNAME$,PERSONRECORD)
    THEN
        REM THAT NAME ALREADY EXISTS, PLACE PERSON RECORD ON CHAIN
        IF ERR=1076
        THEN PERSONNAMESAMELINK=...
&            KEYREPLACE(1,1,PERSONNAME$,PERSONRECORD)
        ELSE ERROR
    FI
    REM ADD PERSON TO COMPANY INDEX
    IF ERROR WHEN
        KEYINSERT(1,2,PERSONCOMPANY$,PERSONRECORD)
    THEN
        REM THAT COMPANY ALREADY EXISTS, PLACE PERSON RECORD ON CHAIN
        IF ERR=1076
        THEN PERSONCOMPANYSAMELINK=...
&            KEYREPLACE(1,2,PERSONCOMPANY$,PERSONRECORD)
        ELSE ERROR
    FI
    WRITEPERSONRECORD
    RETURN SUBROUTINE
END

SUBROUTINE DELETERECORD
    REM DELETE THE FOUND RECORD
    REM THIS UNDOES WHAT ADDRECORD DOES.
    REM THIS MAY REQUIRE SIMPLE REMOVAL FROM A CHAIN
    REM IF THE CHAIN GETS EMPTY, THE KEY MUST BE DELETED!
    REM DELETE FROM NAME KEY CHAIN FIRST
    PERSONPREVIOUS=KEY(1,1,PERSONNAME$)\! NO ERROR CAN OCCUR HERE
    IF PERSONPREVIOUS=PERSONRECORD
    THEN
        REM THIS RECORD IS THE FIRST RECORD ON A NAME CHAIN
        IF PERSONNAMESAMELINK=0
        THEN
            REM THIS RECORD IS ONLY RECORD WITH THIS PERSON NAME
            KEYDELETE(1,1,PERSONNAME$) \! POOF GOES THE NAME KEY
        ELSE
            REM THERE ARE OTHER RECORDS WITH THE SAME NAME
            REM REPLACE CHAIN HEAD WITH POINTER TO REST OF CHAIN
            PERSONRECORD=...
&               KEYREPLACE(1,1,PERSONNAME$,PERSONNAMESAMELINK)
        FI
    ELSE
        REM THIS RECORD IS SOMEWHERE ON A CHAIN...
        REM OF RECORDS WITH SAME NAME
FINDPREVIOUSPERSON: REPEAT
                        READ #1@PERSONPREVIOUS,PERSONNEXT
                        IF PERSONNEXT=PERSONRECORD
                        THEN EXIT FINDPREVIOUSPERSON
                        PERSONPREVIOUS=PERSONNEXT
                    END
         REM FOUND RECORD IN CHAIN WHOSE "NEXT" POINTER...
         REM SELECTS RECORD TO BE DELETED
         REM REMOVE THIS RECORD FROM THE CHAIN
         WRITE #1@PERSONPREVIOUS,PERSONNAMESAMELINK
    FI
    REM NOW DELETE FROM COMPANY KEY CHAIN
    COMPANYPREVIOUS=KEY(1,2,PERSONCOMPANY$)\! NO ERROR POSSIBLE
    IF COMPANYPREVIOUS=PERSONRECORD
    THEN
        REM THIS RECORD IS THE FIRST RECORD ON A COMPANY CHAIN
        IF PERSONCOMPANYSAMELINK=0
        THEN
            REM THIS RECORD IS THE ONLY RECORD WITH THIS COMPANY NAME
            KEYDELETE(1,2,PERSONCOMPANY$) \! POOF GOES THE NAME KEY
        ELSE
            REM THERE ARE OTHER RECORDS WITH THE SAME COMPANY NAME
            REM REPLACE CHAIN HEAD WITH POINTER TO REST OF CHAIN
            PERSONRECORD=...
&               KEYREPLACE(1,2,PERSONCOMPANY$,PERSONCOMPANYSAMELINK)
        FI
    ELSE
        REM THIS RECORD IS SOMEWHERE ON A CHAIN...
        REM OF RECORDS OF SAME COMPANY
FINDPREVIOUSCOMPANY: REPEAT
                        READ #1@COMPANYPREVIOUS,PERSONNEXT,COMPANYNEXT
                        IF COMPANYNEXT=PERSONRECORD
                        THEN EXIT FINDPREVIOUSCOMPANY
                        COMPANYPREVIOUS=COMPANYNEXT
                    END
         REM FOUND RECORD IN CHAIN WHOSE "NEXT" POINTER...
         REM SELECTS RECORD TO BE DELETED
         REM REMOVE THIS RECORD FROM THE CHAIN
         WRITE #1@COMPANYPREVIOUS,PERSONNEXT,PERSONCOMPANYSAMELINK
    FI
    RETURN SUBROUTINE
END

SUBROUTINE MODIFY(MODIFYTITLE$,MODIFYTARGET$)
    PRINT MODIFYTITLE$;MODIFYTARGET$;
    FOR MODIFYCOUNT=1 TO LEN(MODIFYTARGET$)...
&       UNTIL MODIFYTARGET$[MODIFYCOUNT]=0 DO PRINT BACKSPACE$;
    INPUT '' COMMAND$
    IF COMMAND$="" THEN RETURN SUBROUTINE
    MODIFYTARGET$=COMMAND$
    RETURN SUBROUTINE
END

SUBROUTINE TRUNCATEBLANKS(STRINGTOBETRUNCATED$)
    FOR STRINGTOBETRUNCATEDINDEX=LEN(STRINGTOBETRUNCATED$) TO 1 STEP -1 ...
&       UNTIL STRINGTOBETRUNCATED$(STRINGTOBETRUNCATEDINDEX)<>:20
    NEXT STRINGTOBETRUNCATEDINDEX
    LET LEN(STRINGTOBETRUNCATED$)=STRINGTOBETRUNCATEDINDEX
    RETURN SUBROUTINE
END

BEGIN: PRINT "PHONEBOOK V1.0 (C) 1981 SOFTWARE DYNAMICS"
    LET COMMAND$="PHONEBOOK.DATA"
OPENFILE:
    IF ERROR WHEN
        OPEN #1,COMMAND$
    THEN
        IF ERR=1011
        THEN
            PRINT "CAN'T FIND ";COMMAND$
            PRINT "ENTER NAME OF PHONEBOOK FILE,"
            PRINT 'ENTER THE WORD "CREATE" TO CREATE ';COMMAND$
            INPUT "OR ENTER <CR> TO EXIT: " PERSONNAME$
            IF PERSONNAME$="" THEN EXIT
            ELSEIF UPPERCASE$(PERSONNAME$)="CREATE"
            THEN
                CREATE #1,COMMAND$
                KEYINIT(1,1,25,9) \ REM INITIALIZE "PERSON" INDEX
                KEYINIT(1,2,20,9) \ REM INITIALIZE "COMPANY" INDEX
            ELSE COMMAND$=PERSONNAME$\GOTO OPENFILE
        ELSE ERROR
    FI
PRINTMENU:
    PRINT CLEARSCREEN$;"COMMANDS: "
    PRINT "DUMP <FILE> -- DUMPS ENTIRE DATA BASE TO <FILE>"
    PRINT "LOAD <FILE> -- LOADS (OR ADDS) TO DATA BASE FROM <FILE>"
    PRINT "FIND <PERSON> -- FIND A PARTICULAR PERSON"
    PRINT "NEXT -- FIND NEXT PERSON"
    PRINT "COMPANY <COMPANYNAME> -- LOCATE A COMPANY"
    PRINT "NPIC -- FIND NEXT PERSON IN SAME COMPANY"
    PRINT "FIX <PERSON> -- CHANGE INFORMATION ABOUT A PERSON"
    PRINT "ADD <PERSON> -- ADD A PERSON TO THE PHONEBOOK"
    PRINT "DELETE <PERSON> -- DELETE A PERSON FROM THE PHONEBOOK"
    PRINT "EXIT -- LEAVE THIS PROGRAM"
    PRINT "HELP -- PRINTS THIS MENU"
    PRINT "<OTHER> -- IMPLIED FIND ON <OTHER>"
ASKCOMMAND:
    INPUT "OK> " COMMAND$
INSPECTCOMMAND:
    IF LEN(COMMAND$)=0 THEN ASKCOMMAND
    LET COMMAND$=UPPERCASE$(COMMAND$)
    IF FIND(COMMAND$,"DUMP ")=1 THEN DUMP
    IF FIND(COMMAND$,"LOAD ")=1 THEN LOAD
    IF FIND(COMMAND$,"FIND ")=1
    THEN PERSONKEY$=RIGHT$(COMMAND$,6)\GOTO FIND1
    IF COMMAND$="NEXT" THEN FINDNEXTPERSON
    IF FIND(COMMAND$,"COMPANY ")=1 THEN COMPANY
    IF COMMAND$="NPIC" THEN NPIC
    IF FIND(COMMAND$,"FIX ")=1 THEN FIX
    IF FIND(COMMAND$,"ADD ")=1 THEN ADD
    IF FIND(COMMAND$,"DELETE ")=1 THEN DELETE1
    IF COMMAND$="EXIT" THEN EXIT
    IF COMMAND$="HELP" THEN PRINTMENU
OTHER: REM TRY TO FIND THE PERSON
    LET PERSONKEY$=COMMAND$
FIND1:
    IF FINDANDDISPLAYPERSON THEN ASKCOMMAND ELSE INSPECTCOMMAND

DELETE1:
    LET PERSONKEY$=RIGHT$(COMMAND$,8)
    IF NOT FINDANDDISPLAYPERSON THEN INSPECTCOMMAND
    DELETERECORD
    GOTO ASKCOMMAND

ADD: REM ADD A NEW PERSON
    LET PERSONNAME$=RIGHT$(COMMAND$,5)
    IF ERROR WHEN
       PERSONRECORD=KEY(1,1,PERSONNAME$)
    THEN
        REM THAT NAME ALREADY EXISTS!
        IF ERR=1076
        THEN
            READPERSONRECORD
            PRINT "THAT NAME IS A DUPLICATE OF: "
            PRINTPERSONRECORD(0)
            INPUT 'ENTER COMMAND (<CR> MEANS "ADD ANYWAY")' COMMAND$
            IF COMMAND$<>"" THEN INSPECTCOMMAND
       FI
    FI
    INPUT "TITLE:         " PERSONTITLE$
    INPUT "COMPANY:       " PERSONCOMPANY$
    INPUT "STREET/SUITE:  " PERSONSTREET$
    INPUT "CITY:          " PERSONCITY$
    INPUT "STATE/COUNTRY: " PERSONSTATECOUNTRY$
    INPUT "ZIP:           " PERSONZIP$
    INPUT "PHONE NUMBER:  " PERSONPHONE$
    ADDRECORD
    GOTO ASKCOMMAND

FIX: LET PERSONKEY$=RIGHT$(COMMAND$,5)
    IF NOT FINDANDDISPLAYPERSON THEN INSPECTCOMMAND
    PRINT CLEARSCREEN$;
    DELETERECORD
    PRINT "TYPE <CR> TO LEAVE OLD VALUE ALONE"
    MODIFY("NAME:          ",PERSONNAME$)
    MODIFY("TITLE:         ",PERSONTITLE$)
    MODIFY("COMPANY:       ",PERSONCOMPANY$)
    MODIFY("STREET/SUITE:  ",PERSONSTREET$)
    MODIFY("CITY:          ",PERSONCITY$)
    MODIFY("STATE/COUNTRY: ",PERSONSTATECOUNTRY$)
    MODIFY("ZIP:           ",PERSONZIP$)
    MODIFY("PHONE NUMBER:  ",PERSONPHONE$)
    ADDRECORD
    GOTO ASKCOMMAND

FINDNEXTPERSON:
    IF PERSONRECORD=0
    THEN PRINT "NOBODY SELECTED, CAN'T"\GOTO ASKCOMMAND
    IF PERSONNAMESAMELINK<>0
    THEN
        REM MORE THAN ONE GUY WITH SAME NAME
        PERSONRECORD=PERSONNAMESAMELINK
    ELSE
        IF ERROR WHEN
           PERSONRECORD=KEYNEXT(1,1,PERSONKEY$)
        THEN IF ERR=1001
             THEN PERSONRECORD=0\PRINT "CAN'T"\GOTO ASKCOMMAND
             ELSE ERROR
    FI
    PRINT CLEARSCREEN$;"PERHAPS YOU MEANT: "
    PRINT
    READPERSONRECORD
    PRINTPERSONRECORD(0)
    INPUT 'ENTER "YES", "NO", <CR> FOR "NEXT" OR COMMAND: ' COMMAND$
    IF LEN(COMMAND$)=0 THEN FINDNEXTPERSON
    ELSEIF UPPERCASE$(COMMAND$)="YES" THEN ASKCOMMAND
    ELSEIF UPPERCASE$(COMMAND$)="NO" THEN ASKCOMMAND
    ELSE INSPECTCOMMAND

NPIC:
    REM FIND NEXT PERSON WITHIN COMPANY
    IF PERSONRECORD=0
    THEN PRINT "NO COMPANY SELECTED"\GOTO ASKCOMMAND
    IF PERSONCOMPANYSAMELINK<>0
    THEN
        REM MORE THAN ONE GUY AT SAME COMPANY
        PERSONRECORD=PERSONCOMPANYSAMELINK
        GOTO COMPANYDISPLAY
    ELSE PRINT "NO MORE PEOPLE THERE..."\GOTO ASKCOMMAND

COMPANY:
    LET PERSONKEY$=RIGHT$(COMMAND$,9)
    IF ERROR WHEN
       PERSONRECORD=KEY(1,2,PERSONKEY$)
    THEN IF ERR=1075 THEN NOSUCHCOMPANY ELSE ERROR
COMPANYDISPLAY: PRINT CLEARSCREEN$; "PERHAPS YOU MEANT: "
    PRINT
    PERSONKEY$=PERSONNAME$ \ REM IN CASE "NEXT" IS INVOKED
    READPERSONRECORD
    PRINTPERSONRECORD(0)
    INPUT 'ENTER "YES","NO",<CR> FOR "NPIC" OR COMMAND: ' COMMAND$
    IF LEN(COMMAND$)=0 THEN NPIC
    ELSEIF UPPERCASE$(COMMAND$)="YES" THEN ASKCOMMAND
    ELSEIF UPPERCASE$(COMMAND$)="NO" THEN ASKCOMMAND
    ELSE INSPECTCOMMAND

NOSUCHCOMPANY: REM CAN'T FIND THE COMPANY DESIRED, TRY KEYNEXT
    PRINT CLEARSCREEN$;"CAN'T FIND COMPANY: ";PERSONKEY$
NEXTCOMPANY: REM TRY FOR NEXT COMPANY
    IF ERROR WHEN
        PERSONRECORD=KEYNEXT(1,2,PERSONKEY$)
    THEN IF ERR=1001
         THEN
             PRINT "CAN'T FIND SELECTED COMPANY."
             PERSONRECORD=0\GOTO ASKCOMMAND
         ELSE ERROR
    READPERSONRECORD
    PRINT "PERHAPS YOU MEANT: ";PERSONCOMPANY$
    INPUT 'ENTER "YES" OR "NO";<CR> MEANS "NEXT" ' COMMAND$
    IF LEN(COMMAND$)=0 THEN NEXTCOMPANY
    ELSEIF UPPERCASE$(COMMAND$)="YES" THEN COMPANYDISPLAY
    ELSEIF UPPERCASE$(COMMAND$)="NO"
        THEN
            PERSONRECORD=0
            GOTO ASKCOMMAND
    ELSE PERSONRECORD=0\GOTO INSPECTCOMMAND

LOAD: REM LOAD CONTENTS OF SEQUENTIAL FILE INTO PHONEBOOK
    LET COMMAND$=RIGHT$(COMMAND$,6)
    OPEN #2,COMMAND$
    PRINT "LOADING ";COMMAND$
LOADLOOP:
    INPUT #2,PERSONNAME$
    IF EOF(2) THEN CLOSE #2\GOTO ASKCOMMAND
    IF PERSONNAME$="" THEN LOADLOOP
    TRUNCATEBLANKS(PERSONNAME$)
    INPUT #2,PERSONTITLE$
    TRUNCATEBLANKS(PERSONTITLE$)
    INPUT #2,PERSONCOMPANY$
    TRUNCATEBLANKS(PERSONCOMPANY$)
    INPUT #2,PERSONSTREET$
    TRUNCATEBLANKS(PERSONSTREET$)
    INPUT #2,PERSONCITY$
    TRUNCATEBLANKS(PERSONCITY$)
    INPUT #2,PERSONSTATECOUNTRY$
    TRUNCATEBLANKS(PERSONSTATECOUNTRY$)
    INPUT #2,PERSONZIP$
    TRUNCATEBLANKS(PERSONZIP$)
    INPUT #2,PERSONPHONE$
    TRUNCATEBLANKS(PERSONPHONE$)
    PRINT PERSONNAME$
    ADDRECORD
    GOTO LOADLOOP

DUMP: REM DUMP PHONE NUMBER FILE ALPHABETICALLY BY PERSON
    LET COMMAND$=RIGHT$(COMMAND$,6)
    CREATE #2,COMMAND$
    PRINT "DUMPING DATABASE..."
    LET PERSONKEY$=""
    PERSONNAMESAMELINK=0
DUMPNEXTPERSONLOOP:
    IF PERSONNAMESAMELINK<>0
    THEN
        REM MORE THAN ONE GUY WITH THE SAME NAME
        PERSONRECORD=PERSONNAMESAMELINK
    ELSE
        IF ERROR WHEN
            PERSONRECORD=KEYNEXT(1,1,PERSONKEY$)
        THEN IF ERR=1001
             THEN CLOSE #2\GOTO ASKCOMMAND
             ELSE ERROR
    FI
    READPERSONRECORD
    PRINTPERSONRECORD(2)
    GOTO DUMPNEXTPERSONLOOP

END
