You can now kiss the frog!

[mudsync.git] / mudsync / gameobj.scm

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 21c655980b4d33d52c7dbd45fb250b9bb37c6045..fbf4a72b1a4deb804c7486d24f85a64009915657 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -1,5 +1,5 @@
 ;;; Mudsync --- Live hackable MUD
-;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of Mudsync.
 ;;;
@@ -35,6 +35,7 @@
             create-gameobj
             gameobj-loc
             gameobj-gm
+            gameobj-desc
 
             gameobj-act-init
             gameobj-set-loc!
@@ -48,6 +49,7 @@
             dyn-ref
 
             ;; Some of the more common commands
+            cmd-look-at
             cmd-take cmd-drop
             cmd-take-from-no-op cmd-put-in-no-op))
 
@@ -85,11 +87,12 @@
   ;; Commands we can handle
   (commands #:allocation #:each-subclass
             #:init-thunk (build-commands
+                          (("l" "look") ((direct-command cmd-look-at)))
                           ("take" ((direct-command cmd-take)
                                    (prep-indir-command cmd-take-from
                                                        '("from" "out of"))))
                           ("put" ((prep-indir-command cmd-put-in
-                                                      '("in" "inside" "on"))))))
+                                                      '("in" "inside" "into" "on"))))))
 
   ;; Commands we can handle by being something's container
   ;;   dominant version (goes before everything)
@@ -103,6 +106,7 @@
   (contained-commands #:allocation #:each-subclass
                       #:init-thunk 
                       (build-commands
+                       (("l" "look") ((direct-command cmd-look-at)))
                        ("drop" ((direct-command cmd-drop #:obvious? #f)))))
 
   ;; The extremely squishy concept of "props"... properties!
@@ -179,6 +183,7 @@
             (ok-to-be-put-in? gameobj-ok-to-be-put-in)
 
             ;; Common commands
+            (cmd-look-at cmd-look-at)
             (cmd-take cmd-take)
             (cmd-drop cmd-drop)
             (cmd-take-from cmd-take-from-no-op)
@@ -236,6 +241,7 @@ Note that this doesn't do any special dyn-ref of the location."
          (replace-step actor occupants))
        replace-steps))))
 
+(define %nothing (cons '*the* '*nothing*))
 (define (gameobj-setup-props gameobj)
   (define class (class-of gameobj))
   (define props (slot-ref gameobj 'props))
@@ -245,7 +251,8 @@ Note that this doesn't do any special dyn-ref of the location."
   ;; and use that to build up the table
   (hash-for-each
    (lambda (key value)
-     (when (not (hashq-ref props key value)) ; don't override init'ed instance values
+     (when (eq? (hashq-ref props key %nothing) ; don't override init'ed instance values
+                %nothing)
        (hashq-set! props key value)))
    (rmeta-slot-cache (class-slot-ref class 'initial-props))))
 
@@ -264,7 +271,7 @@ Note that this doesn't do any special dyn-ref of the location."
   (hashq-set! (slot-ref gameobj 'props) key val))
 
 (define* (gameobj-act-get-prop actor message key #:optional dflt)
-  (gameobj-get-prop actor key dflt))
+  (<-reply message (gameobj-get-prop actor key dflt)))
 
 (define (gameobj-goes-by gameobj)
   "Find the name we go by.  Defaults to #:name if nothing else provided."
@@ -387,10 +394,10 @@ and whos-asking, and see if we should just return it or run it."
 (define* (gameobj-act-set-name! actor message val)
   (slot-set! actor 'name val))
 
-(define* (gameobj-desc actor #:key whos-looking)
-  (match (slot-ref actor 'desc)
+(define* (gameobj-desc gameobj #:key whos-looking)
+  (match (slot-ref gameobj 'desc)
     ((? procedure? desc-proc)
-     (desc-proc actor whos-looking))
+     (desc-proc gameobj whos-looking))
     (desc desc)))
 
 (define* (gameobj-get-desc actor message #:key whos-looking)
@@ -491,6 +498,17 @@ By default, this is whether or not the generally-visible flag is set."
 ;;; Basic actions
 ;;; -------------
 
+(define %formless-desc
+  "You don't see anything special.")
+
+(define* (cmd-look-at gameobj message
+                      #:key direct-obj
+                      (player (message-from message)))
+  (let ((desc
+         (or (gameobj-desc gameobj #:whos-looking player)
+             %formless-desc)))
+    (<- player 'tell #:text desc)))
+
 (define* (cmd-take gameobj message
                    #:key direct-obj
                    (player (message-from message)))