%%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 \>> \>> \>> \>>