From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Thu, 5 May 2016 20:15:37 +0000 (-0500)
Subject: You can now look at things
X-Git-Tag: fosdem-2017~175
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=d198683d31a3b359e26cc688cc04cebc8ca978c6;p=mudsync.git

You can now look at things
---

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 8278769..3e23ae6 100644
--- 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))
-   (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
@@ -77,7 +77,7 @@
   (goes-by #:init-keyword #:goes-by
            #:init-value #f)
 
-  (desc #:init-value ""
+  (desc #:init-value #f
         #:init-keyword #:desc)
 
   ;; how to print our name
@@ -127,6 +127,11 @@
            (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)
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"))))