; Dial Your Match Segment
; Created on 02/04/89 by -DC-

 public return
 public no.car

 on nocar goto no.car
 un=0:mr=1:t=0
 edit(3)=79:info(5)=0
 open #1,"i1:dym.users"
 if not mark(1) position #1,80,0:input #1,nu:close:goto start
 close:create "i1:dym.users"
 open #1,"i1:dym.users":position #1,80,0:print #1,0:close
 nu=0:goto start

return
 on nocar goto no.car
 return

lower.case
 if len(i$)=1 ab$=i$:return
 ab$=left$(i$,1):for wy=2 to len(i$):wx=asc(mid$(i$,wy,1))
 if wx=32 ab$=ab$+" "+mid$(i$,wy+1,1):wy=wy+1:next:return
 if (wx<65) or (wx>96) ab$=ab$+chr$(wx):next:return
 ab$=ab$+chr$(wx+32):next:return

show.file
 setint(1):print \s$\:open #1,f$:if mark(1) close #1:return
showfl2
 copy (20) #1
 if eof(1) or key(1) setint(""):close #1:return
 print "Press [RETURN] ";:get i$:if i$=chr$(13) print " ";
 print chr$(8,16);chr$(32,16);chr$(8,16);
 if i$=" " setint(""):close #1:return
 setint(1):goto showfl2

no.car
 if un=0 link "a:logon.seg"
 open #1,"i1:dym.users":position #1,80,un
 print #1,na$,ag,d3$\date$,pa$,mr:close
 link "a:logon.seg"

start
 clock(2)=1200
 print sc$\"Connected to: "sn$" - Dial Your Match "date$" "time$
start1
 if (info(0)<>0) or (nu=0) goto start2
 input @0 \"Auto-Logon? "i$:if i$<>"Y" goto start2
 open #1,"i1:dym.users":position #1,80,1
 input #1,na$,ag,d3$\lc$,pa$,mr:close:un=1:goto found
start2
 print \"Enter your account code"
 input "or 'NEW' if you are a new user: "i$
 if i$="NEW" goto new.user
 if i$="OFF" link "a:logon.seg"
 gosub lower.case:nn$=ab$:echo="*"
 input "Enter your password: "p$:echo=""

 open #1,"i1:dym.users"
 for a=1 to nu:position #1,80,a:input #1,na$,ag,d3$\lc$,pa$,mr
 if (na$=nn$) and (pa$=p$) close:un=a:goto found
 next:close:if t<3 print \"Incorrect information, try again."
 t=t+1:if t<4 goto start1
 print \"Access denied":link "a:logon.seg"

new.user
 print \"Control-S Starts/Stops"\
 bo=0:copy "i1:new.user.info"
new1
 clear key
 input \"Enter 2-30 characters to be used as your name/account code: "i$
 a=len(i$)
 if (a<2) or (a>30) print \"Incorrect length, try again":goto new1
 gosub lower.case:na$=ab$
 if bo goto new2
 open #1,"i1:dym.users":for a=1 to nu:position #1,80,a
 input #1,a$,i$:if a$<>na$ next:close:goto new2
 a=nu:next:close
 print \"Sorry, name being used.  Use a different name.":goto new1
new2
 input "Enter 4-9 characters to be used as your password: "pa$
 a=len(pa$)
 if (a<4) or (a>9) print \"Incorrect length, try again":goto new2
new3
 input "What is your age? "ag
 if (ag<13) or (ag>65) print \"If this is true, please hang up now":goto new3
new4
 input "Where are you calling from? (City, ST): "i$
 if len(i$)>30 print \"Incorrect length, 30 characters max":goto new4
 gosub lower.case:d3$=ab$
new5
 print '
You can enter up to 1 line of 79 char/line to describe yourself.'
 input @3">"ab$:if len(ab$)>79 print \"Invalid length, try again":goto new5
 if bo goto newinfo

; Save New User

 open #1,"i1:dym.users":for a=1 to nu:position #1,80,a
 input #1,a$,i$:if a$<>"EMPTY" next:nu=nu+1:un=nu:goto save
 un=a:a=nu:next
