+
+(define (gameobj-replace-data-occupants gameobj)
+ "The general purpose list of replacement data"
+ (list #:occupants (hash-map->list (lambda (occupant _) occupant)
+ (slot-ref gameobj 'occupants))))
+
+(define (gameobj-replace-data* gameobj)
+ ;; For now, just call gameobj-replace-data-occupants.
+ ;; But there may be more in the future!
+ (gameobj-replace-data-occupants gameobj))
+
+;; So sad that objects must assist in their replacement ;_;
+;; But that's life in a live hacked game!
+(define (gameobj-act-assist-replace gameobj message)
+ "Vanilla method for assisting in self-replacement for live hacking"
+ (apply <-reply message
+ (gameobj-replace-data* gameobj)))
+
+(define (gameobj-ok-to-be-taken-from gameobj message whos-acting)
+ (call-with-values (lambda ()
+ (slot-ref-maybe-runcheck gameobj 'take-me?
+ whos-acting #:from #t))
+ ;; This allows this to reply with #:why-not if appropriate
+ (lambda args
+ (apply <-reply message args))))
+
+(define (gameobj-ok-to-be-put-in gameobj message whos-acting where)
+ (call-with-values (lambda ()
+ (slot-ref-maybe-runcheck gameobj 'drop-me?
+ whos-acting where))
+ ;; This allows this to reply with #:why-not if appropriate
+ (lambda args
+ (apply <-reply message args))))
+
+\f
+;;; Utilities every gameobj has
+;;; ---------------------------
+
+(define (dyn-ref gameobj special-symbol)
+ "Dynamically look up a special object from the gm"
+ (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
+ (#f #f)
+ ;; otherwise it's probably an address, return it as-is
+ (_ special-symbol)))
+
+
+\f
+;;; 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)))
+ (define player-name
+ (mbody-val (<-wait player 'get-name)))
+ (define player-loc
+ (mbody-val (<-wait player 'get-loc)))
+ (define our-name (slot-ref gameobj 'name))
+ (define self-should-take
+ (slot-ref-maybe-runcheck gameobj 'take-me? player))
+ ;; @@: Is there any reason to allow the room to object in the way
+ ;; that there is for dropping? It doesn't seem like it.
+ (call-with-values (lambda ()
+ (slot-ref-maybe-runcheck gameobj 'take-me? player))
+ (lambda* (self-should-take #:key (why-not
+ `("It doesn't seem like you can take "
+ ,our-name ".")))
+ (if self-should-take
+ ;; Set the location to whoever's picking us up
+ (begin
+ (gameobj-set-loc! gameobj player)
+ (<- player 'tell
+ #:text (format #f "You pick up ~a.\n"
+ our-name))
+ (<- player-loc 'tell-room
+ #:text (format #f "~a picks up ~a.\n"
+ player-name
+ our-name)
+ #:exclude player))
+ (<- player 'tell #:text why-not)))))
+
+(define* (cmd-drop gameobj message
+ #:key direct-obj
+ (player (message-from message)))
+ (define player-name
+ (mbody-val (<-wait player 'get-name)))
+ (define player-loc
+ (mbody-val (<-wait player 'get-loc)))
+ (define our-name (slot-ref gameobj 'name))
+ (define should-drop
+ (slot-ref-maybe-runcheck gameobj 'drop-me? player))
+ (define (room-objection-to-drop)
+ (mbody-receive (_ drop-ok? #:key why-not) ; does the room object to dropping?
+ (<-wait player-loc 'ok-to-drop-here? player (actor-id gameobj))
+ (and (not drop-ok?)
+ ;; Either give the specified reason, or give a boilerplate one
+ (or why-not
+ `("You'd love to drop " ,our-name
+ " but for some reason it doesn't seem like you can"
+ " do that here.")))))
+ (cond
+ ((not player-loc)
+ (<- player 'tell
+ #:text `("It doesn't seem like you can drop " ,our-name
+ " here, because you don't seem to be anywhere?!?")))
+ ;; TODO: Let ourselves supply a reason why not.
+ ((not should-drop)
+ (<- player 'tell
+ #:text (format #f "It doesn't seem like you can drop ~a.\n"
+ our-name)))
+ ((room-objection-to-drop)
+ (<- player 'tell
+ #:text room-objection-to-drop))
+ (else
+ (gameobj-set-loc! gameobj player-loc)
+ ;; TODO: Allow more flavortext here.
+ (<- player 'tell
+ #:text (format #f "You drop ~a.\n"
+ our-name))
+ (<- player-loc 'tell-room
+ #:text (format #f "~a drops ~a.\n"
+ player-name
+ our-name)
+ #:exclude player))))
+
+(define* (cmd-take-from-no-op gameobj message
+ #:key direct-obj indir-obj preposition
+ (player (message-from message)))
+ (<- player 'tell
+ #:text `("It doesn't seem like you can take anything "
+ ,preposition " "
+ ,(slot-ref gameobj 'name) ".")))
+
+(define* (cmd-put-in-no-op gameobj message
+ #:key direct-obj indir-obj preposition
+ (player (message-from message)))
+ (<- player 'tell
+ #:text `("It doesn't seem like you can put anything "
+ ,preposition " "
+ ,(slot-ref gameobj 'name) ".")))