You can now look at things

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 827876955432036712c4f8bae655f89573e66ee6..3e23ae6ff7b7054e7fe3fe26e614588b724f1b2f 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -52,7 +52,7 @@
    (set-loc! (wrap-apply gameobj-set-loc!))
    (get-name (wrap-apply gameobj-get-name))
    (get-desc (wrap-apply gameobj-get-desc))
    (set-loc! (wrap-apply gameobj-set-loc!))
    (get-name (wrap-apply gameobj-get-name))
    (get-desc (wrap-apply gameobj-get-desc))

-   (goes-by (wrap-apply gameobj-goes-by))
+   (goes-by (wrap-apply gameobj-act-goes-by))

    (visible-name (wrap-apply gameobj-visible-name))))
 
 ;;; *all* game components that talk to players should somehow
    (visible-name (wrap-apply gameobj-visible-name))))
 
 ;;; *all* game components that talk to players should somehow


@@ -77,7 +77,7 @@
   (goes-by #:init-keyword #:goes-by
            #:init-value #f)
 
   (goes-by #:init-keyword #:goes-by
            #:init-value #f)
 

-  (desc #:init-value ""
+  (desc #:init-value #f

         #:init-keyword #:desc)
 
   ;; how to print our name
         #:init-keyword #:desc)
 
   ;; how to print our name


@@ -127,6 +127,11 @@
            (list name)))
         (else '())))
 
            (list name)))
         (else '())))
 

+(define (gameobj-act-goes-by actor message)
+  "Reply to a message requesting what we go by."
+  (<-reply actor message
+           #:goes-by (gameobj-goes-by actor)))
+

 (define (val-or-run val-or-proc)
   "Evaluate if a procedure, or just return otherwise"
   (if (procedure? val-or-proc)
 (define (val-or-run val-or-proc)
   "Evaluate if a procedure, or just return otherwise"
   (if (procedure? val-or-proc)

diff --git a/mudsync/room.scm b/mudsync/room.scm
index efc2a380e9b2ea13436c1207cd51737b7cdd6ace..a84550d630c726f7e6588d63a740d4d07bfed0ef 100644 (file)
--- 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 (8sync agenda)
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)

+  #:use-module (ice-9 control)

   #:export (<room>
             room-actions
             room-actions*
   #: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
    (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))
 
 (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))))
    ;; 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"))))