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 agenda)
  22   #:use-module (8sync repl)
  23   #:use-module (8sync systems actors)
  24   #:use-module (8sync systems actors debug)
  25   #:use-module (srfi srfi-1)
  26   #:use-module (ice-9 receive)
  27   #:use-module (ice-9 q)
  28   #:export (run-demo
  29             inject-special!
  30             make-special-injector
  31
  32             ;; Debug stuff, might go away
  33             %live-gm %live-hive
  34             inject!))
  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! game-spec special-symbol)
  50   (display "Game hasn't been started...\n"))
  51
  52
  53 \f
  54 ;;; Game running stuff
  55 ;;; ==================
  56
  57 (define* (run-demo game-spec default-room #:key repl-server)
  58   (define hive (make-hive))
  59   (define new-conn-handler
  60     (make-default-room-conn-handler default-room))
  61   (define gm
  62     (hive-create-actor-gimmie* hive <game-master> "gm"
  63                                #:new-conn-handler new-conn-handler))
  64   (define initial-tasks
  65     (list (bootstrap-message hive (actor-id gm) 'init-world
  66                              #:game-spec game-spec)))
  67   (define agenda
  68     (make-agenda #:pre-unwind-handler print-error-and-continue
  69                  #:queue (list->q initial-tasks)))
  70
  71   (set! %live-gm gm)
  72   (set! %live-hive hive)
  73   (receive (post-run-hook gameobj-injector)
  74       (make-special-injector agenda hive (actor-id gm))
  75     ;; Set up injector for live hacking
  76     (set! inject! gameobj-injector)
  77
  78     ;; Set up REPL sever
  79     (cond
  80      ;; If repl-server is an integer, we'll use that as the port
  81      ((integer? repl-server)
  82       (spawn-and-queue-repl-server! agenda repl-server))
  83      (repl-server
  84       (spawn-and-queue-repl-server! agenda)))
  85
  86     (start-agenda agenda
  87                   #:post-run-hook post-run-hook)))
  88
  89 ;; urhhghhhhhhhh
  90
  91 (define (inject-special! queue hive gm-id game-spec special-symbol)
  92   (define gameobj-spec
  93     (or (find
  94          (lambda (entry) (eq? (car entry) special-symbol))
  95          game-spec)
  96         (throw 'no-such-symbol "Can't find such a symbol in the game-spec"
  97                #:symbol special-symbol)))
  98   (define task
  99     (bootstrap-message hive gm-id 'inject-special!
 100                        #:special-symbol special-symbol
 101                        #:gameobj-spec gameobj-spec))
 102   (enq! queue task))
 103
 104 (define (queue-injected-tasks-on-agenda! agenda inject-queue)
 105   "Inject tasks from the inject-queue onto the agenda queue."
 106   (while (not (q-empty? inject-queue))
 107     (enq! (agenda-queue agenda) (q-pop! inject-queue))))
 108
 109 (define* (make-special-injector agenda hive gm-id)
 110   "Make a post-run-hook and gameobj injector for quick live hacking."
 111   (define inject-queue (make-q))
 112   (values
 113    (lambda (agenda)
 114      (queue-injected-tasks-on-agenda! agenda inject-queue))
 115    (lambda (game-spec special-symbol)
 116      (inject-special! inject-queue hive gm-id
 117                       game-spec special-symbol))))