diff --git a/bugafriend/room.scm b/bugafriend/room.scm index 2893478..598ed21 100644 --- a/bugafriend/room.scm +++ b/bugafriend/room.scm @@ -8,18 +8,24 @@ (define pubsub (spawn ^pubsub (list creator-presence))) (methods [(add-user presence) - ($ pubsub 'subscribe presence)] + ($ pubsub 'subscribe presence) + ($ pubsub 'publish 'join presence)] [(kick-user presence) - ($ pubsub 'unsubscribe presence)] - [(say user message) - ($ pubsub 'publish 'say user message)] - [(me user message) - ($ pubsub 'publish 'me user message)])) + ($ pubsub 'unsubscribe presence) + ($ pubsub 'publish 'leave presence)] + [(say presence message) + ($ pubsub 'publish 'say presence message)] + [(me presence message) + ($ pubsub 'publish 'me presence message)])) (define (^room-presence bcom name) "Each user has a presence in the room" (methods [(name) name] + [(join user) + (format #t "~a joined." user)] + [(leave user) + (format #t "~a left." user)] [(say user message) (format #t "~a: ~a\n" user message)] [(me user message) diff --git a/bugafriend/user.scm b/bugafriend/user.scm index 258596c..7ac9873 100644 --- a/bugafriend/user.scm +++ b/bugafriend/user.scm @@ -1,7 +1,8 @@ (define-module (bugafriend user) + #:use-module (bugafriend utils registry) #:use-module (goblins) #:use-module (srfi srfi-1) - #:export (^user))) + #:export (^user)) (define-record-type (make-room-data room presence) @@ -9,13 +10,16 @@ (room room-data-room) (presence room-data-presence)) -(define (^user bcom name joined-room-data) +(define (^user bcom name registry joined-room-data) (methods [(make-room) (define my-presence (spawn ^room-presence name)) (define room (spawn ^room my-presence)) (define room-data (make-room-data room my-presence)) - (bcom (^user bcom name room-data))] + (on (<- registry 'register room) + (λ (id) + (format #t "New room ID: ~a\n" (ocapn-id->string id)))) + (bcom (^user bcom name registry room-data))] [(join-room room) (define my-presence (spawn ^room-presence name)) @@ -23,12 +27,12 @@ (<-np (room-data-room joined-room-data) 'kick-user (room-data-presence joined-room-data)) (on (<- room 'add-user my-presence) (λ (_) - (define room-data (make-room-data room my-presence)) - (bcom (^user bcom name room-data))) - #:promise? #t))] + (format #t "Joined room.\n"))) + + (define room-data (make-room-data room my-presence)) + (bcom (^user bcom name registry room-data)))] [(leave-room room) (when (eq? room (room-data-room joined-room-data)) - (on (<- room 'kick-user (room-data-presence joined-room-data)) - (λ (_) (bcom (^user bcom name #f))) - #:promise? #t))])) + (<-np room 'kick-user (room-data-presence joined-room-data)) + (bcom (^user bcom name registry #f)))]))