X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=3957e0a4d40303898888af5828632f9e7f0525cb;hp=6011be2fccc1d07ecf2004f8b7c26c08f89e8359;hb=HEAD;hpb=fc80f814a2ebd5e562e9e5dbf74eea8daf063db7

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 6011be2..fbf4a72 100644
--- 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.
 ;;;
@@ -32,8 +32,10 @@
   #:use-module (oop goops)
   #:export (<gameobj>
 
+            create-gameobj
             gameobj-loc
             gameobj-gm
+            gameobj-desc
 
             gameobj-act-init
             gameobj-set-loc!
@@ -47,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))
 
@@ -84,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)
@@ -102,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!
@@ -178,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)
@@ -187,6 +193,27 @@
 ;;; gameobj message handlers
 ;;; ========================
 
+;; TODO: This init stuff is a mess, and should be redone now that
+;;   we have the *init* action stuff.  We've really spread out the
+;;   logic for creating a gameobj in several places, eg gm-inject-special!
+(define (create-gameobj class gm loc . args)
+  "Create a gameobj of CLASS with GM and set to location LOC, applying rest of ARGS.
+Note that this doesn't do any special dyn-ref of the location."
+  (let ((new-gameobj (apply create-actor (%current-actor) class
+                            #:gm gm args)))
+    ;; Set the location
+    (<-wait new-gameobj 'set-loc! #:loc loc)
+    ;; Initialize the object
+    (<-wait new-gameobj 'init)))
+
+;; ;; @@: Should we also dyn-ref the loc here?  We can do that, unlike with
+;; ;;   create-gameobj.
+;; ;;   Another route could be to have set-loc! itself know how to use the
+;; ;;   dyn-ref.
+;; (define (gameobj-create-gameobj gameobj class loc . args)
+;;   "Like create-gameobj but saves the step of passing in the gm."
+;;   (apply create-gameobj class (gameobj-gm gameobj) loc args))
+
 ;; Kind of a useful utility, maybe?
 (define (simple-slot-getter slot)
   (lambda (actor message)
@@ -214,6 +241,7 @@
          (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))
@@ -223,7 +251,8 @@
   ;; 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))))
 
@@ -242,7 +271,7 @@
   (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."
@@ -365,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)
@@ -455,6 +484,8 @@ By default, this is whether or not the generally-visible flag is set."
   (match special-symbol
     ;; if it's a symbol, look it up dynamically
     ((? symbol? _)
+     ;; TODO: If we get back an #f at this point, should we throw
+     ;;   an error?  Obviously #f is okay, but maybe not if 
      (mbody-val (<-wait (slot-ref gameobj 'gm) 'lookup-special
                         #:symbol special-symbol)))
     ;; if it's false, return nothing
@@ -467,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)))