%%HP: T(3)A(R)F(.);
\<< CLEAR { } { } { }
0 0 \-> PHNAMES
PHNUMBERS ADDRESSES
PHSIZE FLAGS
  \<<
    \<< CLEAR 0 0 0 {
} 0 \-> SRCHNAME DONE
MATCHNUM MATCHLIST
MATCHINDEX
      \<< { { "Next"
        \<< CONT
        \>> } {
"Prev"
        \<< \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM-1'
EVAL CONT
ELSE X CONT
END
              END '
X==2'
              THEN
MATCHNUM CONT
              END '
X-2' EVAL CONT
            END
          \>>
        \>> } { } {
"Addr"
        \<< 6 SF \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM'
EVAL CONT
ELSE X CONT
END
              END '
X-1' EVAL CONT
            END
          \>>
        \>> } { } {
"Exit"
        \<< 1 'DONE'
STO CONT
        \>> } } { {
"Next"
        \<< CONT
        \>> } {
"Prev"
        \<< \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM-1'
EVAL CONT
ELSE X CONT
END
              END '
X==2'
              THEN
MATCHNUM CONT
              END '
X-2' EVAL CONT
            END
          \>>
        \>> } { } {
"Num"
        \<< 6 CF \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM'
EVAL CONT
ELSE X CONT
END
              END '
X-1' EVAL CONT
            END
          \>>
        \>> } { } {
"Exit"
        \<< 1 'DONE'
STO CONT
        \>> } } { {
"Next"
        \<< CONT
        \>> } {
"Prev"
        \<< \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM-1'
EVAL CONT
ELSE X CONT
END
              END '
X==2'
              THEN
MATCHNUM CONT
              END '
X-2' EVAL CONT
            END
          \>>
        \>> } {
"Pick"
        \<<
          IF DUP 1
==
          THEN DROP
MATCHNUM
          ELSE 1 -
          END GET 1
'DONE' STO 4 CF
CONT
        \>> } {
"Addr"
        \<< 6 SF \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM'
EVAL CONT
ELSE X CONT
END
              END '
X-1' EVAL CONT
            END
          \>>
        \>> } { } {
"Exit"
        \<< 1 'DONE'
STO 1 CF 2 SF CONT
        \>> } } { {
"Next"
        \<< CONT
        \>> } {
"Prev"
        \<< \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM-1'
EVAL CONT
ELSE X CONT
END
              END '
X==2'
              THEN
MATCHNUM CONT
              END '
X-2' EVAL CONT
            END
          \>>
        \>> } {
"Pick"
        \<<
          IF DUP 1
==
          THEN DROP
MATCHNUM
          ELSE 1 -
          END GET 1
'DONE' STO 4 CF
CONT
        \>> } { "Num"
        \<< 6 CF \-> X
          \<<
            CASE 'X
==1'
              THEN
IF 'MATCHNUM>1'
THEN 'MATCHNUM'
EVAL CONT
ELSE X CONT
END
              END '
X-1' EVAL CONT
            END
          \>>
        \>> } { } {
"Exit"
        \<< 1 'DONE'
STO 1 CF 2 SF CONT
        \>> } } \->
MENADR MENNUM
MENPICKADR
MENPICKNUM
        \<< { } TMENU
"Enter name..." {
":Name:" \Ga } INPUT
          IF DUP
SIZE 6 \<=
          THEN 1 SF
2 SF 4 CF
          ELSE DUP
SIZE 7 SWAP SUB
'SRCHNAME' STO
PHNAMES OBJ\->
            IF
SRCHNAME "*" SAME
            THEN 3
SF
            END 1
SWAP
            FOR I
SRCHNAME
              IF
POS 3 FS? OR
              THEN
'MATCHNUM' INCR
DROP 'PHSIZE-I+1'
EVAL 'MATCHLIST'
STO+
              END
            NEXT 3
CF
            IF
MATCHNUM 0 \=/
            THEN 1
