vv
/
bugafriend
2
0
Fork 1
Code Issues Pull Requests Packages Activity

probably have to think about proof of ownership of these objects

This commit is contained in:
Vivianne 2024-02-02 01:37:13 -05:00
parent 713b877c5c
commit 476f0a3a7c
2 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
bugafriend/room.scm
View File

@ -8,18 +8,24 @@
(define pubsub (spawn ^pubsub (list creator-presence))) (define pubsub (spawn ^pubsub (list creator-presence)))
(methods (methods
[(add-user presence) [(add-user presence)
($ pubsub 'subscribe presence)] ($ pubsub 'subscribe presence)
($ pubsub 'publish 'join presence)]
[(kick-user presence) [(kick-user presence)
($ pubsub 'unsubscribe presence)] ($ pubsub 'unsubscribe presence)
[(say user message) ($ pubsub 'publish 'leave presence)]
($ pubsub 'publish 'say user message)] [(say presence message)
[(me user message) ($ pubsub 'publish 'say presence message)]
($ pubsub 'publish 'me user message)])) [(me presence message)
($ pubsub 'publish 'me presence message)]))
(define (^room-presence bcom name) (define (^room-presence bcom name)
"Each user has a presence in the room" "Each user has a presence in the room"
(methods (methods
[(name) name] [(name) name]
[(join user)
(format #t "~a joined." user)]
[(leave user)
(format #t "~a left." user)]
[(say user message) [(say user message)
(format #t "~a: ~a\n" user message)] (format #t "~a: ~a\n" user message)]
[(me user message) [(me user message)

22
bugafriend/user.scm
View File

@ -1,7 +1,8 @@
(define-module (bugafriend user) (define-module (bugafriend user)
#:use-module (bugafriend utils registry)
#:use-module (goblins) #:use-module (goblins)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (^user))) #:export (^user))
(define-record-type <room-data> (define-record-type <room-data>
(make-room-data room presence) (make-room-data room presence)
@ -9,13 +10,16 @@
(room room-data-room) (room room-data-room)
(presence room-data-presence)) (presence room-data-presence))
(define (^user bcom name joined-room-data) (define (^user bcom name registry joined-room-data)
(methods (methods
[(make-room) [(make-room)
(define my-presence (spawn ^room-presence name)) (define my-presence (spawn ^room-presence name))
(define room (spawn ^room my-presence)) (define room (spawn ^room my-presence))
(define room-data (make-room-data 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) [(join-room room)
(define my-presence (spawn ^room-presence name)) (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)) (<-np (room-data-room joined-room-data) 'kick-user (room-data-presence joined-room-data))
(on (<- room 'add-user my-presence) (on (<- room 'add-user my-presence)
(λ (_) (λ (_)
(define room-data (make-room-data room my-presence)) (format #t "Joined room.\n")))
(bcom (^user bcom name room-data)))
#:promise? #t))] (define room-data (make-room-data room my-presence))
(bcom (^user bcom name registry room-data)))]
[(leave-room room) [(leave-room room)
(when (eq? room (room-data-room joined-room-data)) (when (eq? room (room-data-room joined-room-data))
(on (<- room 'kick-user (room-data-presence joined-room-data)) (<-np room 'kick-user (room-data-presence joined-room-data))
(λ (_) (bcom (^user bcom name #f))) (bcom (^user bcom name registry #f)))]))
#:promise? #t))]))