save
 position #1,80,0:print #1,nu
 position #1,80,un:print #1,na$,ag,d3$\date$,pa$,mr:close
newinfo
 f$="i1:u."+str$(un):create f$:open #1,f$
 position #1,80,0:print #1,ab$
 print \"Now you must answer the following questions..."\
 open #2,"i1:questions":t=0:gf=0
read
 input #2,i$:if i$="*" goto save1
 if i$="%" close #1:close #2:goto found
 if i$="^" gf=1:print chr$(13):goto read
 print i$:goto read
save1
 input #2,a
save2
 if gf=0 print \"(Up to "a" responses total)"\"Answer: ";
 if gf=1 print "("a" characters max)"\">";
 if gf=0 input @1 i$:else input @3 i$
 print:if len(i$)>a print "Invalid entry, try again":goto save2
 t=t+1:position #1,80,t:print #1,i$
 goto read
 
found
 if bo return
found1
 home:print #3,o$;na$"   Age: "ag"   From: "d3$;n$:poke 34,1
 print \"Good day, "na$".  Welcome to "sn$" Dial Your Match!"
 print \"You are allowed 20 minutes on-line this call."
 f$="i1:dym.log":create f$:open #1,f$
 input #1,i$:if i$<>date$ close:kill f$:create f$:open #1,f$:print #1,date$
 append #1:print #1,na$,time$:close
 f$="i1:system.news":gosub show.file
 ready "i1:mail":if not msg(un) print \"Sorry, you have no E-mail.":goto main
 input @0 \"You have E-mail!  Read it now? "i$
 if i$="Y" gosub read.mail

main
 f$="i1:menu":gosub show.file
main1
 push main1
 print \date$" "time$" "30-(clock(1)/60)" mins left"
 input @0 "What next? "i$
 if i$="?" pop:goto main
 if i$="C" goto chat
 if i$="T" goto terminate
 if i$="W" goto who
 if i$="B" link "a:dym.seg2"
 if i$="S" goto send.mail
 if i$="R" goto read.mail
 if i$="M" goto match
 if i$="D" goto define
 if i$="P" goto setpass
 if (i$="*") and (info(5)) link "a:dym.seg3"
 if i$="*" goto remote
 print \"Invalid command":pop:goto main

remote
 echo="-":input @2 \"Remote password: "i$:echo=""
 if i$="MIKE" link "a:dym.seg3"
 return

terminate
 input @0 \"Terminate call? (Y/N): "i$
 if i$<>"Y" return
 print \"Goodbye...":modem(1):pop
 ready "i1:mail":kill #msg(un):update
 goto no.car

chat
 if pdl(0)=0 print \"SysOp is unavailable":return
 print \"Paging SysOp...";
 for a=1 to 250 step 5:tone (a,a,50)
 if peek(-16287)>127 a=250
 next:print "continue."
 poke 34,0:home:print #3,o$;na$"   Age: "ag"   From: "d3$"   CHAT!"n$
 poke 34,1:return

match
 print sc$'
Matchmaker Menu
---------------

[U]serlist
[S]can users for match
[I]nfo on a user
[L]ook at your info
[C]hange your info
[Q]uit to main
[T]erminate call'
match1
 push match1
 input @0 \"Enter (U,S,I,L,C,Q,T,?): "i$
 if i$="?" pop:goto match
 if i$="Q" pop:return
 if i$="L" print \"Your Info":a=un:goto userinf
 if i$="I" goto about
 if i$="S" goto scan
 if i$="T" pop:goto terminate
 if i$="C" goto change
 if i$="U" goto userlist
 print \"Invalid command, try again":return 

userlist
 input @0 \"[F]astlist, [R]ecent callers, or [N]ormal? "i$
 t=0:pn=1:print
 if i$="N" goto scan4
 if i$="R" goto last
 if i$="F" pn=2:goto scan4
 return

change
 print \"Change Your Info"\
 input @0 "Are you sure? "i$
 if i$<>"Y" return
 bo=1:goto new2

scan
 print '
Scan Users for a Match

Enter letters to match answers or [RETURN] to skip that question.  Type "Q"
at any input to skip the rest of the questions and start the search.'\
 kill "l:temp":create "l:temp"
 open #1,"i1:questions":open #2,"l:temp":t=0:pn=0
