From: Christopher Allan Webber Date: Wed, 4 May 2016 21:24:17 +0000 (-0500) Subject: rearchitect so that the world can init with a game-spec, not just a room-spec X-Git-Tag: fosdem-2017~182 X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=commitdiff_plain;h=7525c62ccdf9e3480214831fb14d9a2d30ab139d rearchitect so that the world can init with a game-spec, not just a room-spec Also rearchitect goblin-hq and start adding interesting things. --- diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index 7324278..0d2051e 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -33,10 +33,6 @@ (special-dir #:init-thunk make-hash-table #:getter gm-special-dir) - ;; 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 ;; and a reverse ;p (client-dir #:init-thunk make-hash-table @@ -57,7 +53,7 @@ (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-special (wrap-apply gm-lookup-special)) (new-client (wrap-apply gm-new-client)) (write-home (wrap-apply gm-write-home))))) @@ -69,7 +65,7 @@ ;; TODO ;; Init basic rooms / structure - (gm-init-rooms gm (message-ref message 'room-spec)) + (gm-init-game-spec gm (message-ref message 'game-spec)) ;; Restore database-based actors ;; TODO @@ -77,30 +73,43 @@ ;; Set up the network (gm-setup-network gm)) -(define (gm-init-rooms gm rooms-spec) - "Initialize the prebuilt rooms" - (define rooms +(define (gm-init-game-spec gm game-spec) + "Initialize the prebuilt special objects" + (define set-locs '()) + (define specials (map (match-lambda - ((room-symbol room-class - room-args ...) - ;; initialize the room - (let ((room - (apply create-actor* gm room-class "room" + ((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) - room-args))) - ;; register the room - (hash-set! (gm-room-dir gm) room-symbol room) + args))) + ;; register the object + (hash-set! (gm-special-dir gm) symbol special-obj) + ;; Give ourselves an instruction to set the location + (set! set-locs (cons (cons special-obj loc) set-locs)) ;; pass it back to the map - room))) - rooms-spec)) + special-obj))) + game-spec)) - ;; now wire up all the exits + ;; Set all initial locations + (for-each + (match-lambda + ((special-obj . loc) + (if loc + (<-wait gm special-obj 'set-loc! + #:loc (hash-ref (gm-special-dir gm) loc))))) + set-locs) + + ;; now init all the objects (for-each - (lambda (room) - (format #t "Wiring up ~s...\n" (address->string room)) - (<-wait gm room 'wire-exits!)) - rooms)) + (lambda (special-obj) + (format #t "Initializing ~s...\n" (address->string special-obj)) + (<-wait gm special-obj 'init)) + specials)) (define (gm-setup-network gm) @@ -135,9 +144,9 @@ (<- actor player 'handle-input #:input input)) -(define-mhandler (gm-lookup-room actor message symbol) +(define-mhandler (gm-lookup-special actor message symbol) (<-reply actor message - #:room-id (hash-ref (slot-ref actor 'room-dir) symbol))) + #:room-id (hash-ref (slot-ref actor 'special-dir) symbol))) (define-mhandler (gm-write-home actor message text) (define client-id (hash-ref (gm-reverse-client-dir actor) @@ -177,7 +186,7 @@ with an anonymous persona" (let* ((guest-name (string-append "Guest-" (number->string count))) (room-id - (hash-ref (gm-room-dir gm) default-room)) + (hash-ref (gm-special-dir gm) default-room)) ;; create and register the player (player (create-actor* gm (@@ (mudsync player) ) "player" diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 921850e..a418cf0 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -43,6 +43,7 @@ ;;; Actions supported by all gameobj (define gameobj-actions (build-actions + (init (wrap-apply gameobj-init)) (get-commands (wrap-apply gameobj-get-commands)) (get-container-commands (wrap-apply gameobj-get-container-commands)) (get-occupants (wrap-apply gameobj-get-occupants)) @@ -50,8 +51,7 @@ (remove-occupant! (wrap-apply gameobj-remove-occupant!)) (set-loc! (wrap-apply gameobj-set-loc!)) (get-name (wrap-apply gameobj-get-name)) - (get-desc (wrap-apply gameobj-get-desc)) - )) + (get-desc (wrap-apply gameobj-get-desc)))) ;;; *all* game components that talk to players should somehow ;;; derive from this class. @@ -104,6 +104,13 @@ (reply-message actor message #:val (slot-ref actor slot)))) + +;; @@: This could be kind of a messy way of doing gameobj-init +;; stuff. If only we had generic methods :( +(define-mhandler (gameobj-init actor message) + "Your most basic game object init procedure. Does nothing." + #f) + (define (val-or-run val-or-proc) "Evaluate if a procedure, or just return otherwise" (if (procedure? val-or-proc) diff --git a/mudsync/room.scm b/mudsync/room.scm index 2e1b99f..56c5a59 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -75,6 +75,7 @@ (define room-actions (build-actions ;; desc == description + (init (wrap-apply room-init)) (wire-exits! (wrap-apply room-wire-exits!)) (cmd-go (wrap-apply room-cmd-go)) (cmd-go-where (wrap-apply room-cmd-go-where)) @@ -101,15 +102,17 @@ ;; @@: Can remove this indirection once things settle #:init-value (wrap-apply room-action-dispatch))) +(define (room-init room message) + (room-wire-exits! room)) -(define (room-wire-exits! room message) +(define (room-wire-exits! room) "Actually hook up the rooms' exit addresses to the rooms they claim to point to." (for-each (lambda (exit) (define new-exit (message-ref - (<-wait room (gameobj-gm room) 'lookup-room + (<-wait room (gameobj-gm room) 'lookup-special #:symbol (slot-ref exit 'to-symbol)) 'room-id)) diff --git a/mudsync/run-game.scm b/mudsync/run-game.scm index 286ff7d..89f96f1 100644 --- a/mudsync/run-game.scm +++ b/mudsync/run-game.scm @@ -30,7 +30,7 @@ (define %test-gm #f) -(define (run-demo db-path room-spec default-room) +(define (run-demo db-path game-spec default-room) (define hive (make-hive)) (define new-conn-handler (make-default-room-conn-handler default-room)) @@ -42,4 +42,4 @@ ;; on interrupt :P (ez-run-hive hive (list (bootstrap-message hive (actor-id gm) 'init-world - #:room-spec room-spec)))) + #:game-spec game-spec)))) diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm index e0d9d82..34b430d 100644 --- a/worlds/goblin-hq.scm +++ b/worlds/goblin-hq.scm @@ -1,5 +1,8 @@ (use-modules (mudsync) - (oop goops)) + (8sync systems actors) + (8sync agenda) + (oop goops) + (ice-9 format)) ;; MEDIAGOBLIN HQ ;; .-------------.--.--------.-----------.-----------. @@ -8,7 +11,7 @@ ;; | Dootacenter | + codea | ballroom | | <- here be ;; | ==== ===== + | plex | | | gandaros ;; | ^-- chris's | ;--------'----+--,---' | -;; | emacs ai == |@ | schendje's | | +;; | emacs ai == |@ | [schendje's] | | ;; | server ==== | | graphic design | TOP SECRET | ;; '-------------' + sweatshop + LABORATORY | ;; .--------+-----. | | | @@ -17,66 +20,153 @@ ;; | cooridoor + _|_|_|_|_|_|_|_|_| ;; '--------------' + +;;; Game objects +;;; ============ + +;;; The fridge +;;; ---------- + +(define-class () + #:name "fridge" + #:desc "The refrigerator is humming. To you? To itself? +Only the universe knows.") + + +;;; The typewriter +;;; -------------- + +(define typewriter-commands + (list + (direct-command "type" 'cmd-type-gibberish) + (indir-command "type" 'cmd-type-something) + (direct-greedy-command "type" 'cmd-type-anything))) + +(define typewriter-actions + (build-actions + (cmd-type-gibberish (wrap-apply typewriter-cmd-type-gibberish)) + (cmd-type-something (wrap-apply typewriter-cmd-type-something)) + (cmd-type-anything (wrap-apply typewriter-cmd-type-anything)))) + +(define typewriter-dispatch + (simple-dispatcher (append typewriter-actions + gameobj-actions))) + +(define-class () + (name #:init-value "fancy typewriter") + (goes-by #:init-value '("typewriter" + "fancy typewriter")) + (commands #:init-value typewriter-commands) + (message-handler + #:init-value + (wrap-apply typewriter-dispatch))) + +(define-mhandler (typewriter-cmd-type-gibberish actor message) + (<- actor (message-from message) 'tell + #:text "*tikka takka!* *tikka takka!* +You type some gibberish on the typewriter.\n")) + +(define (type-thing actor message type-text) + (<- actor (message-from message) 'tell + #:text + (format #f "You type out a note.\nThe note says: ~s" + type-text))) + +(define-mhandler (typewriter-cmd-type-something + actor message direct-obj indir-obj) + (type-thing actor message direct-obj)) + +(define-mhandler (typewriter-cmd-type-anything + actor message direct-obj rest) + (type-thing actor message rest)) + + + +;;; Rooms and stuff +;;; =============== + (define wooden-unlocked-door "A wooden door. It appears to be unlocked.") (define metal-stiff-door "A stiff metal door. It looks like with a hard shove, you could step through it.") -(define goblin-rooms - `((server-room - , - #:name "The dootacenter" - #:desc - "You've entered the server room. The isles alternate between hot and cold -here. It's not not very comfortable in here, and the combined noise of hundreds, -maybe thousands, of fans and various computing mechanisms creates an unpleasant -din. Who'd choose to work in such a place? +;; list of lists +(define-syntax-rule (lol (list-contents ...) ...) + (list (list list-contents ...) ...)) +(define goblin-rooms + (lol + ('room:server-room + #f + #:name "The dootacenter" + #:desc + "You've entered the server room. The isles alternate between hot and +cold here. It's not not very comfortable in here, and the combined +noise of hundreds, maybe thousands, of fans and various computing +mechanisms creates an unpleasant din. Who'd choose to work in such a +place? Still, you have to admit that all the machines look pretty nice." - ;; TODO: Allow walking around further in the dootacenter. - #:exits - ,(list (make - #:name "east" - #:to-symbol 'north-hallway - #:desc wooden-unlocked-door))) ; eventually make this locked so you have - ; to kick it down, joeyh style! - (north-hallway - , - #:name "North hallway" - #:desc - "You're at the north end of the hallway. An open window gives a nice breeze, -and the curtains dance merrily in the wind. Outside appears to be a pleasant -looking lawn. - -The hallway continues to the south." - #:exits - ,(list (make - #:name "west" - #:to-symbol 'server-room - #:desc wooden-unlocked-door) - (make - #:name "east" - #:to-symbol 'code-a-plex - #:desc metal-stiff-door) - ;; (make - ;; #:name "south" - ;; #:to-symbol 'center-hallway) - )) - - (code-a-plex - , - #:name "Joar's Code-A-Plex" - #:desc - "You've entered Joar's Code-A-Plex. What that means is anyone's guess. + ;; TODO: Allow walking around further in the dootacenter. + #:exits + (list (make + #:name "east" + #:to-symbol 'room:north-hallway + #:desc wooden-unlocked-door))) ; eventually make this locked so you have + ; to kick it down, joeyh style! + ('room:north-hallway + #f + #:name "North hallway" + #:desc + "You're at the north end of the hallway. An open window gives a nice + breeze, and the curtains dance merrily in the wind. Outside appears +to be a pleasant looking lawn. +The hallway continues to the south. There are some doors to the east +and the west." + #:exits + (list (make + #:name "west" + #:to-symbol 'room:server-room + #:desc wooden-unlocked-door) + (make + #:name "east" + #:to-symbol 'room:code-a-plex + #:desc metal-stiff-door) + ;; (make + ;; #:name "south" + ;; #:to-symbol 'center-hallway) + )) + + ('room:code-a-plex + #f + #:name "Joar's Code-A-Plex" + #:desc + "You've entered Joar's Code-A-Plex. What that means is anyone's guess. Joar apparently hangs out in here sometimes, but you don't see him here right now. - There's a row of computer desks. Most of them have computers already on them, But one looks invitingly empty." - #:exits - ,(list (make - #:name "west" - #:to-symbol 'north-hallway - #:desc metal-stiff-door))))) + #:exits + (list (make + #:name "west" + #:to-symbol 'room:north-hallway + #:desc metal-stiff-door))) + + ('thing:typewriter + 'room:code-a-plex) + + ('thing:fridge + 'room:code-a-plex))) + +;; (room:hallway-intersection +;; , +;; #:name "Hallway intersection" +;; #:desc "You're at the hallway intersection. To the east is a door +;; labeled \"get to work!\". The hallway continues to the west and to the +;; south." +;; #:exits +;; ,(list (make +;; #:name "east" +;; #:to-symbol 'room:)) +;; ) (define (goblin-demo . args) - (run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway)) + (run-demo "/tmp/goblin-game.db" goblin-rooms 'room:north-hallway))