added dynamic linking approach to exits. live hacking rooms works! :D :D

diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm
index f82ec37cda6379e496be673b5b25e0e9c96773e3..8bc239bdb9bebedf6eebbe047879f8e495b218ab 100644 (file)
--- 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
 
 (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)
 
 (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)))))
             #: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 cb844d1e65ab01a983ba81da808bd194c2e08993..5f702efce85937c9d92ac4297353379364b5dd83 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -33,7 +33,9 @@
 
             gameobj-occupants
             gameobj-actions
 
             gameobj-occupants
             gameobj-actions

-            gameobj-self-destruct))
+            gameobj-self-destruct
+
+            dyn-ref))

 
 ;;; Gameobj
 ;;; =======
 
 ;;; Gameobj
 ;;; =======


@@ -114,6 +116,7 @@
   (define occupants
     (message-ref replace-reply 'occupants #f))
   ;; Snarf all the occupants!
   (define occupants
     (message-ref replace-reply 'occupants #f))
   ;; Snarf all the occupants!

+  (display "replacing occupant\n")

   (when occupants
     (for-each
      (lambda (occupant)
   (when occupants
     (for-each
      (lambda (occupant)


@@ -125,21 +128,21 @@
   (list gameobj-replace-step-occupants))
 
 (define (run-replacement actor message replace-steps)
   (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
   (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))))
 
       (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."
 ;; @@: 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)
   (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)))
   "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)))

diff --git a/mudsync/room.scm b/mudsync/room.scm
index d201c052a96cd8536e94f65b511af79966da0273..c4305233672755dad1f35c50057de342ec40ae33 100644 (file)
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -35,10 +35,7 @@
 ;;; =====
 
 (define-class <exit> ()
 ;;; =====
 
 (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)
   ;; Name of the room (@@: Should this be names?)
   (name #:getter exit-name
         #:init-keyword #:name)


@@ -77,9 +74,6 @@
 
 (define room-actions
   (build-actions
 
 (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))
    (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)))
 
    ;; @@: 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
 (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
        (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)
                          #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 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
         #:to-id (message-from message)))
    (else
     (<- room (message-from message) 'tell

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 5465aa5176705e2d7e51425f353fa8e822ee2257..f95ebd9ab51f4dc61817e7a57fdee2607e61e99e 100644 (file)
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -183,7 +183,7 @@ kind of objects they found lying around.
     #:exits
     (list (make <exit>
             #:name "north"
     #: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
    ;; NPC: hotel owner
    ('npc:hotel-owner
     <chatty-npc> 'room:lobby


@@ -260,7 +260,7 @@ they're all boarded up.  Guess this is still a work in progress, huh?"
     #:exits
     (list (make <exit>
             #:name "south"
     #:exits
     (list (make <exit>
             #:name "south"

-            #:to-symbol 'room:lobby))
+            #:to 'room:lobby))

     )))
 
 \f
     )))
 
 \f

diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm
index 54a573de4fa1781b872ea8a068587d4b97a416fe..357f4a6557decaead808d8603e5210e1c394ad3e 100644 (file)
--- 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 <exit>
             #:name "east"
     #: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
             #: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 <exit>
             #:name "west"
     #:exits
     (list (make <exit>
             #:name "west"

-            #:to-symbol 'room:server-room
+            #:to 'room:server-room

             #:desc wooden-unlocked-door)
           (make <exit>
             #:name "east"
             #: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"
             #:desc metal-stiff-door)
           ;; (make <exit>
           ;;   #:name "south"

-          ;;   #:to-symbol 'center-hallway)
+          ;;   #:to 'center-hallway)

           ))
 
    ('room:code-a-plex
           ))
 
    ('room:code-a-plex


@@ -165,7 +165,7 @@ But one looks invitingly empty."
     #:exits
     (list (make <exit>
             #:name "west"
     #:exits
     (list (make <exit>
             #:name "west"

-            #:to-symbol 'room:north-hallway
+            #:to 'room:north-hallway

             #:desc metal-stiff-door)))
 
    ('thing:typewriter
             #:desc metal-stiff-door)))
 
    ('thing:typewriter


@@ -183,7 +183,7 @@ But one looks invitingly empty."
 ;;      #:exits
 ;;      ,(list (make <exit>
 ;;               #:name "east"
 ;;      #:exits
 ;;      ,(list (make <exit>
 ;;               #:name "east"

-;;               #:to-symbol 'room:))
+;;               #:to 'room:))

 ;;      )
 
 (define (goblin-demo . args)
 ;;      )
 
 (define (goblin-demo . args)