+;;; Mudsync --- Live hackable MUD
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
(use-modules (8sync systems actors)
+ (8sync systems actors debug)
(8sync agenda)
(ice-9 format)
(ice-9 match)
(oop goops))
+\f
+;;; Networking
+;;; ==========
+
(define %default-server #f)
(define %default-port 8889)
(define-class <network-manager> (<actor>)
(server-socket #:accessor nm-server-socket)
- ;; mapping of client -> local-id
+ ;; mapping of client -> client-id
(clients #:accessor nm-clients
#:init-thunk make-hash-table)
;; send input to this actor
(make-action-dispatch
((start-listening actor message)
(nm-install-socket actor (message-ref message 'server %default-server)
- (message-ref message 'port %default-port))))))
+ (message-ref message 'port %default-port)))
+ ((send-to-client actor message client data)
+ (nm-send-to-client-id actor client data)))))
(define-method (nm-close-everything (nm <network-manager>) remove-from-agenda)
"Shut it down!"
(define %maximum-backlog-conns 128) ; same as SOMAXCONN on Linux 2.X,
; says the intarwebs
-(define-method (nm-install-socket (nm <network-manager>) server port)
+(define (nm-install-socket nm server port)
"Install socket on SERVER with PORT"
(let ((s (socket PF_INET ; ipv4
SOCK_STREAM ; two-way connection-based byte stream
;; TODO: set up periodic close of idle connections?
))
-(define-method (nm-new-client (nm <network-manager>) s)
+(define (nm-new-client nm s)
"Handle new client coming in to socket S"
(let* ((client-connection (accept s))
(client-details (cdr client-connection))
(gethostbyaddr
(sockaddr:addr client-details)))
- (let ((local-id (big-random-number)))
- (hash-set! (nm-clients nm) local-id client)
- (8sync-port client #:read (nm-make-client-receive nm local-id)))))
+ (let ((client-id (big-random-number)))
+ (hash-set! (nm-clients nm) client-id client)
+ (8sync-port client #:read (nm-make-client-receive nm client-id)))))
-(define-method (nm-make-client-receive (nm <network-manager>) local-id)
+(define (nm-make-client-receive nm client-id)
"Make a method to receive client data"
(let ((buffer '()))
(define (reset-buffer)
;; reset buffer
(set! buffer '())
;; run it
- (nm-handle-line nm client local-id ready-line)))
+ (nm-handle-line nm client client-id ready-line)))
(_ #f)))
;; Shut things down on closed port or EOF object
(cond
((port-closed? client)
- (nm-handle-port-closed nm client local-id))
+ (nm-handle-port-closed nm client client-id))
((and (char-ready? client)
(eof-object? (peek-char client)))
- (nm-handle-port-eof nm client local-id))))
+ (nm-handle-port-eof nm client client-id))))
receive-handler))
-(define-method (nm-handle-port-closed (nm <network-manager>) client local-id)
+(define (nm-handle-port-closed nm client client-id)
"Handle a closed port"
- (format #t "DEBUG: handled closed port ~x\n" local-id)
+ (format #t "DEBUG: handled closed port ~x\n" client-id)
(8sync-port-remove client)
- (hash-remove! (nm-clients nm) local-id))
+ (hash-remove! (nm-clients nm) client-id))
-(define-method (nm-handle-port-eof (nm <network-manager>) client local-id)
+(define-method (nm-handle-port-eof nm client client-id)
"Handle seeing an EOF on port"
- (format #t "DEBUG: handled eof-object on port ~x\n" local-id)
+ (format #t "DEBUG: handled eof-object on port ~x\n" client-id)
(close client)
(8sync-port-remove client)
- (hash-remove! (nm-clients nm) local-id))
+ (hash-remove! (nm-clients nm) client-id))
-(define-method (nm-handle-line (nm <network-manager>) client local-id line)
+(define-method (nm-handle-line nm client client-id line)
"Handle an incoming line of input from a client"
- (format #t "~x got line: ~s\n" local-id line))
+ (<- nm (nm-send-input-to nm) 'client-input
+ #:data line
+ #:client client-id))
+
+(define-method (nm-send-to-client-id nm client-id data)
+ "Send DATA to TO-CLIENT id"
+ (display data
+ (hash-ref (nm-clients nm) client-id)))
; (ez-run-hive hive (list (bootstrap-message hive (actor-id nm) 'start-listening)))
;; (define-method (nm-close-port (nm <network-manager>)))
-(define-generic gm-init-world)
+;;; The game master! Runs the world.
+;;; =================================
+
+;; @@: We could call this a "world builder" instead...
+;; I kinda like calling it a GM though.
+
+(define (gm-init-world gm message)
+ ;; Load database
+ ;; TODO
+
+ ;; Init basic rooms / structure
+ ;; TODO
+
+ ;; Restore database-based actors
+ ;; TODO
+
+ ;; Set up the network
+ (gm-setup-network gm))
+
+(define (gm-setup-network gm)
+ ;; Create a default network manager if none available
+ (set! (gm-network-manager gm)
+ (create-actor* gm <network-manager> "netman"
+ #:send-input-to (actor-id gm)))
+
+ ;; TODO: Add host and port options
+ (<-wait gm (gm-network-manager gm) 'start-listening))
+
+(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))
+ (format #t "From ~s: ~s\n" client-id input)
+ (<- actor (gm-network-manager actor) 'send-to-client
+ #:client client-id
+ #:data "Thanks, we got it!\n"))
+
(define-class <game-master> (<actor>)
+ ;; The directory is a "namespaced" directory of all "special" content
+ ;; in the game, identifiable by some special key.
+ ;; (The namespace is simply a cons of (namespace . special-symbol))
+ (directory #:init-thunk make-hash-table)
+ ;; A mapping of client ids to in-game actors
+ (client-to-actor #:init-thunk make-hash-table)
+ ;; Network manager
+ (network-manager #:accessor gm-network-manager
+ #:init-val #f)
+
(message-handler
#:init-value
(make-action-dispatch
- ;; init-world
- )))
+ (init-world gm-init-world)
+ (client-input gm-handle-client-input))))
+
+
+(define-method (gm-setup-database (gm <game-master>))
+ 'TODO)
+
+(define-method (gm-setup-rooms-etc (gm <game-master>))
+ 'TODO)
+
+;; Debugging stuff
+(define %test-gm #f)
+(define (run-demo . args)
+ (define hive (make-hive))
+ (define gm
+ (hive-create-actor-gimmie* hive <game-master> "gm"))
+ (set! %test-gm gm)
+ ;; @@: Boy, wouldn't it be nice if the agenda could do things
+ ;; on interrupt :P
+ (ez-run-hive hive
+ (list (bootstrap-message hive (actor-id gm) 'init-world))))