scan1
 input #1,i$:if i$="*" goto scan2
 if i$="^" close #1:goto scan4
 print i$:goto scan1
scan2
 input #1,a
scan3
 print \"(Up to "a" responses total)"\"Answer: ";
 input @2 i$:print:if i$="Q" close #1:goto scan4
 if len(i$)>a print "Invalid entry, try again":goto scan3
 t=t+1:position #2,80,t:print #2,i$:goto scan1
scan4
 print "Searching user file....";
 if pn=2 print \\"Username"chr$(32,22)"  Calling From"chr$(32,18)"  Last On"\
 for a=1 to nu:if (pn<>2) and (not (a mod 3)) print ".";
 open #1,"i1:dym.users":position #1,80,a
 input #1,x$,z,x1$\x2$,x3$,z:close #1
 if (x$="EMPTY") or (a=un) next:goto scan.end
 if pn=2 goto show1
 open #1,"i1:u."+str$(a)
 if t=0 g2=1:goto show
 for b=1 to t
 position #1,80,b:input #1,a1$
 position #2,80,b:input #2,a2$
 g1=0:g2=0
 if a2$="" g2=1:next:goto show
 if len(a2$)>len(a1$) g2=0:b=t:next:goto show
 for c=1 to len(a2$):a3$=mid$(a2$,c,1)
 if instr(a3$,a1$) g1=g1+1
 next:if g1<>len(a2$) g2=0:b=t:next:goto show
 next:g2=1
show
 if g2=0 close #1:next:goto scan.end
 position #1,80,0:input #1,i$:close #1
show1
 x$=left$(x$+chr$(32,30),30):x1$=left$(x1$+chr$(32,30),30)
 if pn<>2 print \
 setint(1):print x$"  "x1$"  "x2$:if pn<>2 print i$
 setint(""):if key(1) print "<Aborted>":a=nu
 next
scan.end
 if pn=0 close #2:kill "l:temp"
 print \"End of search.":return

who
 open #1,"i1:dym.log":input #1,i$
 print \"Caller log for "i$\
who1
 input #1,i$,o$:if i$="" close:return
 print left$(i$+chr$(32,30),30);:print o$:goto who1

about
 print \"Info About User"\
 input @2 "User ID: "i$
 if i$="" return
 gosub lower.case:i$=ab$
 open #1,"i1:dym.users":for b=1 to nu:position #1,80,b
 input #1,a$,b$:if a$<>i$ next:close:goto about1
 a=b:b=nu:next:close:goto userinf
about1
 print \"Sorry, that ID was not found.":return

userinf
 open #1,"i1:u."+str$(a)
 if mark(1) close:print \"No info available":return
 print '
Control-S pauses/starts
<space> Aborts'
 position #1,80,0:input #1,i$
 print \"One line describing yourself:"\">"i$\
 open #2,"i1:questions":t=0:gf=0
uinf1
 input #2,i$:if i$="*" goto uinf2
 if i$="%" close #1:close #2:return
 if i$="^" gf=1:print chr$(13):goto uinf1
 setint(1):print i$:setint("")
 if key(1) print "* Stop *":close #1:close #2:return
 goto uinf1
uinf2
 input #2,a
 t=t+1:position #1,80,t:input #1,i$
 if gf=0 print "Answer(s): ";
 print i$\:goto uinf1

last
 print "Listing users who've called since "lc$
 open #1,"i1:dym.users"
 for a=1 to nu:if not (a mod 3) print ".";
 position #1,80,a:input #1,o$,b,x1$\l$,b
 if (o$="EMPTY") or (a=un) or (l$<lc$) goto last1
 open #2,"i1:u."+str$(a):position #2,80,0:input #2,i$:close #2
 o$=left$(o$+chr$(32,30),30):x1$=left$(x1$+chr$(32,30),30)
 print \\o$"  "x1$"  "l$\i$
last1
 next:close:print \"End of search.":return

; Define set-up

