X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=3ce948d4b7fe568b097f9e0a3a18d4612eedbdf0;hp=372515ede66d206292df8445bd660df71dd6c70d;hb=80b100aa206cc865238f055d8c2b809586566064;hpb=009fc4606e1a141fd182a38718b9954ecfdd62a5 diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 372515e..3ce948d 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,25 +54,17 @@ (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 + (<- (message-from message) 'tell #:text (string-append (slot-ref actor 'read-text) "\n"))) @@ -80,21 +72,18 @@ ;;; Lobby ;;; ----- -(define-mhandler (npc-chat-randomly actor message) +(define (npc-chat-randomly actor message . _) (define text-to-send (format #f "~a says: \"~a\"\n" (slot-ref actor 'name) (random-choice (slot-ref actor 'catchphrases)))) - (<- actor (message-from message) 'tell + (<- (message-from message) 'tell #:text text-to-send)) (define chat-commands (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 @@ -157,20 +143,18 @@ or 'skribe'? Now *that's* composition!")) (and (irregex-match name-sre name) (not (member name forbidden-words)))) -(define-mhandler (sign-cmd-sign-in actor message direct-obj indir-obj) +(define* (sign-cmd-sign-in actor message + #:key direct-obj indir-obj preposition) (define old-name - (message-ref - (<-wait actor (message-from message) 'get-name) - 'val)) + (mbody-val (<-wait (message-from message) 'get-name))) (define name indir-obj) (if (valid-name? indir-obj) (begin - (<-wait actor (message-from message) 'set-name! - #:val name) - (<- actor (slot-ref actor 'loc) 'tell-room + (<-wait (message-from message) 'set-name! name) + (<- (slot-ref actor 'loc) 'tell-room #:text (format #f "~a signs the form!\n~a is now known as ~a\n" old-name old-name name))) - (<- actor (message-from message) 'tell + (<- (message-from message) 'tell #:text "Sorry, that's not a valid name. Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic character.\n"))) @@ -183,36 +167,28 @@ 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-mhandler (summoning-bell-cmd-ring bell message) +(define* (summoning-bell-cmd-ring bell message . _) ;; Call back to actor who invoked this message handler ;; and find out their name. We'll call *their* get-name message ;; handler... meanwhile, this procedure suspends until we get ;; their response. (define who-rang - (message-ref - (<-wait bell (message-from message) 'get-name) - 'val)) + (mbody-val (<-wait (message-from message) 'get-name))) + ;; Now we'll invoke the "tell" message handler on the player ;; who rang us, displaying this text on their screen. ;; This one just uses <- instead of <-wait, since we don't ;; care when it's delivered; we're not following up on it. - (<- bell (message-from message) 'tell + (<- (message-from message) 'tell #:text "*ring ring!* You ring the bell!\n") ;; We also want everyone else in the room to "hear" the bell, ;; but they get a different message since they aren't the ones @@ -220,7 +196,7 @@ character.\n"))) ;; name as extracted and assigned to the who-rang variable. ;; Notice how we send this message to our "location", which ;; forwards it to the rest of the occupants in the room. - (<- bell (gameobj-loc bell) 'tell-room + (<- (gameobj-loc bell) 'tell-room #:text (format #f "*ring ring!* ~a rings the bell!\n" who-rang) @@ -228,7 +204,7 @@ character.\n"))) ;; Now we perform the primary task of the bell, which is to summon ;; the "clerk" character to the room. (This is configurable, ;; so we dynamically look up their address.) - (<- bell (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned + (<- (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned #:who-summoned (message-from message))) @@ -247,7 +223,7 @@ character.\n"))) #:desc " You're in some sort of hotel lobby. You see a large sign hanging over the desk that says \"Hotel Bricabrac\". On the desk is a bell -that says \"ring for service\". Terrible music plays from a speaker +that says \"'ring bell' for service\". Terrible music plays from a speaker somewhere overhead. The room is lined with various curio cabinets, filled with all sorts of kitschy junk. It looks like whoever decorated this place had great @@ -408,24 +384,18 @@ 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-mhandler (furniture-cmd-sit actor message direct-obj) +(define* (furniture-cmd-sit actor message #:key direct-obj) (define player-name - (message-ref - (<-wait actor (message-from message) 'get-name) - 'val)) - (<- actor (message-from message) 'tell + (mbody-val (<-wait (message-from message) 'get-name))) + (<- (message-from message) 'tell #:text (format #f "You ~a ~a.\n" (slot-ref actor 'sit-phrase) (slot-ref actor 'sit-name))) - (<- actor (slot-ref actor 'loc) 'tell-room + (<- (slot-ref actor 'loc) 'tell-room #:text (format #f "~a ~a on ~a.\n" player-name (slot-ref actor 'sit-phrase-third-person) @@ -504,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 @@ -525,15 +483,21 @@ 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*))) - -(define-mhandler (clerk-act-init clerk message) + (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 (gameobj-act-init clerk message) ;; start our main loop - (<- clerk (actor-id clerk) 'update-loop)) + (<- (actor-id clerk) 'update-loop)) (define clerk-help-topics '(("changing name" . @@ -554,7 +518,7 @@ feel free to walk around and explore."))) (define clerk-knows-about - "'changing name', 'common commands', and 'about the hotel'") + "'ask clerk about changing name', 'ask clerk about common commands', and 'ask clerk about the hotel'") (define clerk-general-helpful-line (string-append @@ -571,59 +535,60 @@ For example, 'ask clerk about changing name'. You can ask me about the following energy particle physicist. But ya gotta pay the bills, especially with tuition at where it is...")) -(define-mhandler (clerk-cmd-chat clerk message) +(define* (clerk-cmd-chat clerk message #:key direct-obj) (match (slot-ref clerk 'state) ('on-duty - (<- clerk (message-from message) 'tell + (<- (message-from message) 'tell #:text clerk-general-helpful-line)) ('slacking - (<- clerk (message-from message) 'tell + (<- (message-from message) 'tell #:text (string-append "The clerk says, \"" (random-choice clerk-slacking-complaints) "\"\n"))))) -(define-mhandler (clerk-cmd-ask-incomplete clerk message) - (<- clerk (message-from message) 'tell +(define (clerk-cmd-ask-incomplete clerk message . _) + (<- (message-from message) 'tell #:text "The clerk says, \"Ask about what?\"\n")) (define clerk-doesnt-know-text "The clerk apologizes and says she doesn't know about that topic.\n") -(define-mhandler (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) ((_ . info) - (<- clerk (message-from message) 'tell + (<- (message-from message) 'tell #:text (string-append "The clerk clears her throat and says:\n \"" info "\"\n"))) (#f - (<- clerk (message-from message) 'tell + (<- (message-from message) 'tell #:text clerk-doesnt-know-text)))) ('slacking - (<- clerk (message-from message) 'tell + (<- (message-from message) 'tell #:text "The clerk says, \"Sorry, I'm on my break.\"\n")))) -(define-mhandler (clerk-act-be-summoned clerk message who-summoned) +(define* (clerk-act-be-summoned clerk message #:key who-summoned) (match (slot-ref clerk 'state) ('on-duty - (<- clerk who-summoned 'tell + (<- who-summoned 'tell #:text "The clerk tells you as politely as she can that she's already here, so there's no need to ring the bell.\n")) ('slacking - (<- clerk (gameobj-loc clerk) 'tell-room + (<- (gameobj-loc clerk) 'tell-room #:text "The clerk's ears perk up, she stamps out a cigarette, and she runs out of the room!\n") (gameobj-set-loc! clerk (dyn-ref clerk 'room:lobby)) (slot-set! clerk 'patience 8) (slot-set! clerk 'state 'on-duty) - (<- clerk (gameobj-loc clerk) 'tell-room + (<- (gameobj-loc clerk) 'tell-room #:text (string-append " Suddenly, a uniformed woman rushes into the room! She's wearing a @@ -634,14 +599,12 @@ feel free to ask me. For example, 'ask clerk about changing name'. You can ask me about the following: " clerk-knows-about ".\"\n"))))) -(define-mhandler (clerk-cmd-dismiss clerk message) +(define* (clerk-cmd-dismiss clerk message . _) (define player-name - (message-ref - (<-wait clerk (message-from message) 'get-name) - 'val)) + (mbody-val (<-wait (message-from message) 'get-name))) (match (slot-ref clerk 'state) ('on-duty - (<- clerk (gameobj-loc clerk) 'tell-room + (<- (gameobj-loc clerk) 'tell-room #:text (format #f "\"Thanks ~a!\" says the clerk. \"I have somewhere I need to be.\" The clerk leaves the room in a hurry.\n" @@ -649,11 +612,11 @@ The clerk leaves the room in a hurry.\n" #:exclude (actor-id clerk)) (gameobj-set-loc! clerk (dyn-ref clerk 'room:break-room)) (slot-set! clerk 'state 'slacking) - (<- clerk (gameobj-loc clerk) 'tell-room + (<- (gameobj-loc clerk) 'tell-room #:text clerk-return-to-slacking-text #:exclude (actor-id clerk))) ('slacking - (<- clerk (message-from message) 'tell + (<- (message-from message) 'tell #:text "The clerk sternly asks you to not be so dismissive.\n")))) (define clerk-slacking-texts @@ -672,7 +635,9 @@ The clerk leaves the room in a hurry.\n" "The clerk takes a deep breath.\n" "The clerk yawns.\n" "The clerk drums her nails on the counter.\n" - "The clerk clicks around on the desk computer.\n")) + "The clerk clicks around on the desk computer.\n" + "The clerk thumbs through a printout of some physics paper.\n" + "The clerk mutters that her dissertation isn't going to write itself.\n")) (define clerk-slack-excuse-text "The desk clerk excuses herself, claiming she has important things to @@ -681,14 +646,23 @@ attend to.\n") (define clerk-return-to-slacking-text "The desk clerk enters and slams the door behind her.\n") -(define-mhandler (clerk-act-update-loop clerk message) + +(define (clerk-act-update-loop clerk message) (define (tell-room text) - (<- clerk (gameobj-loc clerk) 'tell-room + (<- (gameobj-loc clerk) 'tell-room #:text text #:exclude (actor-id clerk))) (define (loop-if-not-destructed) (if (not (slot-ref clerk 'destructed)) - (<- clerk (actor-id clerk) 'update-loop))) + ;; 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. + (<- (actor-id clerk) 'update-loop))) (match (slot-ref clerk 'state) ('slacking (tell-room (random-choice clerk-slacking-texts))