Update codebase to use 8sync-fibers

[mudsync.git] / mudsync / room.scm

diff --git a/mudsync/room.scm b/mudsync/room.scm
index 1667b10ec47eef4fb0e55618d7718cbc7fb7a69f..403d610aab35a917b15349107c63af8e382588b6 100644 (file)
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -32,7 +32,8 @@
 ;;; =====
 
 (define-class <exit> ()
-  (to #:init-keyword #:to)
+  (to #:init-keyword #:to
+      #:init-value #f)
   ;; Name of the room (@@: Should this be names?)
   (name #:getter exit-name
         #:init-keyword #:name)
@@ -153,41 +154,48 @@
                          #f))
   (define player (message-from message))
   (define player-name
-    (mbody-val (<-wait player 'get-name)))
+    (<-wait player 'get-name))
   (cond
    (exit
     (call-with-values (lambda ()
                         (exit-can-traverse? exit room player))
       (lambda* (can-traverse? #:optional player-flavortext
                               room-flavortext)
-        (if can-traverse?
-            ;; looks like we can go, so let's go!
-            (begin
-              ;; Set the player's new location
-              (<-wait player 'set-loc!
-                      #:loc to-address)
-              (when player-flavortext
-                (<-wait player 'tell
-                        #:text player-flavortext))
-              ;; Tell everyone else the person walked away
-              (room-tell-room
-               room (or room-flavortext
-                        (format #f "~a wanders ~a.\n"
-                                player-name direct-obj)))
-              (<- to-address 'announce-entrance
-                  #:who-entered player)
-              ;; Have the new room update the player to the new location
-              (<- to-address 'look-room
-                  #:to-id player))
-            ;; Otherwise, if we can't go...
-            (begin
-              (<- player 'tell
-                  #:text (or player-flavortext
-                             `("You try to go " ,direct-obj " but something "
-                               "seems to block you.")))
-              (when room-flavortext
-                (room-tell-room room room-flavortext
-                                #:exclude player)))))))
+        (cond
+         ;; The exit itself objects to moving
+         ((not can-traverse?)
+          (<- player 'tell
+              #:text (or player-flavortext
+                         `("You try to go " ,direct-obj " but something "
+                           "seems to block you.")))
+          (when room-flavortext
+            (room-tell-room room room-flavortext
+                            #:exclude player)))
+         ;; to-address points nowhere, or exit not set.
+         ((not exit)
+          (<- player 'tell
+              #:text '((i "Yikes!") " Something weird is going on. "
+                       "It seems like this exit leads nowhere, "
+                       "in a programming bug kind of way. "
+                       "Maybe tell an administrator?")))
+         ;; looks like we can go, so let's go!
+         (else
+          ;; Set the player's new location
+          (<-wait player 'set-loc!
+                  #:loc to-address)
+          (when player-flavortext
+            (<-wait player 'tell
+                    #:text player-flavortext))
+          ;; Tell everyone else the person walked away
+          (room-tell-room
+           room (or room-flavortext
+                    (format #f "~a wanders ~a.\n"
+                            player-name direct-obj)))
+          (<- to-address 'announce-entrance
+              #:who-entered player)
+          ;; Have the new room update the player to the new location
+          (<- to-address 'look-room
+              #:to-id player))))))
    (else
     (<- player 'tell
         #:text "You don't see any way to go there.\n"))))
@@ -209,10 +217,12 @@
   (define occupant-names-all
     (map
      (lambda (occupant)
-       (call-with-message (<-wait occupant 'visible-name
-                                  #:whos-looking player-id)
-                          (lambda* (_ #:key text)
-                            text)))
+       (call-with-values
+           (lambda ()
+             (<-wait occupant 'visible-name
+                     #:whos-looking player-id))
+         (lambda* (#:key text)
+           text)))
      (remove
       (lambda (x) (equal? x player-id))
       (hash-map->list (lambda (x _) x)
@@ -253,7 +263,7 @@
    (lambda (return)
      (for-each
       (lambda (occupant)
-        (define goes-by (mbody-val (<-wait occupant 'goes-by)))
+        (define goes-by (<-wait occupant 'goes-by))
         (if (ci-member called-this goes-by)
             (return occupant)))
       (hash-map->list (lambda (key val) key)
@@ -288,7 +298,7 @@
 (define* (room-cmd-say room message #:key phrase)
   "Command: Say something to room participants."
   (define player-name
-    (mbody-val (<-wait (message-from message) 'get-name)))
+    (<-wait (message-from message) 'get-name))
   (define message-to-send
     `((b "<" ,player-name ">") " " ,phrase))
   (room-tell-room room message-to-send))
@@ -296,14 +306,14 @@
 (define* (room-cmd-emote room message #:key phrase)
   "Command: Say something to room participants."
   (define player-name
-    (mbody-val (<-wait (message-from message) 'get-name)))
+    (<-wait (message-from message) 'get-name))
   (define message-to-send
     `((b "* " ,player-name) " " ,phrase))
   (room-tell-room room message-to-send))
 
 (define* (room-announce-entrance room message #:key who-entered)
   (define player-name
-    (mbody-val (<-wait who-entered 'get-name)))
+    (<-wait who-entered 'get-name))
   (define message-to-send
     (format #f "~a enters the room.\n" player-name))
   (room-tell-room room message-to-send