X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fgoblin-hq.scm;h=bd79b800e0734d0d3c5f2f52496c7b0b36dface6;hp=e0d9d8297a8ffcbce3fb469166e4123d68a38a99;hb=e6f8f000860185b49867e9c5610324b30c98abbb;hpb=4738c5ae39e26b65cdba3bec005bfe034c4ea2c2

diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm
index e0d9d82..bd79b80 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 <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))
+
+
+
+;;; 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
-     ,<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."
-     ;; 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.
-
 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)
-  (run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway))
+  (run-demo "/tmp/goblin-game.db" goblin-rooms 'room:north-hallway))