Fix code for going someplace that doesn't exist

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

diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm
index e0d9d8297a8ffcbce3fb469166e4123d68a38a99..b6682c2b36519af932405da7a2183e7101b1d295 100644 (file)
--- a/worlds/goblin-hq.scm
+++ b/worlds/goblin-hq.scm
@@ -1,5 +1,26 @@
+;;; Mudsync --- Live hackable MUD
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;;
+;;; This file is part of Mudsync.
+;;;
+;;; Mudsync is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Mudsync is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mudsync.  If not, see <http://www.gnu.org/licenses/>.
+

 (use-modules (mudsync)
 (use-modules (mudsync)

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

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


@@ -8,7 +29,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 +38,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))