(define-mhandler (gm-lookup-special actor message symbol)
(<-reply actor message
- #:room-id (hash-ref (slot-ref actor 'special-dir) symbol)))
+ #:val (hash-ref (slot-ref actor 'special-dir) symbol)))
(define-mhandler (gm-write-home actor message text)
(define client-id (hash-ref (gm-reverse-client-dir actor)
#:text (format #f "You see ~a materialize out of thin air!\n"
guest-name)
#:exclude player)))))
-
gameobj-occupants
gameobj-actions
- gameobj-self-destruct))
+ gameobj-self-destruct
+
+ dyn-ref))
;;; Gameobj
;;; =======
(define occupants
(message-ref replace-reply 'occupants #f))
;; Snarf all the occupants!
+ (display "replacing occupant\n")
(when occupants
(for-each
(lambda (occupant)
(list gameobj-replace-step-occupants))
(define (run-replacement actor message replace-steps)
- (define replaces (message-ref message 'replaces #f))
+ (define replaces (pk 'replace (message-ref message 'replace #f)))
(when replaces
(let ((replace-reply
- (<-wait actor replaces 'assist-replace)))
+ (pk 'replace-reply (<-wait actor replaces 'assist-replace))))
(for-each
(lambda (replace-step)
(replace-step actor replace-reply))
replace-steps))))
-
;; @@: This could be kind of a messy way of doing gameobj-init
;; stuff. If only we had generic methods :(
(define-mhandler (gameobj-init actor message)
"Your most basic game object init procedure.
Assists in its replacement of occupants if necessary and nothing else."
+ (display "gameobj init!\n")
(run-replacement actor message gameobj-replace-steps*))
(define (gameobj-goes-by gameobj)
"Vanilla method for assisting in self-replacement for live hacking"
(apply <-reply actor message
(gameobj-replace-data* actor)))
+
+\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? _)
+ (message-ref
+ (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special
+ #:symbol special-symbol)
+ 'val))
+ ;; if it's false, return nothing
+ ((#f #f))
+ ;; otherwise it's probably an address, return it as-is
+ (_ special-symbol)))
;;; =====
(define-class <exit> ()
- ;; Used for wiring
- (to-symbol #:init-keyword #:to-symbol)
- ;; The actual address we use
- (to-address #:init-keyword #:address)
+ (to #:init-keyword #:to)
;; Name of the room (@@: Should this be names?)
(name #:getter exit-name
#:init-keyword #:name)
(define room-actions
(build-actions
- ;; desc == description
- (init (wrap-apply room-init))
- (wire-exits! (wrap-apply room-wire-exits!))
(cmd-go (wrap-apply room-cmd-go))
(cmd-go-where (wrap-apply room-cmd-go-where))
(announce-entrance (wrap-apply room-announce-entrance))
;; @@: Can remove this indirection once things settle
#:init-value (wrap-apply room-action-dispatch)))
-(define (room-init room message)
- (room-wire-exits! room))
-
-(define (room-wire-exits! room)
- "Actually hook up the rooms' exit addresses to the rooms they
-claim to point to."
- (for-each
- (lambda (exit)
- (define new-exit
- (message-ref
- (<-wait room (gameobj-gm room) 'lookup-special
- #:symbol (slot-ref exit 'to-symbol))
- 'room-id))
-
- (slot-set! exit 'to-address new-exit))
-
- (room-exits room)))
-
(define-mhandler (room-cmd-go room message direct-obj)
(define exit
(find
(equal? (exit-name exit) direct-obj))
(room-exits room)))
(define to-address (if exit
- (slot-ref exit 'to-address)
+ ;; Get the exit, but resolve it dynamically
+ ;; in case it's a special
+ (dyn-ref room (slot-ref exit 'to))
#f))
(define player-name
(message-ref (<-wait room (message-from message)
(<- room to-address 'announce-entrance
#:who-entered (message-from message))
;; Have the new room update the player to the new location
- (<- room (slot-ref exit 'to-address) 'look-room
+ (<- room to-address 'look-room
#:to-id (message-from message)))
(else
(<- room (message-from message) 'tell
#:exits
(list (make <exit>
#:name "north"
- #:to-symbol 'room:grand-hallway)))
+ #:to 'room:grand-hallway)))
;; NPC: hotel owner
('npc:hotel-owner
<chatty-npc> 'room:lobby
#:exits
(list (make <exit>
#:name "south"
- #:to-symbol 'room:lobby))
+ #:to 'room:lobby))
)))
\f
#:exits
(list (make <exit>
#:name "east"
- #:to-symbol 'room:north-hallway
+ #:to 'room:north-hallway
#:desc wooden-unlocked-door))) ; eventually make this locked so you have
; to kick it down, joeyh style!
('room:north-hallway
#:exits
(list (make <exit>
#:name "west"
- #:to-symbol 'room:server-room
+ #:to 'room:server-room
#:desc wooden-unlocked-door)
(make <exit>
#:name "east"
- #:to-symbol 'room:code-a-plex
+ #:to 'room:code-a-plex
#:desc metal-stiff-door)
;; (make <exit>
;; #:name "south"
- ;; #:to-symbol 'center-hallway)
+ ;; #:to 'center-hallway)
))
('room:code-a-plex
#:exits
(list (make <exit>
#:name "west"
- #:to-symbol 'room:north-hallway
+ #:to 'room:north-hallway
#:desc metal-stiff-door)))
('thing:typewriter
;; #:exits
;; ,(list (make <exit>
;; #:name "east"
-;; #:to-symbol 'room:))
+;; #:to 'room:))
;; )
(define (goblin-demo . args)
projects / mudsync.git / commitdiff