1 ;;; Mudsync --- Live hackable MUD
2 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
4 ;;; This file is part of Mudsync.
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.
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.
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/>.
19 (define-module (mudsync game-master)
20 #:use-module (mudsync room)
21 #:use-module (mudsync player)
22 #:use-module (mudsync networking)
23 #:use-module (8sync systems actors)
24 #:use-module (8sync agenda)
25 #:use-module (oop goops)
26 #:use-module (ice-9 match)
27 #:export (<game-master>
28 make-default-room-conn-handler))
30 ;;; The game master! Runs the world.
31 ;;; =================================
33 (define-class <game-master> (<actor>)
34 ;; Directory of "special" objects.
35 (special-dir #:init-thunk make-hash-table
36 #:getter gm-special-dir)
38 ;; Room directory. Room symbols to locations.
39 (room-dir #:init-thunk make-hash-table
42 ;; A mapping of client ids to in-game actors
44 (client-dir #:init-thunk make-hash-table
45 #:getter gm-client-dir)
46 (reverse-client-dir #:init-thunk make-hash-table
47 #:getter gm-reverse-client-dir)
50 (network-manager #:accessor gm-network-manager
53 ;; How we get a new connection acclimated to the system
54 (new-conn-handler #:accessor gm-new-conn-handler
55 #:init-keyword #:new-conn-handler)
60 (init-world (wrap-apply gm-init-world))
61 (client-input (wrap-apply gm-handle-client-input))
62 (lookup-room (wrap-apply gm-lookup-room))
63 (new-client (wrap-apply gm-new-client))
64 (write-home (wrap-apply gm-write-home)))))
67 ;;; .. begin world init stuff ..
69 (define (gm-init-world gm message)
73 ;; Init basic rooms / structure
74 (gm-init-rooms gm (message-ref message 'room-spec))
76 ;; Restore database-based actors
80 (gm-setup-network gm))
82 (define (gm-init-rooms gm rooms-spec)
83 "Initialize the prebuilt rooms"
84 ;; @@: Would it be nicer to just allow passing in
85 ;; #:exits to the room spec itself?
86 (define (exit-from-spec exit-spec)
87 "Take room exits syntax from the spec, turn it into exits"
89 ((name to-symbol desc)
98 ((room-symbol room-class
101 ;; initialize the room
103 (apply create-actor* gm room-class "room"
105 #:exits (map exit-from-spec room-exits)
108 (hash-set! (gm-room-dir gm) room-symbol room)
109 ;; pass it back to the map
113 ;; now wire up all the exits
116 (format #t "Wiring up ~s...\n" (address->string room))
117 (<-wait gm room 'wire-exits!))
121 (define (gm-setup-network gm)
122 ;; Create a default network manager if none available
123 (set! (gm-network-manager gm)
124 (create-actor* gm <network-manager> "netman"
125 #:send-input-to (actor-id gm)))
127 ;; TODO: Add host and port options
128 (<-wait gm (gm-network-manager gm) 'start-listening))
130 (define (gm-setup-database gm)
133 ;;; .. end world init stuff ...
135 (define-mhandler (gm-new-client actor message client)
136 ;; @@: Maybe more indirection than needed for this
137 ((gm-new-conn-handler actor) actor client))
140 (define (gm-handle-client-input actor message)
141 "Handle input from a client."
142 (define client-id (message-ref message 'client))
143 (define input (message-ref message 'data))
144 (format #t "From ~s: ~s\n" client-id input)
145 (<- actor (gm-network-manager actor) 'send-to-client
147 #:data "Thanks, we got it!\n"))
149 (define-mhandler (gm-lookup-room actor message symbol)
151 (slot-ref (gm-room-dir actor) symbol))
152 (<-reply actor message room-id))
154 (define-mhandler (gm-write-home actor message text)
155 (define client-id (hash-ref (gm-reverse-client-dir actor)
156 (message-from message)))
157 (<- actor (gm-network-manager actor) 'send-to-client
164 (define (gm-register-client! gm client-id player)
165 (hash-set! (gm-client-dir gm) client-id player)
166 (hash-set! (gm-reverse-client-dir gm) player client-id))
168 (define (gm-unregister-client! gm client-id)
169 "Remove a connection/player combo and ask them to self destruct"
170 (match (hash-remove! (gm-client-dir gm) client-id) ; Remove from our client dir
172 ;; Remove from reverse table too
173 (hash-remove! (gm-reverse-client-dir gm) client-id)
175 (<- gm player-id 'destroy-self))
176 (#f (throw 'no-client-to-unregister
177 "Can't unregister a client that doesn't exist?"
182 (define (make-default-room-conn-handler default-room)
183 "Make a handler for a GM that dumps people in a default room
184 with an anonymous persona"
186 (lambda (gm client-id)
187 (define guest-name (string-append "Guest-"
188 (number->string count)))
190 (hash-ref (gm-room-dir gm) default-room))
191 ;; create and register the player
193 (create-actor* gm <player> "player"
194 #:username guest-name
198 ;; Register the player in our database of players -> connections
199 (gm-register-client! gm client-id player)
200 ;; Dump the player into the default room
201 (<-wait gm player 'set-loc! #:id room-id)
202 ;; Initialize the player
203 (<- gm player 'init))))