Add #:break-on-departure? keyword argument to join-room.
This commit is contained in:
parent
6fb5488274
commit
fe6171201f
|
@ -30,6 +30,7 @@
|
|||
|
||||
(struct room-state (name ch members) #:transparent)
|
||||
(struct binding (name ;; any
|
||||
break-on-departure? ;; boolean
|
||||
in-ch ;; sync channel
|
||||
out-ch ;; sync channel
|
||||
disconnect-box ;; blocking-box
|
||||
|
@ -43,13 +44,14 @@
|
|||
(thread (lambda () (room-main (room-state name ch '()))))
|
||||
(room ch))
|
||||
|
||||
(define (join-room room [name (gensym 'peer)])
|
||||
(make-object membership% (room-ch room) name))
|
||||
(define (join-room room [name (gensym 'peer)] #:break-on-departure? [break-on-departure? #f])
|
||||
(make-object membership% (room-ch room) name break-on-departure?))
|
||||
|
||||
(define membership%
|
||||
(class* object% ()
|
||||
(init room-init)
|
||||
(init name-init)
|
||||
(init break-on-departure?-init)
|
||||
|
||||
(super-new)
|
||||
|
||||
|
@ -66,7 +68,8 @@
|
|||
(set! connected #f)
|
||||
(set! reason v)
|
||||
v)))
|
||||
(channel-put room `(join ,name ,out-ch ,in-ch ,disconnect-box
|
||||
(channel-put room `(join ,name ,break-on-departure?-init
|
||||
,out-ch ,in-ch ,disconnect-box
|
||||
,(current-thread) ,(current-thread-exit-status)))
|
||||
|
||||
(define/public (connected?)
|
||||
|
@ -127,9 +130,11 @@
|
|||
(room-main (part state b (binding-death-reason b)))))))
|
||||
(handle-evt (room-state-ch state)
|
||||
(match-lambda
|
||||
(`(join ,name ,in-ch ,out-ch ,disconnect-box
|
||||
(`(join ,name ,break-on-departure?
|
||||
,in-ch ,out-ch ,disconnect-box
|
||||
,thread ,exit-status)
|
||||
(room-main (join state name in-ch out-ch disconnect-box
|
||||
(room-main (join state name break-on-departure?
|
||||
in-ch out-ch disconnect-box
|
||||
thread exit-status)))
|
||||
(unexpected (log-warning (format "room-main: unexpected message ~v"
|
||||
unexpected))
|
||||
|
@ -149,8 +154,11 @@
|
|||
message))
|
||||
state)))
|
||||
|
||||
(define (join state name in-ch out-ch disconnect-box thread exit-status)
|
||||
(define b (binding name in-ch out-ch disconnect-box
|
||||
(define (join state name break-on-departure?
|
||||
in-ch out-ch disconnect-box
|
||||
thread exit-status)
|
||||
(define b (binding name break-on-departure?
|
||||
in-ch out-ch disconnect-box
|
||||
(box (list->queue (membership-summary state)))
|
||||
thread exit-status))
|
||||
(broadcast (add-binding state b) b (arrived name)))
|
||||
|
@ -180,4 +188,7 @@
|
|||
|
||||
(define (enqueue-message! b message)
|
||||
(define qb (binding-queue-box b))
|
||||
(set-box! qb (enqueue (unbox qb) message)))
|
||||
(if (and (departed? message)
|
||||
(binding-break-on-departure? b))
|
||||
(break-thread (binding-thread b))
|
||||
(set-box! qb (enqueue (unbox qb) message))))
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
(require racket/match)
|
||||
|
||||
(require "conversation.rkt")
|
||||
(require "standard-thread.rkt")
|
||||
|
||||
(define r (make-room))
|
||||
|
||||
|
@ -20,6 +21,11 @@
|
|||
(else (void)))
|
||||
(loop))))
|
||||
|
||||
(standard-thread (lambda ()
|
||||
(define handle (join-room r 'cascade #:break-on-departure? #t))
|
||||
(define-values (i o) (make-pipe))
|
||||
(sync (read-bytes-evt 128 i))))
|
||||
|
||||
(define (interaction i o)
|
||||
(display "What is your name? > " o)
|
||||
(flush-output o)
|
||||
|
|
Loading…
Reference in New Issue