X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgame-master.scm;h=4576de31146cf54c33d9f64c56e195f27389ad16;hp=8bc239bdb9bebedf6eebbe047879f8e495b218ab;hb=bbf45570e7dfe20e132cc8e4601ccbf2de667ff3;hpb=50cd2aba8f13ec7aecb58a683aa55ae665cf83ab diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index 8bc239b..4576de3 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -18,7 +18,7 @@ (define-module (mudsync game-master) #:use-module (mudsync networking) - #:use-module (8sync systems actors) + #:use-module (8sync actors) #:use-module (8sync agenda) #:use-module (oop goops) #:use-module (ice-9 match) @@ -49,26 +49,27 @@ (new-conn-handler #:getter gm-new-conn-handler #:init-keyword #:new-conn-handler) - (message-handler + (actions + #:allocation #:each-subclass #: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!))))) + (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) +(define* (gm-init-world gm message #:key game-spec) ;; Load database ;; TODO ;; Init basic rooms / structure - (gm-init-game-spec gm (message-ref message 'game-spec)) + (gm-init-game-spec gm game-spec) ;; Restore database-based actors ;; TODO @@ -105,7 +106,7 @@ (match-lambda ((special-obj . loc) (if loc - (<-wait gm special-obj 'set-loc! + (<-wait special-obj 'set-loc! #:loc (hash-ref (gm-special-dir gm) loc))))) set-locs) @@ -113,7 +114,7 @@ (for-each (lambda (special-obj) (format #t "Initializing ~s...\n" (address->string special-obj)) - (<-wait gm special-obj 'init)) + (<-wait special-obj 'init)) specials)) @@ -124,43 +125,41 @@ #:send-input-to (actor-id gm))) ;; TODO: Add host and port options - (<-wait gm (gm-network-manager gm) 'start-listening)) + (<-wait (gm-network-manager gm) 'start-listening)) (define (gm-setup-database gm) 'TODO) ;;; .. end world init stuff ... -(define-mhandler (gm-new-client actor message client) +(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) +(define* (gm-handle-client-input actor message + #:key client data) "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)) + (define player (hash-ref (gm-client-dir actor) client)) ;; debugging - (format #t "DEBUG: From ~s: ~s\n" client-id input) + (format #t "DEBUG: From ~s: ~s\n" client data) - (<- actor player 'handle-input - #:input input)) + (<- player 'handle-input + #:input data)) -(define-mhandler (gm-lookup-special actor message symbol) - (<-reply actor message - #:val (hash-ref (slot-ref actor 'special-dir) symbol))) +(define* (gm-lookup-special actor message #:key symbol) + (<-reply message (hash-ref (slot-ref actor 'special-dir) symbol))) -(define-mhandler (gm-write-home actor message text) +(define* (gm-write-home actor message #:key text) (define client-id (hash-ref (gm-reverse-client-dir actor) (message-from message))) - (<- actor (gm-network-manager actor) 'send-to-client + (<- (gm-network-manager actor) 'send-to-client #:client client-id #:data text)) -(define-mhandler (gm-client-closed gm message client) +(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)) @@ -168,13 +167,13 @@ ;; room, if we have one. ;; (In some games, if the user never connected) (when actor-id - (<-wait gm actor-id 'disconnect-self-destruct) + (<-wait 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) +(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 @@ -193,19 +192,19 @@ using the gameobj-spec." #:gm (actor-id gm) args))) ;; Set the location - (<-wait gm special-obj 'set-loc! - #:loc (hash-ref (gm-special-dir gm) loc)) + (<-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 gm special-obj 'init #:replace existing-obj) - (<-wait gm special-obj 'init)) + (<-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 - (<- gm existing-obj 'self-destruct #:why 'replaced)))))) + (<- existing-obj 'self-destruct #:why 'replaced)))))) ;;; GM utilities @@ -221,7 +220,7 @@ using the gameobj-spec." (hash-remove! (gm-reverse-client-dir gm) client-id) ;; Destroy player (if destroy-player - (<- gm player-id 'self-destruct))) + (<- player-id 'self-destruct))) (#f (throw 'no-client-to-unregister "Can't unregister a client that doesn't exist?" client-id)))) @@ -247,10 +246,10 @@ with an anonymous persona" ;; 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) + (<-wait player 'set-loc! #:loc room-id) ;; Initialize the player - (<-wait gm player 'init) - (<- gm room-id 'tell-room + (<-wait player 'init) + (<- room-id 'tell-room #:text (format #f "You see ~a materialize out of thin air!\n" guest-name) #:exclude player)))))