Moving looking to be primarily a gameobj action.

[mudsync.git] / mudsync / room.scm

diff --git a/mudsync/room.scm b/mudsync/room.scm
index 1e0f354ec0cc01a74f51235f3b9de953a92a80bb..69385f6e2583b5d2c02f5e9c7038ce2fa63fda36 100644 (file)
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -19,6 +19,7 @@
 (define-module (mudsync room)
   #:use-module (mudsync command)
   #:use-module (mudsync gameobj)
+  #:use-module (mudsync utils)
   #:use-module (8sync actors)
   #:use-module (8sync agenda)
   #:use-module (oop goops)
@@ -66,17 +67,22 @@
          #:init-keyword #:exits
          #:getter room-exits)
 
-  (container-commands
+  (container-dom-commands
    #:allocation #:each-subclass
    #:init-thunk
    (build-commands
-    ("look" ((loose-direct-command cmd-look-at)
-             (empty-command cmd-look-room)))
+    (("l" "look") ((empty-command cmd-look-room)))
     ("go" ((empty-command cmd-go-where)
            (loose-direct-command cmd-go)))
     (("say" "\"" "'") ((greedy-command cmd-say)))
     (("emote" "/me") ((greedy-command cmd-emote)))))
 
+  (container-sub-commands
+   #:allocation #:each-subclass
+   #:init-thunk
+   (build-commands
+    (("l" "look") ((loose-direct-command cmd-look-at-from-room)))))
+
   (actions #:allocation #:each-subclass
            #:init-thunk
            (build-actions
@@ -88,7 +94,7 @@
             ;; in this case the command is the same version as the normal
             ;; look-room version
             (cmd-look-room room-look-room)
-            (cmd-look-at room-look-at)
+            (cmd-look-at-from-room room-look-dont-see-it)
             (cmd-say room-cmd-say)
             (cmd-emote room-cmd-emote))))
 
@@ -185,33 +191,17 @@
    (lambda (return)
      (for-each
       (lambda (occupant)
-        (mbody-receive (_ #:key goes-by)
-            (<-wait occupant 'goes-by)
-          (if (member called-this goes-by)
-              (return occupant))))
+        (define goes-by (mbody-val (<-wait occupant 'goes-by)))
+        (if (ci-member called-this goes-by)
+            (return occupant)))
       (hash-map->list (lambda (key val) key)
                       (slot-ref room 'occupants)))
      #f)))
 
-(define %formless-desc
-  "You don't see anything special.")
-
-(define* (room-look-at room message #:key direct-obj)
-  "Look at a specific object in the room."
-  (define matching-object
-    (room-find-thing-called room direct-obj))
-
-  (cond
-   (matching-object
-    (let ((obj-desc
-           (mbody-val (<-wait matching-object 'get-desc
-                            #:whos-looking (message-from message)))))
-      (if obj-desc
-          (<- (message-from message) 'tell #:text obj-desc)
-          (<- (message-from message) 'tell #:text %formless-desc))))
-   (else
-    (<- (message-from message) 'tell
-        #:text "You don't see that here, so you can't look at it.\n"))))
+(define* (room-look-dont-see-it room message #:key direct-obj)
+  "In general, if we get to this point, we didn't find something to look at."
+  (<- (message-from message) 'tell
+      #:text "You don't see that here, so you can't look at it.\n"))
 
 
 (define* (room-tell-room room text #:key exclude wait)