- (reply-message actor message
- #:val (slot-ref actor slot))))
-
-(define (filter-commands commands verb)
- (filter
- (lambda (cmd)
- (equal? (command-verbs cmd)
- verb))
- commands))
-
-(define-mhandler (gameobj-get-commands actor message verb)
- (define filtered-commands
- (filter-commands (slot-ref actor 'commands)
- verb))
- (<-reply actor message #:commands filtered-commands))
-
-(define-mhandler (gameobj-get-container-commands actor message verb)
- (define filtered-commands
- (filter-commands (slot-ref actor 'container-commands)
- verb))
- (<-reply actor message #:commands filtered-commands))
-
-(define-mhandler (gameobj-add-occupant! actor message who)
+ (<-reply message (slot-ref actor slot))))
+
+(define (gameobj-replace-step-occupants actor occupants)
+ ;; Snarf all the occupants!
+ (display "replacing occupant\n")
+ (when occupants
+ (for-each
+ (lambda (occupant)
+ (<-wait occupant 'set-loc!
+ #:loc (actor-id actor)))
+ occupants)))
+
+(define gameobj-replace-steps*
+ (list gameobj-replace-step-occupants))
+
+(define (run-replacement actor replaces replace-steps)
+ (when replaces
+ (mbody-receive (_ #:key occupants)
+ (<-wait replaces 'assist-replace)
+ (for-each
+ (lambda (replace-step)
+ (replace-step actor occupants))
+ replace-steps))))
+
+;; @@: This could be kind of a messy way of doing gameobj-act-init
+;; stuff. If only we had generic methods :(
+(define* (gameobj-act-init actor message #:key replace)
+ "Your most basic game object init procedure.
+Assists in its replacement of occupants if necessary and nothing else."
+ (run-replacement actor replace gameobj-replace-steps*))
+
+(define (gameobj-goes-by gameobj)
+ "Find the name we go by. Defaults to #:name if nothing else provided."
+ (cond ((slot-ref gameobj 'goes-by) =>
+ identity)
+ ((slot-ref gameobj 'name) =>
+ (lambda (name)
+ (list name)))
+ (else '())))
+
+(define (gameobj-act-goes-by actor message)
+ "Reply to a message requesting what we go by."
+ (<-reply 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)
+ (val-or-proc)
+ val-or-proc))
+
+(define (get-candidate-commands actor rmeta-sym verb)
+ (class-rmeta-ref (class-of actor) rmeta-sym verb
+ #:dflt '()))
+
+(define* (gameobj-get-commands actor message #:key verb)
+ "Get commands a co-occupant of the room might execute for VERB"
+ (define candidate-commands
+ (get-candidate-commands actor 'commands verb))
+ (<-reply message
+ #:commands candidate-commands
+ #:goes-by (gameobj-goes-by actor)))
+
+(define* (gameobj-get-container-commands actor message #:key verb)
+ "Get commands as the container / room of message's sender"
+ (define candidate-commands
+ (get-candidate-commands actor 'container-commands verb))
+ (<-reply message #:commands candidate-commands))
+
+(define* (gameobj-get-contained-commands actor message #:key verb)
+ "Get commands as being contained (eg inventory) of commanding gameobj"
+ (define candidate-commands
+ (get-candidate-commands actor 'contained-commands verb))
+ (<-reply message
+ #:commands candidate-commands
+ #:goes-by (gameobj-goes-by actor)))
+
+(define* (gameobj-add-occupant! actor message #:key who)
+ "Add an actor to our list of present occupants"