mudsync/run-game.scm

   1 ;;; Mudsync --- Live hackable MUD
   2 ;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
   3 ;;;
   4 ;;; This file is part of Mudsync.
   5 ;;;
   6 ;;; Mudsync is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or
   9 ;;; (at your option) any later version.
  10 ;;;
  11 ;;; Mudsync is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;; General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with Mudsync.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (mudsync run-game)
  20   #:use-module (mudsync game-master)
  21   #:use-module (8sync)
  22   #:use-module (8sync repl)
  23   #:use-module (8sync debug)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (ice-9 receive)
  26   #:use-module (ice-9 q)
  27   #:use-module (ice-9 match)
  28   #:export (run-demo
  29             do-inject-special!
  30             make-special-injector
  31
  32             ;; Debug stuff, might go away
  33             %live-gm %live-hive
  34             inject-gameobj!))
  35
  36 \f
  37 ;;; Debugging stuff
  38 ;;; ===============
  39
  40 ;; @@: Could these be parameterized and this still work?
  41 (define %live-gm #f)
  42 (define %live-hive #f)
  43
  44 ;; Evil!  This uses a global variable... but it's hard to give any more
  45 ;; convenient way of providing something for live hacking (which is
  46 ;; "quasi-evil for productivity's sake" anyway).  You can set up your own
  47 ;; solution which doesn't use a global though.
  48
  49 (define %inject-queue #f)
  50
  51 (define (inject-gameobj! game-spec special-symbol)
  52   (if %inject-queue
  53       (let ((gameobj-spec
  54              (or (find
  55                   (lambda (entry) (eq? (car entry) special-symbol))
  56                   game-spec)
  57                  (throw 'no-such-symbol "Can't find such a symbol in the game-spec"
  58                         #:symbol special-symbol))))
  59         (enq! %inject-queue (cons gameobj-spec special-symbol)))
  60       (display "Game hasn't been started...\n"))
  61   'done)
  62
  63 (define-actor <gameobj-injector> (<actor>)
  64   ((repl-update gameobj-injector-inject-queued))
  65   (gm #:init-keyword #:gm
  66       #:getter .gm))
  67
  68 (define (gameobj-injector-inject-queued injector message)
  69   (while (not (q-empty? %inject-queue))
  70     (match (deq! %inject-queue)
  71       ((gameobj-spec . special-symbol)
  72        (<-wait (.gm injector) 'inject-special!
  73                #:special-symbol special-symbol
  74                #:gameobj-spec gameobj-spec)))))
  75
  76 \f
  77 ;;; Game running stuff
  78 ;;; ==================
  79
  80 (define* (run-demo game-spec default-room #:key repl-server)
  81   (define hive (make-hive))
  82   (define new-conn-handler
  83     (make-default-room-conn-handler default-room))
  84   (define gm
  85     (bootstrap-actor-gimmie* hive <game-master> "gm"
  86                              #:new-conn-handler new-conn-handler))
  87   (define injector
  88     (bootstrap-actor hive <gameobj-injector>
  89                      #:gm (actor-id gm)))
  90
  91   (define repl-manager
  92     (bootstrap-actor* hive <repl-manager> "repl"
  93                       #:subscribers (list injector)))
  94
  95   (set! %live-gm gm)
  96   (set! %live-hive hive)
  97
  98   (set! %inject-queue (make-q))
  99
 100   (run-hive hive
 101             (list (bootstrap-message hive (actor-id gm) 'init-world
 102                                      #:game-spec game-spec))))