Tutorial 040 A Novel Phonebook Program

Tutorial 041 A Novel Phonebook Program

This program makes use of the techniques explained in Tutorials 34 to 40 and combines them to give an unusual but very useful alphabetical index for all words used in a phonebook text file, which enables phone numbers to be obtained by first name, surname or by other added words.

Thus a record such as : William Cleaver (Butcher) 858585, would be automatically indexed alphabetically under Butcher, Cleaver and William.

I recently decided to sort out our battered , thirty-year-old, Telephone Index Book, which had numerous deletions, corrections and appendices. One doesn't want to have turn on the computer especially to look up a telephone number so I typed the entries into two separate Word files ("people" and "services") alphabetically by Surname in the format shown above and printed out a copy for each of the telephones in the house. There were four A4 pages for the "names" and one for the "services". Much easier to use than the battered old index book with its cover hanging off!

To make more use of the information and to be able to index it more thoroughly, I first saved the data from the Word files as text files for examination by the (slightly modified ) program from Tutorial 34 (Virgil's Vocab). This latter ignores the numbers themselves and sorts all the other words into alphabetical order. By tagging each word with its "record number" its then easy to retrieve the required record containing the full name and telephone number.

I'm wouldn't be fair to publish all my phone contacts(!) so here is a smaller fictitious equivalent of a suitable text file which you can Select/copy/paste into Notepad and save (in the same directory as the program for easiest loading) in order to try out the program...

Herbertina Broadcats 939393
Desmond Cartwrong-Bilgewater 121212
Henry Centiheit 292929
Francis Dunin 919191
Catherine Emblemish 191919
Ziggi Florbin 181818
Xeno Googlebot 717171
Wilfred Haagbod 171717.... 676767
Violet Ioblast 161616
Ursula Jumbles 151515
Telula Kickback 141414
Sergei Lobit 313131
Rowena Moreless 131313
Quentin Nirdlewright 989898
Patricia Orother 898989
Orlando Pinchback 878787
Norris Quilt 787878
Miranda Ripieno 767676
Lucinda Supergras 676767
Kevin Tigglethwaite 656565
Janet Ululat 565656
Ian Van-der-Crunch 545454
Gillian Wiffledown 454545
Ethelred Xylemtwistle 343434
Bertha Yodle-Bootstrap 242424
Alvin Ziggenbaum 323232

ABCD-Garage Garage 393939
Bert Renticle (Plumber) 494949
Makeurite (Doctor) 949494
NatEast (Bank) 353535
Frybynight (Fish-and-Chips) 393939

Which gives a single screen of output :

Press <SPACE> to choose a phone directory

ABCD-Garage(27) Alvin(1) Bank(30) Bert(28) Bertha(2) Broadcats(26)
Cartwrong-Bilgewater(22) Catherine(23) Centiheit(25) Desmond(22) Doctor(29)
Dunin(24) Emblemish(23) Ethelred(3) Fish-and-Chips(31) Florbin(21) Francis(24)
Frybynight(31) Garage(27) Gillian(4) Googlebot(20) Haagbod(19) Henry(25)
Herbertina(26) Ian(5) Ioblast(18) Janet(6) Jumbles(17) Kevin(7) Kickback(16)
Lobit(15) Lucinda(8) Makeurite(29) Miranda(9) Moreless(14) NatEast(30)
Nirdlewright(13) Norris(10) Orlando(11) Orother(12) Patricia(12) Pinchback(11)
Plumber(28) Quentin(13) Quilt(10) Renticle(28) Ripieno(9) Rowena(14) Sergei(15)
Supergras(8) Telula(16) Tigglethwaite(7) Ululat(6) Ursula(17) Van-der-Crunch(5)
Violet(18) Wiffledown(4) Wilfred(19) Xeno(20) Xylemtwistle(3)
Yodle-Bootstrap(2) Ziggenbaum(1) Ziggi(21)

Input the record number to see the record : 31

Frybynight (Fish-and-Chips) 393939

Press <SPACE> to find another phone number...

Here you can see that although I could not remember the name of the chip shop, the fish-and-chip entry enabled me to locate the entry quite easily in the alphabetic list of all the words present. First names are as easy to find as surnames in this novel directory!

N.B. I've used hyphens to avoid some phrases being split, as we allowed for hyphens to be retained in the Virgil's Vocab program. Other examples are ABCD-Garage ( remember the Association of Bent Car Delears?), and Van-der-Cruch, which may not have the hyphens in practice...

Listing :

      MODE8
      REM : Converts a phone list text file
      REM : whose lines are in the form...
      REM : <first name> <space> < surname > <space> <phone number(s)>
      REM : Richard Weston, 10th July 2003
      MODE 8
      rec=1
      t=1000 :REM word capacity
      DIM word$(t),rank(t)
      COLOUR1
      PRINT'" Press <SPACE> to choose a phone directory"'
      G=GET
      OFF
      :
      DIM of% 75, ff% 18, fn% 255
      !of% = 76
      of%!4 = @hwnd%
      of%!12 = ff%
      of%!28 = fn%
      of%!32 = 256
      of%!52 = 6
      $ff% = "Text Files"+CHR$0+"*.txt"+CHR$0+CHR$0
      :
      SYS "GetOpenFileName", of% TO result%
      IF result% filename$ = FNnulterm$(fn%)
      COLOUR2
      :
      fnum=OPENIN filename$
      IF fnum=0 THEN PRINT "No ";filename$;" data": END
      :
      n=0
      COLOUR7
      REPEAT
        finished=FALSE
        word$=""
        REPEAT
          temp=BGET#fnum :REM Read byte
          PROCprocess
        UNTIL finished
        IF LEN(word$)>1 THEN
          word$=word$+"(" + STR$(rec) + ")"
          n+=1
          word$(n)=word$
        ENDIF
      UNTIL EOF#fnum
      CLOSE#fnum
      :
      newword=0
      COLOUR7
      :
      PROCsort
      :
      COLOUR11
      REM PRINT'"Press <SHIFT> to scroll down"'
      COLOUR7
      REPEAT
        FOR i=t-1 TO 1 STEP -1
          pos=POS:L=LEN(word$(rank(i)))
          :
          PROCcheck_already_met
          :
          IF alreadymet=FALSE THEN
            newword+=1
            IF L < (80-pos) THEN
              PRINTword$(rank(i))+" ";
            ELSE
              IF VPOS>27 THEN
                COLOUR1:PRINT:PRINT"Press <SPACE>":G=GET:CLS:COLOUR7
                *FX21,0
              ENDIF

              PRINT'word$(rank(i))+" ";
            ENDIF
          ENDIF
        NEXT i
        PRINT'
        COLOUR9
        ON:COLOUR6
        INPUT'"Input the record number to see the record : "r
        PROCfindrecord
        COLOUR2
        PRINT'" Press <SPACE> to find another phone number..."
        COLOUR7
        G=GET
        CLS
      UNTIL FALSE
      END
      :
      DEF FNnulterm$(P%)
      LOCAL A$
      WHILE ?P% <> 0
        A$ += CHR$?P%
        P% += 1
      ENDWHILE
      = A$
      :
      DEF PROCprocess
      IF temp>64 AND temp<91 THEN
        word$+=CHR$(temp)
      ENDIF
      :
      IF temp>96 AND temp<123 THEN
        word$+=CHR$(temp)
      ENDIF
      :
      IF temp=45 THEN word$+=CHR$(temp)
      REM^ hyphen
      IF temp=10 THEN
        finished=TRUE
        rec+=1
      ENDIF
      IF temp>31 AND temp<65 THEN finished=TRUE
      IF temp=45 THEN finished=FALSE
      IF temp>90 AND temp<97 THEN finished=TRUE
      IF temp>122 THEN finished=TRUE
      ENDPROC
      :
      :
      DEF PROCcheck_already_met
      alreadymet=FALSE
      IF word$(rank(i))=word$(rank(i+1)) THEN
        alreadymet=TRUE
      ENDIF
      ENDPROC
      :
      DEF PROCsort:LOCAL I
      FOR I = 1 TO t
        rank(I)=I
      NEXT
      PROCquicksort(1,t)
      ENDPROC
      :
      DEF PROCquicksort(low,high)
      LOCAL left,right,it,dummy
      left=low:right=high
      it$=word$(rank((low+high)DIV 2))
      REPEAT
        IF word$(rank(left))>it$ THEN
          REPEAT left=left+1
          UNTIL word$(rank(left))<=it$
        ENDIF
        IF word$(rank(right))<it$ THEN
          REPEAT right=right-1
          UNTIL word$(rank(right))>=it$
        ENDIF
        IF left<=right THEN
          dummy=rank(left)
          rank(left)=rank(right)
          rank(right)=dummy
          left=left+1
          right=right-1
        ENDIF
      UNTIL left>right
      IF right>low THEN PROCquicksort(low,right)
      IF left<high THEN PROCquicksort(left,high)
      ENDPROC
      :
      DEF PROCfindrecord
      fnum=OPENIN filename$
      IF fnum=0 THEN PRINT "No ";filename$;" data": END
      rec=0
      REPEAT
        rec$=""
        REPEAT
          temp=BGET#fnum :REM Read byte
          rec$=rec$+CHR$(temp)
        UNTIL temp=10
        rec+=1
      UNTIL rec=r
      COLOUR7
      PRINT'TAB(3)rec$
      CLOSE#fnum
      ENDPROC

Annotated Listing :

      MODE8
      REM : Converts a phone list text file
      REM : whose lines are in the form...
      REM : <first name> <space> < surname > <space> <phone number(s)>
      REM : Richard Weston, 10th July 2003
      MODE 8
      rec=1 *** record number ***
      t=1000 : REM word capacity ***increase this if you have a big enough directory ***
      DIM word$(t),rank(t)
      COLOUR1
      PRINT'" Press <SPACE> to choose a phone directory"'
      G=GET
      OFF
      :
      DIM of% 75, ff% 18, fn% 255 *** Here it is again *** File loading routine *********
      !of% = 76
      of%!4 = @hwnd%
      of%!12 = ff%
      of%!28 = fn%
      of%!32 = 256
      of%!52 = 6
      $ff% = "Text Files"+CHR$0+"*.txt"+CHR$0+CHR$0
      :
      SYS "GetOpenFileName", of% TO result%
      IF result% filename$ = FNnulterm$(fn%)
      COLOUR7
      COLOUR2
      :
      fnum=OPENIN filename$
      IF fnum=0 THEN PRINT "No ";filename$;" data": END ************************** end
      :
      n=0 *** number of words ***
      COLOUR7
      REPEAT ******************** word identification - see earlier programs ***********
        finished=FALSE
        word$=""
        REPEAT
          temp=BGET#fnum :REM Read byte
          PROCprocess
        UNTIL finished
        IF LEN(word$)>1 THEN
          word$=word$+"(" + STR$(rec) + ")" **** here's where we add the record number tag to the word ***
          n+=1
          word$(n)=word$ **** store the word and tag away ready for sorting ****
        ENDIF
      UNTIL EOF#fnum
      CLOSE#fnum
      :
      newword=0
      COLOUR7
      :
      PROCsort ******************* as previously described ********************
      :
      COLOUR7
      REPEAT
        FOR i=t-1 TO 1 STEP -1
          pos=POS:L=LEN(word$(rank(i)))
          :
          PROCcheck_already_met
          :
          IF alreadymet=FALSE THEN
            newword+=1
            IF L < (80-pos) THEN
              PRINTword$(rank(i))+" ";
            ELSE
              IF VPOS>27 THEN ************ need to start a new line *************
                COLOUR1:PRINT:PRINT"Press <SPACE>":G=GET:CLS:COLOUR7 **** To get next screensworth ****
                *FX21,0 ********* flush the buffers to avoid multiple inputs ************
              ENDIF

              PRINT'word$(rank(i))+" ";
            ENDIF
          ENDIF
        NEXT i
        PRINT'
        COLOUR9
        ON:COLOUR6
        INPUT'"Input the record number to see the record : "r
        PROCfindrecord
        COLOUR2
        PRINT'" Press <SPACE> to find another phone number..."
        COLOUR7
        G=GET
        CLS
      UNTIL FALSE
      END
      :
      DEF FNnulterm$(P%)
      LOCAL A$
      WHILE ?P% <> 0
        A$ += CHR$?P%
        P% += 1
      ENDWHILE
      = A$
      :
      DEF PROCprocess *********************
      IF temp>64 AND temp<91 THEN
        word$+=CHR$(temp)
      ENDIF
      :
      IF temp>96 AND temp<123 THEN
        word$+=CHR$(temp)
      ENDIF
      :
      IF temp=45 THEN word$+=CHR$(temp)
      REM^ hyphen
      IF temp=10 THEN
        finished=TRUE
        rec+=1************** NEW! counts the number of records
      ENDIF
      IF temp>31 AND temp<65 THEN finished=TRUE
      IF temp=45 THEN finished=FALSE
      IF temp>90 AND temp<97 THEN finished=TRUE
      IF temp>122 THEN finished=TRUE
      ENDPROC
      :
      :
      DEF PROCcheck_already_met ********* unlikely to be needed here ***************
      alreadymet=FALSE
      IF word$(rank(i))=word$(rank(i+1)) THEN
        alreadymet=TRUE
      ENDIF
      ENDPROC
      :
      DEF PROCsort:LOCAL I
      FOR I = 1 TO t
        rank(I)=I
      NEXT
      PROCquicksort(1,t)
      ENDPROC
      :
      DEF PROCquicksort(low,high)
      LOCAL left,right,it,dummy
      left=low:right=high
      it$=word$(rank((low+high)DIV 2))
      REPEAT
        IF word$(rank(left))>it$ THEN
          REPEAT left=left+1
          UNTIL word$(rank(left))<=it$
        ENDIF
        IF word$(rank(right))<it$ THEN
          REPEAT right=right-1
          UNTIL word$(rank(right))>=it$
        ENDIF
        IF left<=right THEN
          dummy=rank(left)
          rank(left)=rank(right)
          rank(right)=dummy
          left=left+1
          right=right-1
        ENDIF
      UNTIL left>right
      IF right>low THEN PROCquicksort(low,right)
      IF left<high THEN PROCquicksort(left,high)
      ENDPROC
      :
      DEF PROCfindrecord ****************** NEW! re-reads the file to find the record requested
      fnum=OPENIN filename$
      IF fnum=0 THEN PRINT "No ";filename$;" data": END
      rec=0
      REPEAT
        rec$=""
        REPEAT
          temp=BGET#fnum :REM Read byte
          rec$=rec$+CHR$(temp)
        UNTIL temp=10
        rec+=1
      UNTIL rec=r ******************* GOT IT!
      COLOUR7
      PRINT'TAB(3)rec$ *************** now print it!!
      CLOSE#fnum
      ENDPROC

Next Tutorial

Richard Weston's Homepage