;;; Mudsync --- Live hackable MUD ;;; Copyright © 2016 Christine Lemmer-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 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) (actions #:allocation #:each-subclass #:init-thunk (build-actions (init-world gm-init-world) (client-input gm-handle-client-input) (lookup-special gm-lookup-special) (new-client gm-new-client) (write-home gm-write-home) (client-closed gm-client-closed) (inject-special! gm-inject-special!)))) ;;; .. begin world init stuff .. (define* (gm-init-world gm message #:key game-spec) ;; Load database ;; TODO ;; Init basic rooms / structure (gm-init-game-spec gm 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 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 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-network-manager gm) 'start-listening)) (define (gm-setup-database gm) 'TODO) ;;; .. end world init stuff ... (define* (gm-new-client actor message #:key client) ;; @@: Maybe more indirection than needed for this ((gm-new-conn-handler actor) actor client)) (define* (gm-handle-client-input actor message #:key client data) "Handle input from a client." ;; Look up player (define player (hash-ref (gm-client-dir actor) client)) ;; debugging (format #t "DEBUG: From ~s: ~s\n" client data) (<- player 'handle-input #:input data)) (define* (gm-lookup-special actor message #:key symbol) (<-reply message (hash-ref (slot-ref actor 'special-dir) symbol))) (define* (gm-write-home actor message #:key text) (define client-id (hash-ref (gm-reverse-client-dir actor) (message-from message))) (<- (gm-network-manager actor) 'send-to-client #:client client-id #:data text)) (define* (gm-client-closed gm message #:key 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 actor-id 'disconnect-self-destruct) ;; Unregister from the client directories. (gm-unregister-client! gm client))) (define* (gm-inject-special! gm message #:key 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 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 special-obj 'init #:replace existing-obj) (<-wait special-obj 'init)) ;; Register the object (hash-set! (gm-special-dir gm) symbol special-obj) ;; Destroy the original, if it exists. (if existing-obj (<- 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 (<- 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 player 'set-loc! #:loc room-id) ;; Initialize the player (<-wait player 'init) (<- room-id 'tell-room #:text (format #f "You see ~a materialize out of thin air!\n" guest-name) #:exclude player)))))