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 732427850fc72b5e9601a112b95afd077b53cd01..0d2051ec48bd43df10abfd3e56e1e38203f3c845 100644 (file)
--- 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)
 
   (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
   ;; 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))
    (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)))))
 
     (new-client (wrap-apply gm-new-client))
     (write-home (wrap-apply gm-write-home)))))
 


@@ -69,7 +65,7 @@
   ;;  TODO
 
   ;; Init basic rooms / structure
   ;;  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
 
   ;; Restore database-based actors
   ;;  TODO


@@ -77,30 +73,43 @@
   ;; Set up the network
   (gm-setup-network gm))
 
   ;; 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
     (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)
                       #: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
           ;; 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
   (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)
 
 
 (define (gm-setup-network gm)


@@ -135,9 +144,9 @@
   (<- actor player 'handle-input
       #:input input))
 
   (<- 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
   (<-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)
 
 (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
       (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>) "player"
              ;; create and register the player
              (player
               (create-actor* gm (@@ (mudsync player) <player>) "player"

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 921850eef534cde51c23a18a1d9be3a7d91d493c..a418cf0c1566b38622dd61d74264f389605c5458 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -43,6 +43,7 @@
 ;;; Actions supported by all gameobj
 (define gameobj-actions
   (build-actions
 ;;; 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))
    (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))
    (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.
 
 ;;; *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))))
 
     (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)
 (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 2e1b99fcdf1d8f94e4712e36736db572e42bb7e3..56c5a5922751a71bb209e92bef8a8f8e9ff3ee1f 100644 (file)
--- a/mudsync/room.scm
+++ b/mudsync/room.scm
@@ -75,6 +75,7 @@
 (define room-actions
   (build-actions
    ;; desc == description
 (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))
    (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)))
 
    ;; @@: 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
   "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))
 
                 #:symbol (slot-ref exit 'to-symbol))
         'room-id))
 

diff --git a/mudsync/run-game.scm b/mudsync/run-game.scm
index 286ff7dbf18b564591aa25ef922d6af3379934ef..89f96f1df8540711f8555917b59a5bf518c14bb4 100644 (file)
--- a/mudsync/run-game.scm
+++ b/mudsync/run-game.scm
@@ -30,7 +30,7 @@
 
 (define %test-gm #f)
 
 
 (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))
   (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
   ;;   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 e0d9d8297a8ffcbce3fb469166e4123d68a38a99..34b430d372def445e64fb70543ad959934c71398 100644 (file)
--- a/worlds/goblin-hq.scm
+++ b/worlds/goblin-hq.scm
@@ -1,5 +1,8 @@
 (use-modules (mudsync)
 (use-modules (mudsync)

-             (oop goops))
+             (8sync systems actors)
+             (8sync agenda)
+             (oop goops)
+             (ice-9 format))

 
 ;;                    MEDIAGOBLIN HQ
 ;; .-------------.--.--------.-----------.-----------.
 
 ;;                    MEDIAGOBLIN HQ
 ;; .-------------.--.--------.-----------.-----------.


@@ -8,7 +11,7 @@
 ;; | Dootacenter |  + codea  | ballroom  |           |  <- here be
 ;; | ====  ===== +  | plex   |           |           |     gandaros
 ;; | ^-- chris's |  ;--------'----+--,---'           |
 ;; | Dootacenter |  + codea  | ballroom  |           |  <- here be
 ;; | ====  ===== +  | plex   |           |           |     gandaros
 ;; | ^-- chris's |  ;--------'----+--,---'           |

-;; | emacs ai == |@ | schendje's     |               |
+;; | emacs ai == |@ | [schendje's]   |               |

 ;; | server ==== |  | graphic design |   TOP SECRET  |
 ;; '-------------'  + sweatshop      +   LABORATORY  |
 ;; .--------+-----. |                |               |
 ;; | server ==== |  | graphic design |   TOP SECRET  |
 ;; '-------------'  + sweatshop      +   LABORATORY  |
 ;; .--------+-----. |                |               |


@@ -17,66 +20,153 @@
 ;; | cooridoor    + _|_|_|_|_|_|_|_|_|
 ;; '--------------'
 
 ;; | cooridoor    + _|_|_|_|_|_|_|_|_|
 ;; '--------------'
 

+\f
+;;; Game objects
+;;; ============
+
+;;; The fridge
+;;; ----------
+
+(define-class <fridge> (<gameobj>)
+  #: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 <typewriter> (<gameobj>)
+  (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))
+
+
+\f
+;;; 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 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
-     ,<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
+    <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."
 Still, you have to admit that all the machines look pretty nice."

-     ;; TODO: Allow walking around further in the dootacenter.
-     #:exits
-     ,(list (make <exit>
-              #: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
-     ,<room>
-     #: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 <exit>
-              #:name "west"
-              #:to-symbol 'server-room
-              #:desc wooden-unlocked-door)
-            (make <exit>
-              #:name "east"
-              #:to-symbol 'code-a-plex
-              #:desc metal-stiff-door)
-            ;; (make <exit>
-            ;;   #:name "south"
-            ;;   #:to-symbol 'center-hallway)
-            ))
-
-    (code-a-plex
-     ,<room>
-     #: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 <exit>
+            #: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
+    <room> #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 <exit>
+            #:name "west"
+            #:to-symbol 'room:server-room
+            #:desc wooden-unlocked-door)
+          (make <exit>
+            #:name "east"
+            #:to-symbol 'room:code-a-plex
+            #:desc metal-stiff-door)
+          ;; (make <exit>
+          ;;   #:name "south"
+          ;;   #:to-symbol 'center-hallway)
+          ))
+
+   ('room:code-a-plex
+    <room> #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.
 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."
 There's a row of computer desks.  Most of them have computers already on them,
 But one looks invitingly empty."

-     #:exits
-     ,(list (make <exit>
-              #:name "west"
-              #:to-symbol 'north-hallway
-              #:desc metal-stiff-door)))))
+    #:exits
+    (list (make <exit>
+            #:name "west"
+            #:to-symbol 'room:north-hallway
+            #:desc metal-stiff-door)))
+
+   ('thing:typewriter
+    <typewriter> 'room:code-a-plex)
+
+   ('thing:fridge
+    <fridge> 'room:code-a-plex)))
+
+;;     (room:hallway-intersection
+;;      ,<room>
+;;      #: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 <exit>
+;;               #:name "east"
+;;               #:to-symbol 'room:))
+;;      )

 
 (define (goblin-demo . args)
 
 (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))