define
 print \"[1) Video width now = "edit(3)+1
 print "[2) Back-space mode = ";
 a=nibble(0)/4:if a=1 print "non-";
 if a=0 print "Unknown":else print "destruct"
 print "[3) Nulls sent @ LF = "info(3)
 print "[4) Page pause mode = ";
 if flag(35) print "ON":else print "OFF"
 print "[Q)uit"\
display2
 input @0 "Select: "i$
 if i$="Q" return
 if i$="2" goto backspace
 if i$="3" goto nulls
 if i$="4" goto paging
 if i$="?" goto define
 if i$<>"1" goto display2
 
video
 print "Set Video Width"
 print \"New width (";
 print width(1),width(2),width(3),width(4);
 input @2 ")? " i$:if i$="" goto display2
 a=val(i$):for x=1 to 4
 if a=width(x) nibble(0)=nibble(0)/4*4+(x-1):edit(3)=a-1
 next:goto define
 
backspace
 print "Set Cursor Characteristics"
 print \"123456"chr$(8,3):a=0
 print '
How many numbers do you see?

3 shows a destructable backspace
6 shows a non-destructable backspace'
 input @0 \"How many (3 or 6)? "i$
 if i$="6" a=1
 if i$="3" a=2
 nibble(0)=(nibble(0) mod 4)+(a*4)
 edit(4)=a:goto define
 
nulls
 input @2"Set nulls to (0-127):"i$
 if i$<>"" info(3)=val(i$)
 goto display2
 
paging
 print "Pause after page now ";
 if flag(35) print "OFF":flag(35)=0:goto display2
 if not flag(35) print "ON":flag(35)=1
 goto display2
 
setpass
 print \"Change Your Password"\:echo="X"
 input @2 "Enter your current password: "i$:echo="":if i$="" return
 if i$<>pa$ print \"Incorrect!":return
 print \"Your password may be 4-9 characters long."
 echo="X":input @2 \"Enter your new password: "i$
 if i$="" echo="":return
 input @2 "Please type it in again: "a$
 echo="":a=len(i$)
 if a$<>i$ print \"Passwords do not match; no change.":return
 if (a<4) or (a>9) print \"Password must be 4-9 characters.":return
 pa$=i$:print \"New password accepted.":return

; Read E-mail

read.mail
 ready "i1:mail"
 if not msg(un) print \"No mail for you.":return
 ready #msg(un)
rd.mail2
 x=0:input #7,i$:d=val(i$)
 if i$="" return
rd.mail3
 print #x,\md$:setint(2):copy #7,#x
 setint(""):print #x,md$
 if key(2) goto rd.mail2
rd.mail4
 input @0 \"[A]uto-reply, [N]ext, [R]e-read, [Q]uit: "i$
 if (i$="C") or (i$="N") goto rd.mail2
 if i$="Q" return
 if i$="R" rewind:x=0:goto rd.mail3
 if (i$="P") and info(5) rewind:x=5:goto rd.mail3
 if (i$="W") and info(5) goto wr.mail
 if i$<>"A" goto rd.mail4
 if d=0 print \"Sorry, anonymous sender.":goto rd.mail4
 gosub editor:if not edit(2) goto rd.mail4
 print \"Wait..";:h$="":s=8:gg=0:gosub wr.ltr
 print ".reply sent.":goto rd.mail2
wr.mail
 input @2 \"Filename (to write):" i$:if i$="" goto rd.mail4
 create i$:rewind:open #1,i$:input #7,i$
 append #1:copy #7,#1:close:goto rd.mail4

; Send E-mail

send.mail
 an=0:h$="":r$=".letter sent."
 gg=0:print \"Send Electronic Mail"
 gosub mail.who
 if not d close #2:return
 gosub editor
 if not edit(2) close #2:return
 s=8:goto snd.bulk
 
mail.who
 print \"To who [1-"nu;:input @2 ",Q]: " i$
 if (i$="") or (i$="Q") d=0:return
 kill "l:bulk":create "l:bulk":open #2,"l:bulk
 gosub mail.wh2:position #2,80,0:print #2,d,d,d:return
 
