From ea3774311efdb27eaeff459aef3d91d28c8fe0ff Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 30 Apr 2016 17:09:24 -0500 Subject: [PATCH] Finally can connect and get a room description! So much work just to get to that point.... --- mudsync.scm | 194 ++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 164 insertions(+), 30 deletions(-) diff --git a/mudsync.scm b/mudsync.scm index eee888d..cdc03fd 100644 --- a/mudsync.scm +++ b/mudsync.scm @@ -120,7 +120,10 @@ (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))))) + ;; @@: Do we need an 8sync-port-wait here? + ;; Is such a thing even possible? :\ + (8sync-port client #:read (nm-make-client-receive nm client-id)) + (<- nm (nm-send-input-to nm) 'new-client #:client client-id)))) (define (nm-make-client-receive nm client-id) "Make a method to receive client data" @@ -173,8 +176,13 @@ (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))) + (define client-obj (hash-ref (nm-clients nm) client-id)) + (if (not client-obj) + (throw 'no-such-client + "Asked to send data to client but that client doesn't exist" + #:client-id client-id + #:data data)) + (display data client-obj)) ; (ez-run-hive hive (list (bootstrap-message hive (actor-id nm) 'start-listening))) @@ -194,22 +202,33 @@ (special-dir #:init-thunk make-hash-table #:getter gm-special-dir) - ;; Room directory. Room symbols to + ;; Room directory. Room symbols to locations. (room-dir #:init-thunk make-hash-table #:getter gm-room-dir) ;; A mapping of client ids to in-game actors - (client-to-actor #:init-thunk make-hash-table) + ;; 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 #:accessor gm-network-manager #:init-value #f) + ;; How we get a new connection acclimated to the system + (new-conn-handler #:accessor 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-room (wrap-apply gm-lookup-room))))) + (lookup-room (wrap-apply gm-lookup-room)) + (new-client (wrap-apply gm-new-client)) + (write-home (wrap-apply gm-write-home))))) ;;; .. begin world init stuff .. @@ -234,11 +253,11 @@ (define (exit-from-spec exit-spec) "Take room exits syntax from the spec, turn it into exits" (match exit-spec - ((name to-symbol description) + ((name to-symbol desc) (make #:name name #:to-symbol to-symbol - #:description description)))) + #:desc desc)))) (define rooms (map @@ -246,12 +265,16 @@ ((room-symbol room-class room-args ... (room-exits ...)) - ;; initialize the room - (apply create-actor* gm room-class "room" - #:gm (actor-id gm) - #:exits (map exit-from-spec room-exits) - room-args))) + (let ((room + (apply create-actor* gm room-class "room" + #:gm (actor-id gm) + #:exits (map exit-from-spec room-exits) + room-args))) + ;; register the room + (hash-set! (gm-room-dir gm) room-symbol room) + ;; pass it back to the map + room))) rooms-spec)) ;; now wire up all the exits @@ -271,8 +294,15 @@ ;; 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." @@ -288,11 +318,68 @@ (slot-ref (gm-room-dir actor) symbol)) (<-reply actor message room-id)) -(define-method (gm-setup-database (gm )) - 'TODO) +(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)) + + +;;; 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) + "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 + (<- gm player-id 'destroy-self)) + (#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) + (define guest-name (string-append "Guest-" + (number->string count))) + (define room-id + (hash-ref (gm-room-dir gm) default-room)) + ;; create and register the player + (define player + (create-actor* gm "player" + #:username 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! #:id room-id) + ;; Initialize the player + (<- gm player 'init)))) + + +;;; Game actor +;;; ========== -(define-method (gm-setup-rooms-etc (gm )) - 'TODO) +;;; *all* game components that talk to players should somehow +;;; derive from this class. +;;; And all of them need a GM! + +(define-class () + (gm #:init-keyword #:gm + #:getter game-actor-gm)) @@ -312,8 +399,8 @@ ;; Name of the room (@@: Should this be names?) (name #:accessor exit-name #:init-keyword #:name) - (description #:accessor exit-description - #:init-keyword #:description) + (desc #:accessor exit-desc + #:init-keyword #:desc) ;; *Note*: These two methods have an extra layer of indirection, but ;; it's for a good reason. @@ -339,10 +426,10 @@ #:val (slot-ref actor slot)))) -(define-class () +(define-class () (name #:init-keyword #:name) - (description #:init-value "" - #:init-keyword #:description) + (desc #:init-value "" + #:init-keyword #:desc) ;; Uses a hash table like a set (values ignored) (occupants #:init-thunk make-hash-table) ;; A list of @@ -350,15 +437,14 @@ #:getter room-exits) ;; @@: Maybe eventually will inherit from some more general ;; game object class - (gm #:init-keyword #:gm - #:getter room-gm) (message-handler #:allocation #:each-subclass #:init-value (make-action-dispatch - (get-description - (simple-slot-getter 'description)) + ;; desc == description + (get-desc + (simple-slot-getter 'desc)) (get-name (simple-slot-getter 'name)) ((register-occupant! actor message who) @@ -370,10 +456,12 @@ (wire-exits! (wrap-apply room-wire-exits!))))) (define (room-wire-exits! room message) + "Actually hook up the rooms' exit addresses to the rooms they +claim to point to." (for-each (lambda (exit) (define new-exit - (<-wait room (room-gm room) 'lookup-room + (<-wait room (game-actor-gm room) 'lookup-room #:symbol (exit-to-symbol exit))) (set! (exit-to-address exit) new-exit)) @@ -385,14 +473,60 @@ ;;; Players ;;; ======= +(define-class () + (username #:init-keyword #:username + #:accessor player-username) + ;; location id + (loc #:init-value #f + #:accessor player-loc) + ;; Connection id + (client #:accessor player-client) + + (message-handler + #:init-value + (make-action-dispatch + (set-loc! (wrap-apply player-set-loc!)) + (init (wrap-apply player-init!))))) + +;;; player message handlers + +(define-mhandler (player-set-loc! player message id) + (format #t "DEBUG: Location set to ~s for player ~s" + id (actor-id-actor player)) + (set! (player-loc player) id)) + +(define-mhandler (player-init! player message) + (player-look-around player)) + +;;; player methods + +(define (player-look-around player) + (define room-name + (message-ref + (<-wait player (player-loc player) 'get-name) + 'val)) + (define room-desc + (message-ref + (<-wait player (player-loc player) 'get-desc) + 'val)) + (define message-text + (format #f "**~a**\n~a\n" room-name room-desc)) + + (<- player (game-actor-gm player) 'write-home #:text message-text)) + + +;;; Debugging stuff +;;; =============== -;; Debugging stuff (define %test-gm #f) -(define (run-demo db-path room-spec) +(define (run-demo db-path room-spec default-room) (define hive (make-hive)) + (define new-conn-handler + (make-default-room-conn-handler default-room)) (define gm - (hive-create-actor-gimmie* hive "gm")) + (hive-create-actor-gimmie* hive "gm" + #:new-conn-handler new-conn-handler)) (set! %test-gm gm) ;; @@: Boy, wouldn't it be nice if the agenda could do things ;; on interrupt :P -- 2.31.1