rem 12/13/86 common used for terminal characteristics
common today$,warm$,trmtyp$,clear$,bell$,clreol$
common escape$,poscmd$,posofs%,rowcol$
rem repaired damaged module
rem - program FONEBOOK.BAS
rem - quick reference phone number listing
rem - copyright 1982, by Peter C. Hawxhurst
rem - revised 12/22/1982
rem - revised for KAYPRO 03/02/84
rem - variable tabulation ************************
rem   after$   = name after which to add entry
rem   command% = assigned value for input command
rem   cmnd$    = user command input
rem   count%   = page counter
rem   nam$     = file read of name entry
rem   num$     = file read of phone number
rem   name$    = individual's names
rem   number$  = individual's phone number
rem   ren%     = file rename value
rem   q$       = recovery input
rem   s1       = end switch
rem   s2       = headings switch
rem   s3       = successful find switch
rem   s4       = end of file switch
rem   unam$    = all uppercase name$ for comparison
rem - program structure **************************
%chain 100,10000,50,500
gosub 100 : rem - housekeeping
10 if s1=1 then 20
gosub 200 : rem - process
go to 10
20 print clear$
chain "HANDYSYS.COM"
100 rem - housekeeping subroutine ****************
dim namex$(12)
dim numberx$(12)
s2=1
if end #1 then 110
open "FONEBOOK.DAT" as 1
goto 120
110 create "FONEBOOK.DAT" as 1
print #1;"MHSCF RCP/M","203-665-1100"
120 close 1
return
200 rem - process subroutine *********************
if s2=0 then 210
gosub 300 : rem - screen
gosub 400 : rem - output
s2=0
210 gosub 500 : rem - command
if s1=1 then 220
on command% gosub 600,700,800,900
220 return
300 rem - screen subroutine **********************
print clear$
print tab(23);"FONEBOOK"
print tab(7);"Quick Reference Phone Number Listing"
print
for i%=1 to 12
    print tab(25);"|"
next i%
print:print
for i%=1 to 49:print "-";:next i%:print
print "(A)dd (C)ontinue (D)elete (E)xit (R)estart"
return
400 rem - output subroutine **********************
if s2<>0 then 410
ypos%=5:xpos%=1:gosub 15000:rem - cursor
for i%=1 to 12
    print "                        "
    ypos%=ypos%+1:gosub 15000
next i%
ypos%=5:xpos%=26:gosub 15000
for i%=1 to 12
    print "                        "
    ypos%=ypos%+1:gosub 15000
next i%
if s5=0 then 410
return
410 open "FONEBOOK.DAT" as 1
415 ypos%=5:xpos%=1
420 if end #1 then 430
read #1;name$,number$
gosub 15000 : rem - cursor
print name$;
zpos%=xpos%
xpos%=xpos%+24-len(number$):gosub 15000
print number$
ypos%=ypos%+1
xpos%=zpos%
if ypos%=17 and xpos%=26 then 430
if ypos%=17 then xpos%=26
if ypos%=17 then ypos%=5
rem here's where the bad sectors started
go to 420
430 close 1
count%=count%+1
return
500 rem input subroutine *********************
s1=0
510 ypos%=20:xpos%=44:gosub 15000: rem - cursor
print bell$;
print "> ";
while not constat%:wend:cmnd$=ucase$(chr$(conchar%))
if cmnd$="" then gosub 14000:goto 510
command%=0
if cmnd$="E" then s1=1:return
if cmnd$="A" then command%=1
if cmnd$="C" then command%=2
if cmnd$="D" then command%=3
if cmnd$="R" then command%=4
if command%=0 then 510
return
600 rem add subroutine **********************
gosub 14000: rem - rubout
s3=0
610 ypos%=21:xpos%=1:gosub 15000
input "Name to add after >";line after$
if after$="" then print bell$;
if after$="" then 610
after$=ucase$(after$)
gosub 14000:gosub 15000
print "Searching..."
open "FONEBOOK.DAT" as 1
create "TRANS" as 2
620 if end #1 then 660
read #1;nam$,num$
unam$=ucase$(nam$)
if unam$=after$ then 630
print #2;nam$,num$
goto 620
630 print #2;nam$,num$
640 gosub 14000:gosub 15000
input "Name to be added >";line name$
if name$="" then print bell$;
if name$="" then 640
if len(name$)<12 then 650
gosub 14000:print bell$;:
input "Name too long - press RETURN >";line q$
goto 640
650 gosub 14000:gosub 15000
print name$;"'s";
input " phone number >";line number$
if number$="" then print bell$;
if number$="" then 650
print #2;name$,number$
s3=1
goto 620
660 if s3>0 then 670
gosub 14000:gosub 15000
print bell$;:
print after$;
input " not found - press RETURN >";line q$
670 gosub 14000
delete 1
close 2
ren%=rename("FONEBOOK.DAT","TRANS")
count%=count%-1
gosub 700 : rem - continue
return
700 rem - continue subroutine ********************
s4=0
gosub 14000 : rem - rubout
open "FONEBOOK.DAT" as 1
if count%=0 then 725
for i%=1 to count%*24
    if end #1 then 710
    read #1;name$,number$
    goto 720
    710 close 1
    i%=count%*24
    s4=1
720 next i%
if s4>0 then 730
725 s5=1:gosub 400 : rem - output
s5=0
gosub 415 : rem - output
730 return
800 rem - delete subroutine **********************
s3=0
810 gosub 14000 : rem - rubout
ypos%=21:xpos%=1:gosub 15000:rem - cursor
input "Name to delete >";line name$
if name$="" then print bell$;
if name$="" then 810
name$=ucase$(name$)
open "FONEBOOK.DAT" as 1
create "TRANS" as 2
820 if end #1 then 830
read #1;nam$,num$
unam$=ucase$(nam$)
if unam$=name$ then s3=1
if unam$=name$ then 820
print #2;nam$,num$
goto 820
830 if s3>0 then 840
gosub 14000 : rem - rubout
print bell$;:
input "Name not found - press RETURN >";line q$
840 delete 1
close 2
ren%=rename("FONEBOOK.DAT","TRANS")
gosub 14000 : rem - rubout
count%=count%-1
gosub 700 : rem - continue
return
900 rem - restart subroutine *********************
count%=0
gosub 14000 : rem - rubout
gosub 400 : rem - output
return
14000 rem - rubout subroutine ********************
14010 gosub 15000
14020 print clreol$;
14030 return
15000 rem - cursor subroutine ********************
15020 rem - variables to check
15030 rem   xpos% = horizontal cursor position (1-52, L to R)
15040 rem   ypos% = vertical cursor position (1-24, T to B)
15060 if rowcol$=chr$(01) then 15090
15070 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1);
15080 go to 15100
15090 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1);
15100 return