mudsync/run-game.scm

   1 ;;; Mudsync --- Live hackable MUD
   2 ;;; Copyright © 2016 Christopher Allan 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 (fibers conditions)
  24   ;; #:use-module (8sync debug)
  25   #:use-module (srfi srfi-1)
  26   #:use-module (ice-9 receive)
  27   #:use-module (ice-9 q)
  28   #:use-module (ice-9 match)
  29   #:export (run-demo
  30             do-inject-special!
  31             make-special-injector
  32
  33             ;; Debug stuff, might go away
  34             %live-gm %live-hive
  35             inject-gameobj!))
  36
  37 \f
  38 ;;; Debugging stuff
  39 ;;; ===============
  40
  41 ;; @@: Could these be parameterized and this still work?
  42 (define %live-gm #f)
  43 (define %live-hive #f)
  44
  45 ;; Evil!  This uses a global variable... but it's hard to give any more
  46 ;; convenient way of providing something for live hacking (which is
  47 ;; "quasi-evil for productivity's sake" anyway).  You can set up your own
  48 ;; solution which doesn't use a global though.
  49
  50 (define %inject-queue #f)
  51
  52 (define (inject-gameobj! game-spec special-symbol)
  53   (if %inject-queue
  54       (let ((gameobj-spec
  55              (or (find
  56                   (lambda (entry) (eq? (car entry) special-symbol))
  57                   game-spec)
  58                  (throw 'no-such-symbol "Can't find such a symbol in the game-spec"
  59                         #:symbol special-symbol))))
  60         (enq! %inject-queue (cons gameobj-spec special-symbol)))
  61       (display "Game hasn't been started...\n"))
  62   'done)
  63
  64 (define-actor <gameobj-injector> (<actor>)
  65   ((repl-update gameobj-injector-inject-queued))
  66   (gm #:init-keyword #:gm
  67       #:getter .gm))
  68
  69 (define (gameobj-injector-inject-queued injector message)
  70   (while (not (q-empty? %inject-queue))
  71     (match (deq! %inject-queue)
  72       ((gameobj-spec . special-symbol)
  73        (<-wait (.gm injector) 'inject-special!
  74                #:special-symbol special-symbol
  75                #:gameobj-spec gameobj-spec)))))
  76
  77 \f
  78 ;;; Game running stuff
  79 ;;; ==================
  80
  81 (define* (run-demo game-spec default-room #:key repl-server)
  82   (run-hive
  83    (lambda (hive)
  84      (define new-conn-handler
  85        (make-default-room-conn-handler default-room))
  86      (define gm
  87        ;; (bootstrap-actor-gimmie* hive <game-master> "gm"
  88        ;;                          #:new-conn-handler new-conn-handler)
  89        (create-actor* <game-master> "gm"
  90                       #:new-conn-handler new-conn-handler))
  91      (define injector
  92        (create-actor <gameobj-injector>
  93                      #:gm gm))
  94
  95      (define repl-manager
  96        (create-actor* <repl-manager> "repl"
  97                       #:subscribers (list injector)))
  98
  99      ;; (set! %live-gm gm)
 100      (set! %live-hive hive)
 101
 102      (set! %inject-queue (make-q))
 103
 104      (<- gm 'init-world
 105          #:game-spec game-spec)
 106      ;; (run-hive hive
 107      ;;           (list (bootstrap-message hive (actor-id gm) 'init-world
 108      ;;                                    #:game-spec game-spec)))
 109      (wait (make-condition)))
 110    ;; Just for testing / for now...
 111    #:parallelism 1))