curio cabinet and stuff

[mudsync.git] / worlds / goblin-hq.scm

diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm
index e0d9d8297a8ffcbce3fb469166e4123d68a38a99..bd79b800e0734d0d3c5f2f52496c7b0b36dface6 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 #:init-value "fridge")
+  (desc #:init-value "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\n"
+              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))