From 36042544b6defa138f348f093f895722a472e1ba Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 7 May 2016 12:24:34 -0500 Subject: [PATCH] Most of the rest of support for live hacking! Still need to add a dynamic linking system though and update rooms to use it. --- mudsync/game-master.scm | 34 ++++++++++++++++++++++++++-- mudsync/gameobj.scm | 50 ++++++++++++++++++++++++++++++++++++++--- mudsync/run-game.scm | 4 ++-- 3 files changed, 81 insertions(+), 7 deletions(-) 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 ( 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." -- 2.31.1