X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgame-master.scm;h=b11d21cff800e1955a730c97e196c13b55ca8c2d;hp=05de6697c7db54c4c6221d0afc225caff1f2df78;hb=701425bc611abaa8b4140942d995d5f32d24e2d7;hpb=dc6370a830b0f027db2e75e22b65a1a978e13f18 diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index 05de669..b11d21c 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -18,10 +18,11 @@ (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) + #:use-module (srfi srfi-26) #:export ( make-default-room-conn-handler)) @@ -48,25 +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))))) + (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 @@ -74,6 +77,8 @@ ;; 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 '()) @@ -127,36 +132,34 @@ ;;; .. 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)) + #:input data)) -(define-mhandler (gm-lookup-special actor message symbol) - (<-reply actor message - #:room-id (hash-ref (slot-ref actor 'special-dir) symbol))) +(define* (gm-lookup-special actor message #:key symbol) + (<-reply actor 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 #: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)) @@ -169,6 +172,40 @@ (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 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) @@ -211,5 +248,8 @@ with an anonymous persona" ;; Dump the player into the default room (<-wait gm player 'set-loc! #:loc room-id) ;; Initialize the player - (<- gm player 'init))))) - + (<-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)))))