From 50cd2aba8f13ec7aecb58a683aa55ae665cf83ab Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 7 May 2016 13:43:55 -0500 Subject: [PATCH] added dynamic linking approach to exits. live hacking rooms works! :D :D --- mudsync/game-master.scm | 3 +-- mudsync/gameobj.scm | 29 +++++++++++++++++++++++++---- mudsync/room.scm | 32 +++++--------------------------- worlds/bricabrac.scm | 4 ++-- worlds/goblin-hq.scm | 12 ++++++------ 5 files changed, 39 insertions(+), 41 deletions(-) diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index f82ec37..8bc239b 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -151,7 +151,7 @@ (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) @@ -254,4 +254,3 @@ with an anonymous persona" #:text (format #f "You see ~a materialize out of thin air!\n" guest-name) #:exclude player))))) - diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index cb844d1..5f702ef 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -33,7 +33,9 @@ gameobj-occupants gameobj-actions - gameobj-self-destruct)) + gameobj-self-destruct + + dyn-ref)) ;;; Gameobj ;;; ======= @@ -114,6 +116,7 @@ (define occupants (message-ref replace-reply 'occupants #f)) ;; Snarf all the occupants! + (display "replacing occupant\n") (when occupants (for-each (lambda (occupant) @@ -125,21 +128,21 @@ (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) @@ -307,3 +310,21 @@ By default, this is whether or not the generally-visible flag is set." "Vanilla method for assisting in self-replacement for live hacking" (apply <-reply actor message (gameobj-replace-data* actor))) + + +;;; 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))) diff --git a/mudsync/room.scm b/mudsync/room.scm index d201c05..c430523 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -35,10 +35,7 @@ ;;; ===== (define-class () - ;; 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) @@ -77,9 +74,6 @@ (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)) @@ -113,24 +107,6 @@ ;; @@: 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 @@ -138,7 +114,9 @@ claim to point to." (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) @@ -156,7 +134,7 @@ claim to point to." (<- 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 diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 5465aa5..f95ebd9 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -183,7 +183,7 @@ kind of objects they found lying around. #:exits (list (make #:name "north" - #:to-symbol 'room:grand-hallway))) + #:to 'room:grand-hallway))) ;; NPC: hotel owner ('npc:hotel-owner 'room:lobby @@ -260,7 +260,7 @@ they're all boarded up. Guess this is still a work in progress, huh?" #:exits (list (make #:name "south" - #:to-symbol 'room:lobby)) + #:to 'room:lobby)) ))) diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm index 54a573d..357f4a6 100644 --- a/worlds/goblin-hq.scm +++ b/worlds/goblin-hq.scm @@ -127,7 +127,7 @@ Still, you have to admit that all the machines look pretty nice." #:exits (list (make #: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 @@ -142,15 +142,15 @@ and the west." #:exits (list (make #:name "west" - #:to-symbol 'room:server-room + #:to 'room:server-room #:desc wooden-unlocked-door) (make #:name "east" - #:to-symbol 'room:code-a-plex + #:to 'room:code-a-plex #:desc metal-stiff-door) ;; (make ;; #:name "south" - ;; #:to-symbol 'center-hallway) + ;; #:to 'center-hallway) )) ('room:code-a-plex @@ -165,7 +165,7 @@ But one looks invitingly empty." #:exits (list (make #:name "west" - #:to-symbol 'room:north-hallway + #:to 'room:north-hallway #:desc metal-stiff-door))) ('thing:typewriter @@ -183,7 +183,7 @@ But one looks invitingly empty." ;; #:exits ;; ,(list (make ;; #:name "east" -;; #:to-symbol 'room:)) +;; #:to 'room:)) ;; ) (define (goblin-demo . args) -- 2.31.1