Document why the clerk-act-update-loop calls itself

[mudsync.git] / worlds / bricabrac.scm

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 12217bfe1c42e8f88fa6a5df296a06303f559305..84836fa7690ab0c19d81eeca9105f70ed3b1716d 100644 (file)
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -80,7 +80,7 @@
 ;;; Lobby
 ;;; -----
 
 ;;; 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)
   (define text-to-send
     (format #f "~a says: \"~a\"\n"
             (slot-ref actor 'name)


@@ -157,16 +157,14 @@ or 'skribe'?  Now *that's* composition!"))
   (and (irregex-match name-sre name)
        (not (member name forbidden-words))))
 
   (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
   (define old-name

-    (message-ref
-     (<-wait actor (message-from message) 'get-name)
-     'val))
+    (msg-val (<-wait actor (message-from message) 'get-name)))

   (define name indir-obj)
   (if (valid-name? indir-obj)
       (begin
   (define name indir-obj)
   (if (valid-name? indir-obj)
       (begin

-        (<-wait actor (message-from message) 'set-name!
-                #:val name)
+        (<-wait actor (message-from message) 'set-name! name)

         (<- actor (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 (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)))


@@ -199,19 +197,34 @@ character.\n")))
    #:init-value
    (simple-dispatcher summoning-bell-actions*)))
 
    #:init-value
    (simple-dispatcher summoning-bell-actions*)))
 

-(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
   (define who-rang

-    (message-ref
-     (<-wait bell (message-from message) 'get-name)
-     'val))
+    (msg-val (<-wait bell (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
       #:text "*ring ring!*  You ring the bell!\n")
   (<- bell (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
+  ;; ringing it.  Notice here's where we make use of the invoker's
+  ;; 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
       #:text
       (format #f "*ring ring!*  ~a rings the bell!\n"
               who-rang)
       #:exclude (message-from message))
   (<- bell (gameobj-loc bell) 'tell-room
       #:text
       (format #f "*ring ring!*  ~a rings the bell!\n"
               who-rang)
       #:exclude (message-from message))

-
+  ;; 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
       #:who-summoned (message-from message)))
 
   (<- bell (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned
       #:who-summoned (message-from message)))
 


@@ -364,7 +377,7 @@ if this room is intended for children or child-like adults."
    ('thing:cuddles-plushie
     <thing> 'room:playroom
     #:name "a cuddles plushie"
    ('thing:cuddles-plushie
     <thing> 'room:playroom
     #:name "a cuddles plushie"

-    #:goes-by '("plushie" "cuddles plushie")
+    #:goes-by '("plushie" "cuddles plushie" "cuddles")

     #:takeable #t
     #:desc "  A warm and fuzzy cuddles plushie!  It's a cuddlefish!")))
 
     #:takeable #t
     #:desc "  A warm and fuzzy cuddles plushie!  It's a cuddlefish!")))
 


@@ -400,11 +413,9 @@ if this room is intended for children or child-like adults."
       (cmd-sit-furniture (wrap-apply furniture-cmd-sit)))
      gameobj-actions))))
 
       (cmd-sit-furniture (wrap-apply furniture-cmd-sit)))
      gameobj-actions))))
 

-(define-mhandler (furniture-cmd-sit actor message direct-obj)
+(define* (furniture-cmd-sit actor message #:key direct-obj)

   (define player-name
   (define player-name

-    (message-ref
-     (<-wait actor (message-from message) 'get-name)
-     'val))
+    (msg-val (<-wait actor (message-from message) 'get-name)))

   (<- actor (message-from message) 'tell
       #:text (format #f "You ~a ~a.\n"
                      (slot-ref actor 'sit-phrase)
   (<- actor (message-from message) 'tell
       #:text (format #f "You ~a ~a.\n"
                      (slot-ref actor 'sit-phrase)


@@ -513,7 +524,7 @@ seat in the room, though."
    #:init-value
    (simple-dispatcher clerk-actions*)))
 
    #:init-value
    (simple-dispatcher clerk-actions*)))
 

-(define-mhandler (clerk-act-init clerk message)
+(define (clerk-act-init clerk message)

   ;; call the gameobj main init method
   (gameobj-act-init clerk message)
   ;; start our main loop
   ;; call the gameobj main init method
   (gameobj-act-init clerk message)
   ;; start our main loop


@@ -555,7 +566,7 @@ 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..."))
 
 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
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk (message-from message) 'tell


@@ -568,14 +579,14 @@ with tuition at where it is..."))
           (random-choice clerk-slacking-complaints)
           "\"\n")))))
 
           (random-choice clerk-slacking-complaints)
           "\"\n")))))
 

-(define-mhandler (clerk-cmd-ask-incomplete clerk message)
+(define (clerk-cmd-ask-incomplete clerk message)

   (<- clerk (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")
 
   (<- clerk (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 indir-obj)

   (match (slot-ref clerk 'state)
     ('on-duty
      (match (assoc (pk 'indir indir-obj) clerk-help-topics)
   (match (slot-ref clerk 'state)
     ('on-duty
      (match (assoc (pk 'indir indir-obj) clerk-help-topics)


@@ -592,7 +603,7 @@ with tuition at where it is..."))
      (<- clerk (message-from message) 'tell
          #:text "The clerk says, \"Sorry, I'm on my break.\"\n"))))
 
      (<- clerk (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
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk who-summoned 'tell


@@ -618,22 +629,22 @@ feel free to ask me.  For example, 'ask clerk about changing name'.
 You can ask me about the following:
 " clerk-knows-about ".\"\n")))))
 
 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
   (define player-name

-    (message-ref
-     (<-wait clerk (message-from message) 'get-name)
-     'val))
+    (msg-val (<-wait clerk (message-from message) 'get-name)))

   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk (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"
   (match (slot-ref clerk 'state)
     ('on-duty
      (<- clerk (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"

-                 player-name))
+                 player-name)
+         #: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-set-loc! clerk (dyn-ref clerk 'room:break-room))
      (slot-set! clerk 'state 'slacking)
      (<- clerk (gameobj-loc clerk) 'tell-room

-         #:text clerk-return-to-slacking-text))
+         #:text clerk-return-to-slacking-text
+         #:exclude (actor-id clerk)))

     ('slacking
      (<- clerk (message-from message) 'tell
          #:text "The clerk sternly asks you to not be so dismissive.\n"))))
     ('slacking
      (<- clerk (message-from message) 'tell
          #:text "The clerk sternly asks you to not be so dismissive.\n"))))


@@ -663,42 +674,48 @@ attend to.\n")
 (define clerk-return-to-slacking-text
   "The desk clerk enters and slams the door behind her.\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
   (define (tell-room text)
     (<- clerk (gameobj-loc clerk) 'tell-room

-        #:text text))
-  (define (loop return)
-    (define (stop-if-destructed)
-      (if (slot-ref clerk 'destructed)
-          (return #f)))
-    (match (slot-ref clerk 'state)
-      ('slacking
-       (tell-room (random-choice clerk-slacking-texts))
-       (8sleep (+ (random 10) 10))
-       (stop-if-destructed)
-       (loop return))
-      ('on-duty
-       (if (> (slot-ref clerk 'patience) 0)
-           ;; Keep working but lose patience gradually
-           (begin
-             (tell-room (random-choice clerk-working-impatience-texts))
-             (slot-set! clerk 'patience (- (slot-ref clerk 'patience)
-                                           (+ (random 2) 1)))
-             (8sleep (+ (random 25) 20))
-             (stop-if-destructed)
-             (loop return))
-           ;; Back to slacking
-           (begin
-             (tell-room clerk-slack-excuse-text)
-             ;; back bto the break room
-             (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'room:break-room)))
-             (tell-room clerk-return-to-slacking-text)
-             ;; annnnnd back to slacking
-             (slot-set! clerk 'state 'slacking)
-             (8sleep (+ (random 30) 15))
-             (stop-if-destructed)
-             (loop return))))))
-  (call/ec loop))
+        #:text text
+        #: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
+     (tell-room (random-choice clerk-slacking-texts))
+     (8sleep (+ (random 10) 10))
+     (loop-if-not-destructed))
+    ('on-duty
+     (if (> (slot-ref clerk 'patience) 0)
+         ;; Keep working but lose patience gradually
+         (begin
+           (tell-room (random-choice clerk-working-impatience-texts))
+           (slot-set! clerk 'patience (- (slot-ref clerk 'patience)
+                                         (+ (random 2) 1)))
+           (8sleep (+ (random 25) 20))
+           (loop-if-not-destructed))
+         ;; Back to slacking
+         (begin
+           (tell-room clerk-slack-excuse-text)
+           ;; back bto the break room
+           (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'room:break-room)))
+           (tell-room clerk-return-to-slacking-text)
+           ;; annnnnd back to slacking
+           (slot-set! clerk 'state 'slacking)
+           (8sleep (+ (random 30) 15))
+           (loop-if-not-destructed))))))
+

 
 (define break-room
   (lol
 
 (define break-room
   (lol