From: Christopher Allan Webber Date: Sat, 30 Apr 2016 18:07:54 +0000 (-0500) Subject: room exit wiring X-Git-Tag: fosdem-2017~208 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=11ff8f1ac1d05e8d00c9936cfac59907eb323318;p=mudsync.git room exit wiring --- diff --git a/mudsync.scm b/mudsync.scm index 36781f4..eee888d 100644 --- a/mudsync.scm +++ b/mudsync.scm @@ -190,10 +190,14 @@ ;; I kinda like calling it a GM though. (define-class () - ;; 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) + ;; Directory of "special" objects. + (special-dir #:init-thunk make-hash-table + #:getter gm-special-dir) + + ;; Room directory. Room symbols to + (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) ;; Network manager @@ -204,15 +208,18 @@ #:init-value (make-action-dispatch (init-world (wrap-apply gm-init-world)) - (client-input (wrap-apply gm-handle-client-input))))) + (client-input (wrap-apply gm-handle-client-input)) + (lookup-room (wrap-apply gm-lookup-room))))) + +;;; .. begin world init stuff .. (define (gm-init-world gm message) ;; Load database ;; TODO ;; Init basic rooms / structure - ;; TODO + (gm-init-rooms gm (message-ref message 'room-spec)) ;; Restore database-based actors ;; TODO @@ -220,6 +227,41 @@ ;; Set up the network (gm-setup-network gm)) +(define (gm-init-rooms gm rooms-spec) + "Initialize the prebuilt rooms" + ;; @@: Would it be nicer to just allow passing in + ;; #:exits to the room spec itself? + (define (exit-from-spec exit-spec) + "Take room exits syntax from the spec, turn it into exits" + (match exit-spec + ((name to-symbol description) + (make + #:name name + #:to-symbol to-symbol + #:description description)))) + + (define rooms + (map + (match-lambda + ((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))) + rooms-spec)) + + ;; now wire up all the exits + (for-each + (lambda (room) + (format #t "Wiring up ~s...\n" (address->string room)) + (<-wait gm room 'wire-exits!)) + rooms)) + + (define (gm-setup-network gm) ;; Create a default network manager if none available (set! (gm-network-manager gm) @@ -229,6 +271,9 @@ ;; TODO: Add host and port options (<-wait gm (gm-network-manager gm) 'start-listening)) +;;; .. end world init stuff ... + + (define (gm-handle-client-input actor message) "Handle input from a client." (define client-id (message-ref message 'client)) @@ -238,12 +283,18 @@ #:client client-id #:data "Thanks, we got it!\n")) +(define-mhandler (gm-lookup-room actor message symbol) + (define room-id + (slot-ref (gm-room-dir actor) symbol)) + (<-reply actor message room-id)) + (define-method (gm-setup-database (gm )) 'TODO) (define-method (gm-setup-rooms-etc (gm )) 'TODO) + ;;; Rooms ;;; ===== @@ -262,13 +313,15 @@ (name #:accessor exit-name #:init-keyword #:name) (description #:accessor exit-description - #:init-keyword #:address) + #:init-keyword #:description) ;; *Note*: These two methods have an extra layer of indirection, but ;; it's for a good reason. - (visible-check #:init-keyword (const #t)) + (visible-check #:init-value (const #t) + #:init-keyword #:visible-check) ;; By default all exits can be traversed - (traverse-check #:init-keyword (const #t))) + (traverse-check #:init-value (const #t) + #:init-keyword #:traverse-check)) (define* (exit-can-traverse? exit actor #:optional (target-actor (actor-id actor))) @@ -314,8 +367,7 @@ ((evict-occupant! actor message who) "De-register an occupant removed from the room" (hash-remove! (slot-ref actor 'occupants) who)) - ((wire-exits! actor message) - (wrap-apply room-wire-exits!))))) + (wire-exits! (wrap-apply room-wire-exits!))))) (define (room-wire-exits! room message) (for-each @@ -337,7 +389,7 @@ ;; Debugging stuff (define %test-gm #f) -(define (run-demo . args) +(define (run-demo db-path room-spec) (define hive (make-hive)) (define gm (hive-create-actor-gimmie* hive "gm")) @@ -345,4 +397,5 @@ ;; @@: 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)))) + (list (bootstrap-message hive (actor-id gm) 'init-world + #:room-spec room-spec))))