steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add a few utility words to managed-server

Doug Coleman 2009-05-30 13:38:40 -05:00
parent 8c51abfd06
commit aa1df815dc
1 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/managed-server/managed-server.factor
View File

@ -29,11 +29,27 @@ M: managed-server handle-managed-client* ;
: clients ( -- assoc ) server clients>> ; : clients ( -- assoc ) server clients>> ;
: client-streams ( -- assoc ) clients values ; : client-streams ( -- assoc ) clients values ;
: username ( -- string ) client username>> ; : username ( -- string ) client username>> ;
: everyone-else ( -- assoc )
clients [ drop username = not ] assoc-filter ;
: everyone-else-streams ( -- assoc ) everyone-else values ;
ERROR: no-such-client username ;
<PRIVATE
: (send-client) ( seq managed-client -- )
swap output-stream>> '[ _ print flush ] with-output-stream* ;
PRIVATE>
: send-client ( seq username -- )
clients ?at [ no-such-client ] [ (send-client) ] if ;
: send-everyone ( seq -- ) : send-everyone ( seq -- )
[ client-streams ] dip '[ [ client-streams ] dip '[ _ (send-client) ] each ;
output-stream>> [ _ print flush ] with-output-stream*
] each ; : send-everyone-else ( seq -- )
[ everyone-else-streams ] dip '[ _ (send-client) ] each ;
ERROR: already-logged-in username ; ERROR: already-logged-in username ;