From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Sat, 7 May 2016 14:48:24 +0000 (-0500)
Subject: Injection almost works, you can pass along the appropriate action at least.
X-Git-Tag: fosdem-2017~154
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=0580e6a2294089a142923e4fba9b345d7442af79;p=mudsync.git

Injection almost works, you can pass along the appropriate action at least.
---

diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm
index 9ced9fa..6a06cb7 100644
--- a/mudsync/game-master.scm
+++ b/mudsync/game-master.scm
@@ -56,7 +56,8 @@
     (lookup-special (wrap-apply gm-lookup-special))
     (new-client (wrap-apply gm-new-client))
     (write-home (wrap-apply gm-write-home))
-    (client-closed (wrap-apply gm-client-closed)))))
+    (client-closed (wrap-apply gm-client-closed))
+    (inject-special! (wrap-apply gm-inject-special!)))))
 
 
 ;;; .. begin world init stuff ..
@@ -169,6 +170,13 @@
     (gm-unregister-client! gm client)))
 
 
+(define-mhandler (gm-inject-special! gm message
+                                     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))
+
 ;;; GM utilities
 
 (define (gm-register-client! gm client-id player)
diff --git a/mudsync/run-game.scm b/mudsync/run-game.scm
index 89f96f1..0bbf759 100644
--- a/mudsync/run-game.scm
+++ b/mudsync/run-game.scm
@@ -18,28 +18,100 @@
 
 (define-module (mudsync run-game)
   #:use-module (mudsync game-master)
+  #:use-module (8sync agenda)
+  #:use-module (8sync repl)
   #:use-module (8sync systems actors)
   #:use-module (8sync systems actors debug)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 q)
   #:export (run-demo
-            ;; Just temporarily
-            %test-gm))
+            inject-special!
+            make-special-injector
 
+            ;; Debug stuff, might go away
+            %live-gm %live-hive
+            inject!))
 
+
 ;;; Debugging stuff
 ;;; ===============
 
-(define %test-gm #f)
+;; @@: Could these be parameterized and this still work?
+(define %live-gm #f)
+(define %live-hive #f)
 
-(define (run-demo db-path game-spec default-room)
+;; Evil!  This uses a global variable... but it's hard to give any more
+;; convenient way of providing something for live hacking (which is
+;; "quasi-evil for productivity's sake" anyway).  You can set up your own
+;; solution which doesn't use a global though.
+
+(define (inject! game-spec special-symbol)
+  (display "Game hasn't been started...\n"))
+
+
+
+;;; Game running stuff
+;;; ==================
+
+(define* (run-demo game-spec default-room #:key repl-server)
   (define hive (make-hive))
   (define new-conn-handler
     (make-default-room-conn-handler default-room))
   (define gm
     (hive-create-actor-gimmie* hive <game-master> "gm"
                                #:new-conn-handler new-conn-handler))
-  (set! %test-gm gm)
-  ;; @@: Boy, wouldn't it be nice if the agenda could do things
-  ;;   on interrupt :P
-  (ez-run-hive hive
-               (list (bootstrap-message hive (actor-id gm) 'init-world
-                                        #:game-spec game-spec))))
+  (define initial-tasks
+    (list (bootstrap-message hive (actor-id gm) 'init-world
+                             #:game-spec game-spec)))
+  (define agenda
+    (make-agenda #:pre-unwind-handler print-error-and-continue
+                 #:queue (list->q initial-tasks)))
+
+  (set! %live-gm gm)
+  (set! %live-hive hive)
+  (receive (post-run-hook gameobj-injector)
+      (make-special-injector agenda hive (actor-id gm))
+    ;; Set up injector for live hacking
+    (set! inject! gameobj-injector)
+
+    ;; Set up REPL sever
+    (cond
+     ;; If repl-server is an integer, we'll use that as the port
+     ((integer? repl-server)
+      (spawn-and-queue-repl-server! agenda repl-server))
+     (repl-server
+      (spawn-and-queue-repl-server! agenda)))
+
+    (start-agenda agenda
+                  #:post-run-hook post-run-hook)))
+
+;; urhhghhhhhhhh
+
+(define (inject-special! queue hive gm-id game-spec special-symbol)
+  (define gameobj-spec
+    (or (find
+         (lambda (entry) (eq? (car entry) special-symbol))
+         game-spec)
+        (throw 'no-such-symbol "Can't find such a symbol in the game-spec"
+               #:symbol special-symbol)))
+  (define task
+    (bootstrap-message hive gm-id 'inject-special!
+                       #:special-symbol special-symbol
+                       #:gameobj-spec gameobj-spec))
+  (enq! queue task))
+
+(define (queue-injected-tasks-on-agenda! agenda inject-queue)
+  "Inject tasks from the inject-queue onto the agenda queue."
+  (while (not (q-empty? inject-queue))
+    (enq! (agenda-queue agenda) (q-pop! inject-queue))))
+
+(define* (make-special-injector agenda hive gm-id)
+  "Make a post-run-hook and gameobj injector for quick live hacking."
+  (define inject-queue (make-q))
+  (values
+   (lambda (agenda)
+     (queue-injected-tasks-on-agenda! agenda inject-queue))
+   (lambda (game-spec special-symbol)
+     (inject-special! inject-queue hive gm-id
+                      game-spec special-symbol))))
diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index c9b4fd8..5465aa5 100644
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -297,6 +297,7 @@ they're all boarded up.  Guess this is still a work in progress, huh?"
 (define game-spec
   (append lobby grand-hallway))
 
+;; TODO: Provide command line args
 (define (run-game . args)
-  (run-demo "/tmp/bricabrac-game.db" game-spec 'room:lobby))
+  (run-demo game-spec 'room:lobby #:repl-server #t))
 
diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm
index b6682c2..54a573d 100644
--- a/worlds/goblin-hq.scm
+++ b/worlds/goblin-hq.scm
@@ -187,4 +187,4 @@ But one looks invitingly empty."
 ;;      )
 
 (define (goblin-demo . args)
-  (run-demo "/tmp/goblin-game.db" goblin-rooms 'room:north-hallway))
+  (run-demo goblin-rooms 'room:north-hallway))