!: :: /=main=/bin/chat/hoon :: => %= . + => + => ^/===/lib/pony => ^/===/lib/chat =+ flag=?(%all %rooms %monitor %never %leet %nub %time [%haus p=@p]) =+ flags=*(list flag) => |% ++ chk-flag |=(f=@tas (lien flags |=(flag =(f +<)))) ++ chat %+ cook |=(a=^chat a) ;~ pose (cold [%how ~] wut) (cold [%out ~] zap) %+ stag %who %+ stag %tcc (teklist ^room tis cen room) (cold [%who %ttt ~] ;~(plug tis tis tis)) (cold [%who %tts ~] ;~(plug tis tis)) (cold [%who %tis ~] tis) %+ stag %lus (teklist ^room lus cen room) %+ stag %hep (teklist ^room hep cen room) %+ stag %kil (teklist ,@p hep sig fed:ag) %+ stag %res (teklist ,@p lus sig fed:ag) ;~(pfix pam (stag %all (stag %$ (stag %& mess)))) ;~(pfix bar (stag %all (stag %$ (stag %| mess)))) %+ stag %all ;~(plug ;~(pfix cen room) (stag %& ;~(pfix ace mess))) (stag %say ;~(plug ;~(pfix sig fed:ag) ;~(pfix ace mess))) (stag %def mess) == :: ++ teklist |* [t=_,* pep=_rule pef=_rule sef=_rule] ;~(pfix pep (cook (list t) (plus (ifix [pef (star ace)] sef)))) :: ++ expn %- sear :_ text |= a=@t ^- (unit ,[p=@t q=tank]) =+ hun=(rush a wide:vast) ?~ hun ~ ?~(a ~ [~ a (sell (slap seed u.hun))]) :: ++ room %+ cook |=(a=(list ,@t) `^room`(crip a)) (plus ;~(pose low nud hep)) :: ++ mess %+ cook |=(a=^mess a) ;~ pose (stag %do ;~(pfix pat text)) (stag %ex ;~(pfix hax expn)) (stag %do (full (easy ''))) (stag %qu text) == ++ text (boss 256 (star ;~(pose (shim 32 126) (shim 128 255)))) -- |% ++ rend |= [sen=@da roo=@tas chr=tape nym=tape dum=^mess] :: roo=^room ^- tank =+ da=(yell sen) ?- -.dum %do =+ msg=?:(=(0 p.dum) "remains quietly present" (trip p.dum)) [%leaf "%{(trip roo)} {chr}{nym} {msg}"] %ex :~ %rose [" " "" ""] [%leaf "%{(trip roo)} {chr}{nym} {(trip p.dum)}"] q.dum == %qu :- %leaf %+ welp ?. (chk-flag %time) ~ (weld (timestamp sen) " ") "%{(trip roo)} {chr}{nym}: {(trip p.dum)}" == :: ++ timestamp |= t=@da =+ da=(yell t) "{?:((gth 10 h.da) "0" "")}{(scow %ud h.da)}:". "{?:((gth 10 m.da) "0" "")}{(scow %ud m.da)}" ++ read-wlist |= pax=path %- (unit (list)) =+ fil=((hard arch) .^(%cy pax)) ?~ q.fil ~ `(cue p:((hard ,[%dtzy %uw p=@]) (ream ((hard ,@) .^(%cx pax))))) -- == => %= . - :- :* bud=(sein `@p`-<) :: chat server oot=_@ud :: outstanding, server tod=*(map ,@p ,@ud) :: outstanding, friend giz=*(list gift) :: stuff to send sad=`sand`[%& &] :: default state wak=_@da :: next wakeup dun=| :: done kills=*(list ,@p) rooms=*(list ^room) == [who=`@p`-< how=`path`->] == |= [est=time *] |= args=(list flag) =. flags `(list flag)`args =+ sta=est :: move up to declaration of state =. wak est =. bud :: future maintainers: don't add more cell types with changing this ?: (lien args |=(a=flag ?=(^ a))) (roll args |=([p=flag q=@p] ?:(?=(^ p) p.p q))) bud =. kills %- (list ,@p) %+ fall (read-wlist /[(scot %p who)]/conf/[(scot %da est)]/chat/killfile/wlist) ~ =. rooms %- (list ^room) %+ fall %- read-wlist /[(scot %p who)]/conf/[(scot %da est)]/chat/[(scot %p bud)]/wlist ~[coci] |- ^- bowl =< abet:init |% ++ abet `bowl`[(flop giz) ?:(dun ~ [~ hope vent(giz ~)])] ++ hope :: wait for events =< apex |% ++ apex ^- (list slip) ;: weld buds pals regs == :: ++ buds ^- (list slip) ?: =(0 oot) ~ [[/re [%ow ~]] ~] :: ++ pals ^- (list slip) =| alx=(list slip) |- ^+ alx ?~ tod alx %= $ tod r.tod alx %= $ tod l.tod alx :_(alx [[%ra (scot %p p.n.tod) ~] [%ow ~]]) == == :: ++ regs ^- (list slip) :~ [/ob [%lq %ob]] [/wa [%wa wak]] [/ya [%lq %ya]] ^- slip :- /up :+ %up %text :_ "" =+ wyt=?:(?=(& -.sad) !=(0 oot) (~(has by tod) p.sad)) %+ weld ?. ?=(& -.sad) (scow %p p.sad) ?~ rooms "deep space " :(weld "%" (trip i.rooms) ?:(p.sad " &" " |")) ?:(wyt "... " " ") == -- :: ++ init (joke:(joke ~ [%who ~]) ~ [%ego est]) :: initial actions ++ joke :: send message |= [hur=(unit ,@p) msg=*] ^+ +> ?~ hur +>(oot +(oot), giz :_(giz [%sq bud %bo /re msg])) %= +> giz :_(giz [%sq u.hur %ya [%ra (scot %p u.hur) ~] msg]) tod =+ dut=(~(get by tod) u.hur) (~(put by tod) u.hur ?~(dut 1 +(u.dut))) == :: ++ nice :: got response |= [hur=(unit ,@p) kay=cape] ^+ +> =. +> ?~ hur +>(oot (dec oot)) =+ dyt=(need (~(get by tod) u.hur)) %_ +>.$ tod ?: =(1 dyt) (~(del by tod) u.hur) (~(put by tod) u.hur (dec dyt)) == ?- kay %good +> %dead (show %leaf "server {(scow %p ?~(hur bud u.hur))} choked") == :: ++ priv :: private message |= [now=@da her=@p mes=^mess] ^+ +> ?: (dead her) +> =+ ^= nym =+ yow=(scot %p her) =+ ^= woy %- (hard ,@t) .^(%a (scot %p who) %name (scot %da now) (scot %p her) ~) ?: =(%$ woy) yow (cat 3 yow (cat 3 ' ' woy)) (show (rend est '(private)' "" (trip nym) mes)) :: ++ said :: server message |= [her=@p duz=(list zong)] ^+ +> ?~ duz +> %= $ duz t.duz +> %- shew ^- (list tank) ?- -.i.duz %all ?: (dead p.s.i.duz) ~ :_ ~ %- rend :* p.i.duz q.i.duz ?:(=(%white r.i.duz) "& " "| ") (trip q.s.i.duz) t.i.duz == %who %+ ~(rep by q.i.duz) *(list tank) |= [p=[r=^room u=(list user)] q=(list tank)] :* [%leaf "%{(trip r.p)}:"] :+ %rose [", " " " ""] %+ turn %+ weld (skim u.p |=(a=user =(p.a who))) (skip u.p |=(a=user =(p.a who))) |=(a=user [%leaf (trip q.a)]) q == ?(%new %out) ?. ?& !(dead p.r.i.duz) ?| (chk-flag %all) ?& (lth sta p.i.duz) ?| (chk-flag %rooms) ?& =(coci q.i.duz) (chk-flag %monitor) == == == == == ~ :_ ~ :- %leaf ;: weld ?. (chk-flag %time) ~ (timestamp p.i.duz) ?- -.i.duz %new " +" %out " -" == ?: (chk-flag %nub) (trip q.r.i.duz) (scow %p p.r.i.duz) ?: (chk-flag %monitor) ~ (weld " %" (trip q.i.duz)) == == == :: ++ dead |= her=@p (lien kills |=(@p =(her +<))) :: ++ kill |= her=(list ,@p) %= +> kills (weld her (skip kills |=(a=@p (lien her |=(b=@p =(a b)))))) giz =+ j=(jam (weld her (skip kills |=(a=@p (lien her |=(b=@p =(a b))))))) =+ encoded=(cat 3 (scot %uw j) `@t`10) :: Base-64 encoding :_ giz :- %ok (foal /[(scot %p who)]/conf/[(scot %da est)]/chat/killfile/wlist encoded) == :: ++ resurrect |= her=(list ,@p) %= +> kills (skip kills |=(a=@p (lien her |=(b=@p =(a b))))) giz =+ j=(jam (skip kills |=(a=@p (lien her |=(b=@p =(a b)))))) =+ encoded=(cat 3 (scot %uw j) `@t`10) :: Base-64 encoding :_ giz :- %ok (foal /[(scot %p who)]/conf/[(scot %da est)]/chat/killfile/wlist encoded) == :: ++ add-room |= roo=(list ^room) =+ rs=(weld roo (skip rooms |=(a=^room (lien roo |=(b=^room =(a b)))))) %+ %= joke sad [%& %&] rooms rs giz =+ encoded=(cat 3 (scot %uw (jam rs)) `@t`10) :: Base-64 encoding :_ giz :- %ok %+ foal /[(scot %p who)]/conf/[(scot %da est)]/chat/[(scot %p bud)]/wlist encoded == ~ `zing`[%lus roo] :: ++ remove-room |= roo=(list ^room) =+ rs=(skip rooms |=(a=^room (lien roo |=(b=^room =(a b))))) %+ %= joke sad [%& %&] rooms rs giz =+ j=(jam rs) =+ encoded=(cat 3 (scot %uw j) `@t`10) :: Base-64 encoding :_ giz :- %ok %+ foal /[(scot %p who)]/conf/[(scot %da est)]/chat/[(scot %p bud)]/wlist encoded == ~ `zing`[%hep roo] :: ++ shew |=(tax=(list tank) +>(giz [[%lo tax] giz])) :: print to screen ++ show |=(tan=tank +>(giz [[%la tan] giz])) :: print to screen ++ take :: alarm event |- ^+ + =. wak (add ~m1 (max wak est)) ?.(=(0 oot) + (joke ~ `zing`[%ego est])) :: ++ toke :: user action |= txt=@t ^+ +> ?: =(0 txt) +> =+ rey=(rush txt chat) ?~ rey (show %leaf "invalid input") ?- -.u.rey %all ?~ p.u.rey ?~ rooms (show [%leaf "in space, no one can hear you scream..."]) (joke(sad [%& q.u.rey]) ~ `zing`[%all i.rooms q.u.rey r.u.rey]) (joke(sad [%& q.u.rey]) ~ `zing`u.rey) %def ?~ rooms (show [%leaf "in space, no one can hear you scream..."]) %- joke ?: ?=(& -.sad) [~ `zing`[%all i.rooms p.sad p.u.rey]] [[~ p.sad] `^mess`p.u.rey] %how (shew (turn (lore ^:@/===doc%/help/txt) |=(a=@t [%leaf (trip a)]))) %out (show(dun &) %leaf "see you space cowboy...") %say (joke(sad [%| p.u.rey]) [~ p.u.rey] `^mess`q.u.rey) %who ?- p.u.rey %tis ?~ rooms %+ show %leaf "you are alone. try again on a habitable world." %+ joke ~ ^- zing :- %who `~[i.rooms] %tts %+ joke ~ ^- zing :- %who `rooms %ttt %+ joke ~ ^- zing :- %who ~ %tcc %+ joke ~ ^- zing :- %who `q.u.rey == %lus (add-room p.u.rey) %hep ?~ rooms %+ show %leaf "you are at the outer rim, alone. try entering a habitable world." (remove-room p.u.rey) %kil (kill p.u.rey) %res (resurrect p.u.rey) == :: ++ vent :: handle event |= [now=@da pax=path nut=note] ^- bowl =. est now =< abet ?+ -.pax +> %ob ?>(?=(%lq -.nut) (said p.nut ((hard (list zong)) r.nut))) %re ?>(?=(%ow -.nut) (nice ~ p.nut)) %ra ?> &(?=(%ow -.nut) ?=(^ t.pax)) (nice [~ (need (slaw %p i.t.pax))] p.nut) %up ?>(?=(%up -.nut) (toke p.nut)) %wa ?>(?=(%wa -.nut) take) %ya ?>(?=(%lq -.nut) (priv now p.nut ((hard ^mess) r.nut))) == --