SF 2 CF MATCHLIST 1
              DO
GETI 'MATCHINDEX'
STO DUP
IF 1 ==
THEN MATCHNUM
ELSE DUP 1 -
END CLLCD "Match "
SWAP + " of " +
MATCHNUM + 1 DISP
":Name:" PHNAMES
MATCHINDEX GET +
"
" +
IF 6 FC?
THEN ":Number:"
PHNUMBERS
MATCHINDEX GET + +
4 DISP
ELSE "
" ADDRESSES
MATCHINDEX GET + +
3 DISP
END 3 FREEZE
IF 4 FC?
THEN
  IF 6 FC?
  THEN MENADR
  ELSE MENNUM
  END
ELSE
  IF 6 FC?
  THEN MENPICKADR
  ELSE MENPICKNUM
  END
END TMENU HALT
              UNTIL
DONE
              END
            ELSE
"The specified name
was not found"
1 CF 2 CF CLLCD
1200 .1 BEEP 2 DISP
1 WAIT
            END
          END
        \>>
      \>>
    \>> \-> PHSEARCH
    \<<
      \<< \-> P1
        \<<
          IF P1
"INT" SAME
          THEN
"Do you want to add
to the list, modify
an existing entry,
or delete an entry?"
CLLCD 1 DISP 3
FREEZE { { "Add"
            \<< "ADD"
CONT
            \>> } {
"Mdfy"
            \<<
"MODIFY" 5 CF CONT
            \>> } {
"Del"
            \<<
"MODIFY" 5 SF CONT
            \>> } { }
{ } { "EXIT"
            \<< 2 SF
CONT
            \>> } }
TMENU HALT
          ELSE
CLEAR "ADD"
          END
          IF 2 FC?C
          THEN { }
TMENU 0 0 0 0 \-> X
TEMP LEN LEN2 DONE
            \<<
              CASE
X "ADD" SAME
THEN
  DO
"Enter name..." {
":Name:" \Ga } INPUT
DUP SIZE 'LEN' STO
'TEMP' STO
    IF LEN 6 >
    THEN
"Enter number..."
TEMP EVAL
"
:Number:" + { 2 9
} \Ga 3 \->LIST INPUT
DUP DUP SIZE 'LEN2'
STO 7 LEN SUB
PHNAMES + 'PHNAMES'
STO LEN 10 + LEN2
SUB PHNUMBERS +
'PHNUMBERS' STO
PHNAMES SIZE
'PHSIZE' STO
"Enter address..."
TEMP EVAL "
:Addr:"
+ { 2 7 } \Ga 3 \->LIST
INPUT DUP SIZE
'LEN2' STO LEN 8 +
LEN2 SUB ADDRESSES
+ 'ADDRESSES' STO
    ELSE 1 'DONE'
STO
    END
  UNTIL DONE
  END
END X "MODIFY" SAME
THEN CLEAR 0 0 "" \->
INDEX DONE
EDITSTRING
  \<<
    DO 2 CF 4 SF
PHSEARCH EVAL
    UNTIL 1 FS?C
    END 4 CF
    IF 2 FC?C
    THEN 'INDEX'
STO
      IF 5 FC?C
      THEN
        DO INDEX
DUP PHNAMES SWAP
GET SWAP 6 FC?
'PHNUMBERS'
'ADDRESSES' IFTE
SWAP GET 6 FC?
":Number:" ":Addr:"
IFTE SWAP + SWAP
":Name:" SWAP + "
"
+ SWAP +
"Edit entry..."
SWAP 0 2 \->LIST { }
TMENU INPUT DUP
'EDITSTRING' STO
          IF DUP
":Name:" POS 1 ==
SWAP DUP 6 FC?
":Number:" ":Addr:"
IFTE POS DUP 'TEMP'
STO ROT AND
          THEN DUP
