X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=a84550d630c726f7e6588d63a740d4d07bfed0ef;hp=efc2a380e9b2ea13436c1207cd51737b7cdd6ace;hb=d198683d31a3b359e26cc688cc04cebc8ca978c6;hpb=582ae7c4ffaddad629c53750b80c807745489b37

diff --git a/mudsync/room.scm b/mudsync/room.scm
index efc2a38..a84550d 100644
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -23,6 +23,7 @@
   #:use-module (8sync agenda)
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 control)
   #:export (<room>
             room-actions
             room-actions*
@@ -82,7 +83,8 @@
    (look-room (wrap-apply room-look-room))
    ;; in this case the command is the same version as the normal
    ;; look-room version
-   (cmd-look-room (wrap-apply room-look-room))))
+   (cmd-look-room (wrap-apply room-look-room))
+   (cmd-look-at (wrap-apply room-look-at))))
 
 (define room-actions*
   (append room-actions gameobj-actions))
@@ -213,3 +215,42 @@ claim to point to."
    ;; sender of the message
    (message-ref message 'to-id
                 (message-from message))))
+
+(define (room-find-thing-called room called-this)
+  "Find something called CALLED-THIS in the room, if any."
+  (call/ec
+   (lambda (return)
+     (for-each
+      (lambda (occupant)
+        (define goes-by
+          (message-ref (<-wait room occupant 'goes-by)
+                       'goes-by #f))
+        (display "here!\n")
+        (if (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 about it.")
+
+(define-mhandler (room-look-at room message 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
+           (message-ref
+            (<-wait room matching-object 'get-desc)
+            'val)))
+      (if obj-desc
+          (<- room (message-from message) 'tell
+              #:text (string-append obj-desc "\n"))
+          (<- room (message-from message) 'tell
+              #:text (string-append %formless-desc "\n")))))
+   (else
+    (<- room (message-from message) 'tell
+        #:text "You don't see that here, so you can't look at it.\n"))))