(use-modules (mudsync)
(mudsync parser)
- (8sync systems actors)
+ (8sync actors)
(8sync agenda)
(oop goops)
(ice-9 control)
(append readable-commands
thing-commands))
-(define readable-actions
- (build-actions
- (cmd-read (wrap-apply readable-cmd-read))))
-
-(define readable-actions*
- (append readable-actions
- thing-actions*))
-
(define-class <readable> (<thing>)
(read-text #:init-value "All it says is: \"Blah blah blah.\""
#:init-keyword #:read-text)
(commands
#:init-value readable-commands*)
- (message-handler
- #:init-value
- (simple-dispatcher readable-actions*)))
+ (actions #:allocation #:each-subclass
+ #:init-value (build-actions
+ (cmd-read readable-cmd-read))))
(define (readable-cmd-read actor message)
(<- actor (message-from message) 'tell
(list
(direct-command "chat" 'cmd-chat)
(direct-command "talk" 'cmd-chat)))
-(define chat-actions
- (build-actions
- (cmd-chat (wrap-apply npc-chat-randomly))))
(define hotel-owner-grumps
'("Eight sinks! Eight sinks! And I couldn't unwind them..."
#:init-keyword #:catchphrases)
(commands
#:init-value chat-commands)
- (message-handler
- #:init-value
- (simple-dispatcher (append gameobj-actions chat-actions))))
+ (actions #:allocation #:each-subclass
+ #:init-value
+ (build-actions
+ (cmd-chat npc-chat-randomly))))
(define random-bricabrac
'("a creepy porcelain doll"
#:init-value
(list
(prep-direct-command "sign" 'cmd-sign-form
- '("as"))))
- (message-handler
- #:init-value
- (simple-dispatcher
- (append
- (build-actions
- (cmd-sign-form (wrap-apply sign-cmd-sign-in)))
- gameobj-actions))))
+ '("as"))))
+ (actions #:allocation #:each-subclass
+ #:init-value (build-actions
+ (cmd-sign-form sign-cmd-sign-in))))
(define name-sre
(append summoning-bell-commands
thing-commands*))
-(define summoning-bell-actions
- (build-actions
- (cmd-ring (wrap-apply summoning-bell-cmd-ring))))
-(define summoning-bell-actions*
- (append summoning-bell-actions
- thing-actions*))
-
(define-class <summoning-bell> (<thing>)
(summons #:init-keyword #:summons)
(commands
#:init-value summoning-bell-commands*)
- (message-handler
- #:init-value
- (simple-dispatcher summoning-bell-actions*)))
+ (actions #:allocation #:each-subclass
+ #:init-value (build-actions
+ (cmd-ring summoning-bell-cmd-ring))))
(define* (summoning-bell-cmd-ring bell message . _)
;; Call back to actor who invoked this message handler
#:init-value
(list
(direct-command "sit" 'cmd-sit-furniture)))
- (message-handler
- #:init-value
- (simple-dispatcher
- (append
- (build-actions
- (cmd-sit-furniture (wrap-apply furniture-cmd-sit)))
- gameobj-actions))))
+ (actions #:allocation #:each-subclass
+ #:init-value (build-actions
+ (cmd-sit-furniture furniture-cmd-sit))))
(define* (furniture-cmd-sit actor message #:key direct-obj)
(define player-name
(define clerk-commands*
(append clerk-commands thing-commands*))
-(define clerk-actions
- (build-actions
- (init (wrap-apply clerk-act-init))
- (cmd-chat (wrap-apply clerk-cmd-chat))
- (cmd-ask-incomplete (wrap-apply clerk-cmd-ask-incomplete))
- (cmd-ask-about (wrap-apply clerk-cmd-ask))
- (cmd-dismiss (wrap-apply clerk-cmd-dismiss))
- (update-loop (wrap-apply clerk-act-update-loop))
- (be-summoned (wrap-apply clerk-act-be-summoned))))
-(define clerk-actions* (append clerk-actions
- thing-actions*))
-
(define-class <desk-clerk> (<thing>)
;; The desk clerk has three states:
;; - on-duty: Arrived, and waiting for instructions (and losing patience
(state #:init-value 'slacking)
(commands #:init-value clerk-commands*)
(patience #:init-value 0)
- (message-handler
- #:init-value
- (simple-dispatcher clerk-actions*)))
+ (actions #:allocation #:each-subclass
+ #:init-value (build-actions
+ (init clerk-act-init)
+ (cmd-chat clerk-cmd-chat)
+ (cmd-ask-incomplete clerk-cmd-ask-incomplete)
+ (cmd-ask-about clerk-cmd-ask)
+ (cmd-dismiss clerk-cmd-dismiss)
+ (update-loop clerk-act-update-loop)
+ (be-summoned clerk-act-be-summoned))))
(define (clerk-act-init clerk message)
;; call the gameobj main init method
(define clerk-doesnt-know-text
"The clerk apologizes and says she doesn't know about that topic.\n")
-(define (clerk-cmd-ask clerk message indir-obj)
+(define* (clerk-cmd-ask clerk message #:key indir-obj
+ #:allow-other-keys)
(match (slot-ref clerk 'state)
('on-duty
(match (assoc (pk 'indir indir-obj) clerk-help-topics)
(define clerk-return-to-slacking-text
"The desk clerk enters and slams the door behind her.\n")
+
(define (clerk-act-update-loop clerk message)
(define (tell-room text)
(<- clerk (gameobj-loc clerk) 'tell-room
#:exclude (actor-id clerk)))
(define (loop-if-not-destructed)
(if (not (slot-ref clerk 'destructed))
+ ;; This iterates by "recursing" on itself by calling itself
+ ;; (as the message handler) again. It used to be that we had to do
+ ;; this, because there was a bug where a loop which yielded like this
+ ;; would keep growing the stack due to some parameter goofiness.
+ ;; That's no longer true, but there's an added advantage to this
+ ;; route: it's much more live hackable. If we change the definition
+ ;; of this method, the character will act differently on the next
+ ;; "tick" of the loop.
(<- clerk (actor-id clerk) 'update-loop)))
(match (slot-ref clerk 'state)
('slacking