run-game.scm 3.3 KB

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