mail.wh2
 if left$(i$,1)="#" i$=mid$(i$,2):goto snd.num
 if val(left$(i$,1)) goto snd.num
 d$=i$:if (d$="SYSOP") or (d$=sys$) d=1:return
 gosub lower.case:d$=ab$
 close #2:kill "l:matches":create "l:matches"
 open #2,"l:matches"
 open #1,"i1:dym.users":d=1:gf=0
 
snd.user
 position #1,80,d:input #1,a$,a,i$\i$,i$,a
 if a$=d$ close #1:close #2:open #2,"l:bulk":return
 if instr(d$,d1$) position #2,30,gf:print #2,d,d1$:gf=gf+1
 if d<nu d=d+1:goto snd.user
 close #1:if gf goto snd.usr3
 close #2:open #2,"l:bulk":d=0
 print \d$" is not a user.":return
snd.usr2
 print \"That user does not exist."
 d=0:return
snd.usr3
 print \"That user does not exist.  Matching users:"\
 for a=0 to gf-1:position #2,30,a:input #2,d,d1$
 print d1$" [#"d"]":next:close #2:open #2,"l:bulk"
 input @1\"Select user # (0=quit): "i$
 if i$="0" d=0:return
 
snd.num
 d=val(i$)
 if (d<1) or (d>nu) goto snd.usr2
 open #1,"i1:dym.users"
 position #1,80,d:input #1,a$,a,i$\i$,i$,a:close #1
 if a$="" goto snd.usr2
 print \"Send to "a$"? ";:input @0 i$
 a=len(a$):x$=i$
 if i$="ANON" goto snd.anon
 if i$<>"Y" d=0:else i$=x$
 return
snd.anon
 print \"Anonymous Letter"
 an=1:i$=x$:return

; write a bunch of letters to disk
 
snd.bulk
 print \"Wait..";:x=0
snd.blk2
 position #2,80,x:input #2,d,d1$,d2$
 if not d print r$:close #2:return
 x=x+1:if s=7 rewind
 gosub wr.ltr:goto snd.blk2
 
; write the letter to disk
 
wr.ltr
 ready "i1:mail"
 if info(6)<29 print \"Mail bit-map full":return
 if an=0 print #msg(d),un:else print #msg(d),0
 if h$ print #6,h$\
 print #6,"Letter From -%>";
 if an=0 print #6,na$;
 if (an) and (d<>1) print #6,"Anonymous sender!"
 if (an) and (d=1) print #6,"Sent anonymously from "na$
 if an=0 print #6," (#"un")"
 print #6,"Date Mailed -%>";:gosub date1
 if an=0 print #6,i$:else print #6,"Witheld"
 print #6,""
 copy #s,#6:print #msg(d),chr$(4);chr$(0);
 msg(d)=1:update:return
 
editor
 print \"Enter message now, "edit(3)" col, 4k bytes max ";
 print ".s = save|.h = help|'done' to edit msg."
 cl=clock(2):clock(2)=0:edit(0):edit(1):clock(2)=cl:return

date1
 q=val(left$(date$,2)):q1=val(mid$(date$,4,2)):q2=val(right$(date$,2))
 m$="000031059090120151181212243273304334":if q>1 q3=val(mid$(m$,q*3-2,3))
 q1=q1+q3:m$="46012356":q1=q1+val(mid$(m$,8-(94-q2),1)):q1=q1 mod 7
 m$="BobMonTueWedThuFriSat":if q1>1 td$=mid$(m$,q1*3-2,3):else td$="Sun"
 ml$="085534469788":q3=0:for q4=1 to q-1:q3=q3+val(mid$(ml$,q4,1):next
 mt$="FebruaryMarchAprilMayJuneJulyAugustSeptemberOctoberNovemberDecember"
 if q>1 m$=mid$(mt$,q3+1,val(mid$(ml$,q4+1,1))):else m$="January"
 min$=mid$(time$,4,2):if len(time$)>8 tm$=time$:goto date2
 if val(left$(time$,2))<12 tm$=left$(time$,2)+":"+min$+"AM":goto date2
 q4=val(left$(time$,2)):tm$=str$(12-(24-q4))+":"+min$+"PM"
date2
 i$=td$+", "+m$+" "+mid$(date$,4,2)+"  "+tm$
 return