From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Sat, 7 May 2016 17:24:34 +0000 (-0500)
Subject: Most of the rest of support for live hacking!
X-Git-Tag: fosdem-2017~153
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=36042544b6defa138f348f093f895722a472e1ba;p=mudsync.git

Most of the rest of support for live hacking!

Still need to add a dynamic linking system though and update rooms to
use it.
---

diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm
index 6a06cb7..f82ec37 100644
--- a/mudsync/game-master.scm
+++ b/mudsync/game-master.scm
@@ -22,6 +22,7 @@
   #:use-module (8sync agenda)
   #:use-module (oop goops)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
   #:export (<game-master>
             make-default-room-conn-handler))
 
@@ -75,6 +76,8 @@
   ;; Set up the network
   (gm-setup-network gm))
 
+
+;; @@: If you change this code, update gm-inject-special! if appropriate.
 (define (gm-init-game-spec gm game-spec)
   "Initialize the prebuilt special objects"
   (define set-locs '())
@@ -174,8 +177,35 @@
                                      special-symbol gameobj-spec)
   "Inject, possiibly replacing the original, special symbol
 using the gameobj-spec."
-  (pk 'special-symbol special-symbol)
-  (pk 'gameobj-spec gameobj-spec))
+  (define existing-obj
+    (hash-ref (slot-ref gm 'special-dir) special-symbol))
+
+  ;; There's a lot of overlap here with gm-init-game-spec.
+  ;; We could try to union them?  It seemed hard last time I looked,
+  ;; because things need to run in a different order.
+  (match gameobj-spec
+    (((? (cut eq? <> special-symbol) symbol) class loc args ...)
+     ;; initialize the special object
+     (let ((special-obj
+            (apply create-actor* gm class
+                   ;; set cookie to be the object's symbol
+                   (symbol->string symbol)
+                   #:gm (actor-id gm)
+                   args)))
+       ;; Set the location
+       (<-wait gm special-obj 'set-loc!
+                  #:loc (hash-ref (gm-special-dir gm) loc))
+       ;; Initialize the object, and depending on if an object
+       ;; already exists with this info, ask it to coordinate
+       ;; replacing with the existing object.
+       (if existing-obj
+           (<-wait gm special-obj 'init #:replace existing-obj)
+           (<-wait gm special-obj 'init))
+       ;; Register the object
+       (hash-set! (gm-special-dir gm) symbol special-obj)
+       ;; Destroy the original, if it exists.
+       (if existing-obj
+           (<- gm existing-obj 'self-destruct #:why 'replaced))))))
 
 ;;; GM utilities
 
diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index c34e89b..cb844d1 100644
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -55,7 +55,8 @@
    (goes-by (wrap-apply gameobj-act-goes-by))
    (visible-name (wrap-apply gameobj-visible-name))
    (self-destruct (wrap-apply gameobj-act-self-destruct))
-   (tell (wrap-apply gameobj-tell-no-op))))
+   (tell (wrap-apply gameobj-tell-no-op))
+   (assist-replace (wrap-apply gameobj-act-assist-replace))))
 
 ;;; *all* game components that talk to players should somehow
 ;;; derive from this class.
@@ -109,11 +110,37 @@
                    #:val (slot-ref actor slot))))
 
 
+(define (gameobj-replace-step-occupants actor replace-reply)
+  (define occupants
+    (message-ref replace-reply 'occupants #f))
+  ;; Snarf all the occupants!
+  (when occupants
+    (for-each
+     (lambda (occupant)
+       (<-wait actor occupant 'set-loc!
+               #:loc (actor-id actor)))
+     occupants)))
+
+(define gameobj-replace-steps*
+  (list gameobj-replace-step-occupants))
+
+(define (run-replacement actor message replace-steps)
+  (define replaces (message-ref message 'replaces #f))
+  (when replaces
+    (let ((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.  Does nothing."
-  #f)
+  "Your most basic game object init procedure.
+Assists in its replacement of occupants if necessary and nothing else."
+  (run-replacement actor message gameobj-replace-steps*))
 
 (define (gameobj-goes-by gameobj)
   "Find the name we go by.  Defaults to #:name if nothing else provided."
@@ -263,3 +290,20 @@ By default, this is whether or not the generally-visible flag is set."
 ;; Unless an actor has a tell message, we just ignore it
 (define gameobj-tell-no-op
   (const 'no-op))
+
+(define (gameobj-replace-data-occupants actor)
+  "The general purpose list of replacement data"
+  (list #:occupants (hash-map->list (lambda (occupant _) occupant)
+                                    (slot-ref actor 'occupants))))
+
+(define (gameobj-replace-data* actor)
+  ;; For now, just call gameobj-replace-data-occupants.
+  ;; But there may be more in the future!
+  (gameobj-replace-data-occupants actor))
+
+;; So sad that objects must assist in their replacement ;_;
+;; But that's life in a live hacked game!
+(define (gameobj-act-assist-replace actor message)
+  "Vanilla method for assisting in self-replacement for live hacking"
+  (apply <-reply actor message
+         (gameobj-replace-data* actor)))
diff --git a/mudsync/run-game.scm b/mudsync/run-game.scm
index 0bbf759..daedf18 100644
--- a/mudsync/run-game.scm
+++ b/mudsync/run-game.scm
@@ -86,7 +86,6 @@
     (start-agenda agenda
                   #:post-run-hook post-run-hook)))
 
-;; urhhghhhhhhhh
 
 (define (inject-special! queue hive gm-id game-spec special-symbol)
   (define gameobj-spec
@@ -99,7 +98,8 @@
     (bootstrap-message hive gm-id 'inject-special!
                        #:special-symbol special-symbol
                        #:gameobj-spec gameobj-spec))
-  (enq! queue task))
+  (enq! queue task)
+  'done)
 
 (define (queue-injected-tasks-on-agenda! agenda inject-queue)
   "Inject tasks from the inject-queue onto the agenda queue."