X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=daf63539ab8dadc8663fbdb47755d40d775b2c85;hb=d23f2cefbde148dedc61da5cf35391a12c6734bb;hp=d458327d3cd72d97d45f6b0cccb0f0bde8240bef;hpb=aca41e2e3c5ed026c2672e3ac4ac364bbdef19c7;p=mudsync.git diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index d458327..daf6353 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -20,7 +20,7 @@ (use-modules (mudsync) (mudsync parser) - (8sync systems actors) + (8sync actors) (8sync agenda) (oop goops) (ice-9 control) @@ -54,22 +54,14 @@ (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 () (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 @@ -92,9 +84,6 @@ (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..." @@ -117,9 +106,10 @@ or 'skribe'? Now *that's* composition!")) #: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" @@ -136,14 +126,10 @@ or 'skribe'? Now *that's* composition!")) #: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 @@ -181,21 +167,14 @@ character.\n"))) (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 () (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 @@ -405,13 +384,9 @@ if this room is intended for children or child-like adults." #: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 @@ -499,18 +474,6 @@ seat in the room, though." (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 () ;; The desk clerk has three states: ;; - on-duty: Arrived, and waiting for instructions (and losing patience @@ -520,9 +483,15 @@ seat in the room, though." (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 @@ -586,7 +555,8 @@ with tuition at where it is...")) (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) @@ -674,6 +644,7 @@ attend to.\n") (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 @@ -681,6 +652,14 @@ attend to.\n") #: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