(let loop ((recipients-left recipients))
(unless (null? recipients-left)
(send-message (car recipients-left) 'show-msg name str)
- (loop (cdr recipients-left))))))
- (finally
- 'sleep))))
+ (loop (cdr recipients-left)))))))))
(define (make-receiver-beh system)
(make-beh (self)
(('show-msg from text) =>
- (send-message system 'print from "> " text)
- 'sleep)))
+ (send-message system 'print from "> " text))))
(define (make-client-beh system)
(('start) =>
(send-message system 'print "Welcome to chat!\n"
"Your client address is " (address->string receiver) ".\n"
- "Type '/help' for a list of commands.\n"))
+ "Type '/help' for a list of commands.\n")
+ (send-message system 'read self))
(((? string? str)) =>
(if (string-prefix? "/" str)
(let* ((maybe-idx (string-index str #\space))
(send-message system 'shutdown))
(else
(send-message system 'print "Unrecognised command '" cmd "'"))))
- (send-message rollodex 'send name str)))
-
- (finally
- (send-message system 'read self)
- 'sleep))))
+ (send-message rollodex 'send name str))
+ (send-message system 'read self)))))
(define-beh main-beh (self)
((system) =>
(define root-beh
(make-beh : #f (self)
(('ping recipient) =>
- (send-message recipient 'pong)
- 'sleep)))
+ (send-message recipient 'pong))))
;; Actors
(condition-case
(match (apply (beh-proc beh) (cons address message))
('done (hash-table-delete! actor-table id))
- ('sleep 'do-nothing)
('pass
(log-trace "Passing to parent behaviour...")
(loop (beh-parent beh)))
((? procedure? new-beh) (hash-table-set! actor-table id new-beh))
(else
- (log-msg "Warning: behaviour of actor " id " returned invalid value.")))
+ 'do-nothing)) ; sleep is now the default
(o (exn)
(log-msg "Warning: actor " id " crashed evaluating message " (->stringrep message))
(print-error-message o)))
'done)
(('print strings ...) =>
- (apply print strings)
- 'sleep)
+ (apply print strings))
(('read reader) =>
(mutex-lock! reader-queue-mutex)
(fifo-push reader-queue reader)
(mutex-unlock! reader-available-mutex)
- (mutex-unlock! reader-queue-mutex)
- 'sleep))
+ (mutex-unlock! reader-queue-mutex)))
(define (boot-sam)
(start-console)
'done)
((user) =>
(send-message login console 'user user)
- 'done)))
- 'sleep)
+ 'done))))
((console 'user user) =>
(send-message console 'print "password: ")
(send-message console 'read
(self)
((pass) =>
(send-message login console 'user user 'pass pass)
- 'done)))
- 'sleep)
+ 'done))))
((console 'user user 'pass pass) =>
- (send-message console 'print "Logged in user " user " with password " pass)
- 'sleep)
+ (send-message console 'print "Logged in user " user " with password " pass))
((console 'new-user) =>
(send-message console 'print "What should I call your character?")
(send-message console 'read
"A character with that name already exists.")
(send-message login console 'new-user))
(send-message login console 'new-user user))
- 'done)))
- 'sleep)
+ 'done))))
((console 'new-user user) =>
(send-message console 'print "Please enter a good password/phrase:")
(send-message console 'read
(self)
((pass) =>
(send-message login console 'new-user user 'pass-confirm pass)
- 'done)))
- 'sleep)
+ 'done))))
((console 'new-user user 'pass-confirm pass) =>
(send-message console 'print "Please confirm your password:")
(send-message console 'read
(begin
(send-message console 'print "Passwords do not match. Try again.")
(send-message login console 'new-user user)))
- 'done)))
- 'sleep)
+ 'done))))
((console 'new-user user 'pass pass) =>
(let ((player (make-actor (make-player-beh user))))
(set! accounts (cons (list user pass player)))
- (send-message console 'print "New account created! Welcome!"))
- 'sleep))))
+ (send-message console 'print "New account created! Welcome!"))))))
(define-beh main-beh (self)