;;; Mudsync --- Live hackable MUD ;;; Copyright © 2016 Christopher Allan Webber ;;; ;;; This file is part of Mudsync. ;;; ;;; Mudsync is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; Mudsync is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with Mudsync. If not, see . (define-module (mudsync game-master) #:use-module (mudsync networking) #:use-module (8sync systems actors) #:use-module (8sync agenda) #:use-module (oop goops) #:use-module (ice-9 match) #:use-module (srfi srfi-26) #:export ( make-default-room-conn-handler)) ;;; The game master! Runs the world. ;;; ================================= (define-class () ;; Directory of "special" objects. (special-dir #:init-thunk make-hash-table #:getter gm-special-dir) ;; A mapping of client ids to in-game actors ;; and a reverse ;p (client-dir #:init-thunk make-hash-table #:getter gm-client-dir) (reverse-client-dir #:init-thunk make-hash-table #:getter gm-reverse-client-dir) ;; Network manager (network-manager #:getter gm-network-manager #:init-value #f) ;; How we get a new connection acclimated to the system (new-conn-handler #:getter gm-new-conn-handler #:init-keyword #:new-conn-handler) (message-handler #:init-value (make-action-dispatch (init-world (wrap-apply gm-init-world)) (client-input (wrap-apply gm-handle-client-input)) (lookup-special (wrap-apply gm-lookup-special)) (new-client (wrap-apply gm-new-client)) (write-home (wrap-apply gm-write-home)) (client-closed (wrap-apply gm-client-closed)) (inject-special! (wrap-apply gm-inject-special!))))) ;;; .. begin world init stuff .. (define (gm-init-world gm message) ;; Load database ;; TODO ;; Init basic rooms / structure (gm-init-game-spec gm (message-ref message 'game-spec)) ;; Restore database-based actors ;; TODO ;; Set up the network (gm-setup-network gm)) ;; @@: If you change this code, update gm-inject-special! if appropriate. (define (gm-init-game-spec gm game-spec) "Initialize the prebuilt special objects" (define set-locs '()) (define specials (map (match-lambda ((symbol class loc args ...) ;; initialize the special object (let ((special-obj (apply create-actor* gm class ;; set cookie to be the object's symbol (symbol->string symbol) #:gm (actor-id gm) args))) ;; register the object (hash-set! (gm-special-dir gm) symbol special-obj) ;; Give ourselves an instruction to set the location (set! set-locs (cons (cons special-obj loc) set-locs)) ;; pass it back to the map special-obj))) game-spec)) ;; Set all initial locations (for-each (match-lambda ((special-obj . loc) (if loc (<-wait gm special-obj 'set-loc! #:loc (hash-ref (gm-special-dir gm) loc))))) set-locs) ;; now init all the objects (for-each (lambda (special-obj) (format #t "Initializing ~s...\n" (address->string special-obj)) (<-wait gm special-obj 'init)) specials)) (define (gm-setup-network gm) ;; Create a default network manager if none available (slot-set! gm 'network-manager (create-actor* gm "netman" #:send-input-to (actor-id gm))) ;; TODO: Add host and port options (<-wait gm (gm-network-manager gm) 'start-listening)) (define (gm-setup-database gm) 'TODO) ;;; .. end world init stuff ... (define-mhandler (gm-new-client actor message client) ;; @@: Maybe more indirection than needed for this ((gm-new-conn-handler actor) actor client)) (define (gm-handle-client-input actor message) "Handle input from a client." (define client-id (message-ref message 'client)) (define input (message-ref message 'data)) ;; Look up player (define player (hash-ref (gm-client-dir actor) client-id)) ;; debugging (format #t "DEBUG: From ~s: ~s\n" client-id input) (<- actor player 'handle-input #:input input)) (define-mhandler (gm-lookup-special actor message symbol) (<-reply actor message #:val (hash-ref (slot-ref actor 'special-dir) symbol))) (define-mhandler (gm-write-home actor message text) (define client-id (hash-ref (gm-reverse-client-dir actor) (message-from message))) (<- actor (gm-network-manager actor) 'send-to-client #:client client-id #:data text)) (define-mhandler (gm-client-closed gm message client) ;; Do we have this client registered to an actor? Get the id if so. (define actor-id (hash-ref (gm-client-dir gm) client)) ;; Have the actor appropriately disappear / be removed from its ;; room, if we have one. ;; (In some games, if the user never connected) (when actor-id (<-wait gm actor-id 'disconnect-self-destruct) ;; Unregister from the client directories. (gm-unregister-client! gm client))) (define-mhandler (gm-inject-special! gm message special-symbol gameobj-spec) "Inject, possiibly replacing the original, special symbol using the gameobj-spec." (define existing-obj (hash-ref (slot-ref gm 'special-dir) special-symbol)) ;; There's a lot of overlap here with gm-init-game-spec. ;; We could try to union them? It seemed hard last time I looked, ;; because things need to run in a different order. (match gameobj-spec (((? (cut eq? <> special-symbol) symbol) class loc args ...) ;; initialize the special object (let ((special-obj (apply create-actor* gm class ;; set cookie to be the object's symbol (symbol->string symbol) #:gm (actor-id gm) args))) ;; Set the location (<-wait gm special-obj 'set-loc! #:loc (hash-ref (gm-special-dir gm) loc)) ;; Initialize the object, and depending on if an object ;; already exists with this info, ask it to coordinate ;; replacing with the existing object. (if existing-obj (<-wait gm special-obj 'init #:replace existing-obj) (<-wait gm special-obj 'init)) ;; Register the object (hash-set! (gm-special-dir gm) symbol special-obj) ;; Destroy the original, if it exists. (if existing-obj (<- gm existing-obj 'self-destruct #:why 'replaced)))))) ;;; GM utilities (define (gm-register-client! gm client-id player) (hash-set! (gm-client-dir gm) client-id player) (hash-set! (gm-reverse-client-dir gm) player client-id)) (define* (gm-unregister-client! gm client-id #:optional destroy-player) "Remove a connection/player combo and ask them to self destruct" (match (hash-remove! (gm-client-dir gm) client-id) ; Remove from our client dir ((_ . player-id) ;; Remove from reverse table too (hash-remove! (gm-reverse-client-dir gm) client-id) ;; Destroy player (if destroy-player (<- gm player-id 'self-destruct))) (#f (throw 'no-client-to-unregister "Can't unregister a client that doesn't exist?" client-id)))) ;;; An easy default (define (make-default-room-conn-handler default-room) "Make a handler for a GM that dumps people in a default room with an anonymous persona" (let ((count 0)) (lambda (gm client-id) (set! count (+ count 1)) (let* ((guest-name (string-append "Guest-" (number->string count))) (room-id (hash-ref (gm-special-dir gm) default-room)) ;; create and register the player (player (create-actor* gm (@@ (mudsync player) ) "player" #:name guest-name #:gm (actor-id gm) #:client client-id))) ;; Register the player in our database of players -> connections (gm-register-client! gm client-id player) ;; Dump the player into the default room (<-wait gm player 'set-loc! #:loc room-id) ;; Initialize the player (<-wait gm player 'init) (<- gm room-id 'tell-room #:text (format #f "You see ~a materialize out of thin air!\n" guest-name) #:exclude player)))))