7 TEMP 2 - SUB 1
\->LIST PHNAMES SWAP
INDEX SWAP REPL
'PHNAMES' STO TEMP
6 FC? 8 6 IFTE +
EDITSTRING SIZE SUB
1 \->LIST 6 FC?
'PHNUMBERS'
'ADDRESSES' IFTE
SWAP INDEX SWAP
REPL 6 FC?
"'PHNUMBERS'"
"'ADDRESSES'" IFTE
OBJ\-> STO 1 'DONE'
STO CLEAR
          ELSE
CLLCD 1200 .1 BEEP
"Invalid Entry" 2
DISP 2 WAIT
          END
        UNTIL DONE
        END
      ELSE CLEAR
INDEX DUP PHNAMES
SWAP GET SWAP
PHNUMBERS SWAP GET
":Number:" SWAP +
SWAP ":Name:" SWAP
+ "
" + SWAP +
CLLCD
"Delete entry?" 1
DISP 4 DISP 1200 .1
BEEP 3 FREEZE { {
"Yes"
        \<< 1 CONT
        \>> } { } { }
{ } { } { "No"
        \<< 0 CONT
        \>> } } TMENU
HALT
        IF
        THEN
PHNAMES OBJ\-> DROP
PHSIZE INDEX 1 - -
ROLL DROP PHSIZE 1
- \->LIST 'PHNAMES'
STO PHNUMBERS OBJ\->
DROP PHSIZE INDEX 1
- - ROLL DROP
PHSIZE 1 - \->LIST
'PHNUMBERS' STO
ADDRESSES OBJ\-> DROP
PHSIZE INDEX 1 - -
ROLL DROP 'PHSIZE'
DECR \->LIST
'ADDRESSES' STO
        END
      END
    ELSE 5 CF
    END
  \>>
END
              END
            \>>
          END
ADDRESSES PHNUMBERS
PHNAMES 3 \->LIST
'PHDAT' STO
        \>>
      \>> \-> PHEDIT
      \<< 64 STWS
RCLF DUP 'FLAGS'
STO 2 { # 0h } REPL
STOF STD
        IF 'PHDAT'
VTYPE -1 ==
        THEN CLLCD
"Phone Database does"
2 DISP
"not exist.  Do you"
3 DISP
"want to create it?"
4 DISP 3 FREEZE { {
"Yes"
          \<< 1 CONT
          \>> } { } {
} { } { } { "No"
          \<< 0 CONT
          \>> } }
TMENU HALT
          IF
          THEN { }
DUP 'PHNAMES' STO
'PHNUMBERS' STO
"NEW" PHEDIT EVAL
          ELSE
"You must create a
phone database before
any further action can
be taken."
2 DISP CLEAR 2 MENU
1200 .1 BEEP 3
FREEZE 3 WAIT 0
DOERR
          END
        END 0 \->
DONE
        \<< { } DUP
'PHNAMES' STO
'PHNUMBERS' STO
CLEAR PHDAT EVAL
          IF DEPTH
2 ==
          THEN
CLLCD
"Reformating PHDAT.
Please wait..."
2 DISP 1 WAIT DUP {
} SWAP SIZE 1 SWAP
            FOR I
"" +
            NEXT 3
ROLLD 3 \->LIST
'PHDAT' STO CLEAR
PHDAT EVAL
          END
'PHNAMES' STO
'PHNUMBERS' STO
'ADDRESSES' STO
PHNAMES SIZE
'PHSIZE' STO
          DO
"Do you want to
search the list or
edit the list?"
CLLCD 1 DISP 3
FREEZE { { "SRCH"
            \<<
              DO
PHSEARCH EVAL
              UNTIL
1 FS?C
              END
CONT
            \>> } {
"EDIT"
            \<< "INT"
PHEDIT EVAL CONT
            \>> } { }
{ } { } { "Exit"
            \<< 1
'DONE' STO CONT
            \>> } }
TMENU HALT
          UNTIL
DONE
          END
        \>> CLEAR 2
MENU FLAGS STOF
      \>>
    \>>
  \>>
\>>
