worlds/goblin-hq.scm

   1 (use-modules (mudsync)
   2              (8sync systems actors)
   3              (8sync agenda)
   4              (oop goops)
   5              (ice-9 format))
   6
   7 ;;                    MEDIAGOBLIN HQ
   8 ;; .-------------.--.--------.-----------.-----------.
   9 ;; | ====  ===== |  |        | elrond's  |           |
  10 ;; | ====  ===== |  | joar's | goblin    |           |
  11 ;; | Dootacenter |  + codea  | ballroom  |           |  <- here be
  12 ;; | ====  ===== +  | plex   |           |           |     gandaros
  13 ;; | ^-- chris's |  ;--------'----+--,---'           |
  14 ;; | emacs ai == |@ | [schendje's]   |               |
  15 ;; | server ==== |  | graphic design |   TOP SECRET  |
  16 ;; '-------------'  + sweatshop      +   LABORATORY  |
  17 ;; .--------+-----. |                |               |
  18 ;; | deb's        | '----------------'---------------'
  19 ;; | communication|  | | | | | | | | | <- stairs
  20 ;; | cooridoor    + _|_|_|_|_|_|_|_|_|
  21 ;; '--------------'
  22
  23 \f
  24 ;;; Game objects
  25 ;;; ============
  26
  27 ;;; The fridge
  28 ;;; ----------
  29
  30 (define-class <fridge> (<gameobj>)
  31   #:name "fridge"
  32   #:desc "The refrigerator is humming.  To you?  To itself?
  33 Only the universe knows.")
  34
  35
  36 ;;; The typewriter
  37 ;;; --------------
  38
  39 (define typewriter-commands
  40   (list
  41    (direct-command "type" 'cmd-type-gibberish)
  42    (indir-command "type" 'cmd-type-something)
  43    (direct-greedy-command "type" 'cmd-type-anything)))
  44
  45 (define typewriter-actions
  46   (build-actions
  47    (cmd-type-gibberish (wrap-apply typewriter-cmd-type-gibberish))
  48    (cmd-type-something (wrap-apply typewriter-cmd-type-something))
  49    (cmd-type-anything (wrap-apply typewriter-cmd-type-anything))))
  50
  51 (define typewriter-dispatch
  52   (simple-dispatcher (append typewriter-actions
  53                              gameobj-actions)))
  54
  55 (define-class <typewriter> (<gameobj>)
  56   (name #:init-value "fancy typewriter")
  57   (goes-by #:init-value '("typewriter"
  58                           "fancy typewriter"))
  59   (commands #:init-value typewriter-commands)
  60   (message-handler
  61    #:init-value
  62    (wrap-apply typewriter-dispatch)))
  63
  64 (define-mhandler (typewriter-cmd-type-gibberish actor message)
  65   (<- actor (message-from message) 'tell
  66       #:text "*tikka takka!*  *tikka takka!*
  67 You type some gibberish on the typewriter.\n"))
  68
  69 (define (type-thing actor message type-text)
  70   (<- actor (message-from message) 'tell
  71       #:text
  72       (format #f "You type out a note.\nThe note says: ~s"
  73               type-text)))
  74
  75 (define-mhandler (typewriter-cmd-type-something
  76                   actor message direct-obj indir-obj)
  77   (type-thing actor message direct-obj))
  78
  79 (define-mhandler (typewriter-cmd-type-anything
  80                   actor message direct-obj rest)
  81   (type-thing actor message rest))
  82
  83
  84 \f
  85 ;;; Rooms and stuff
  86 ;;; ===============
  87
  88 (define wooden-unlocked-door "A wooden door.  It appears to be unlocked.")
  89 (define metal-stiff-door "A stiff metal door.
  90 It looks like with a hard shove, you could step through it.")
  91
  92 ;; list of lists
  93 (define-syntax-rule (lol (list-contents ...) ...)
  94   (list (list list-contents ...) ...))
  95
  96 (define goblin-rooms
  97   (lol
  98    ('room:server-room
  99     <room> #f
 100     #:name "The dootacenter"
 101     #:desc
 102     "You've entered the server room.  The isles alternate between hot and
 103 cold here.  It's not not very comfortable in here, and the combined
 104 noise of hundreds, maybe thousands, of fans and various computing
 105 mechanisms creates an unpleasant din.  Who'd choose to work in such a
 106 place?
 107 Still, you have to admit that all the machines look pretty nice."
 108     ;; TODO: Allow walking around further in the dootacenter.
 109     #:exits
 110     (list (make <exit>
 111             #:name "east"
 112             #:to-symbol 'room:north-hallway
 113             #:desc wooden-unlocked-door)))  ; eventually make this locked so you have
 114                                         ; to kick it down, joeyh style!
 115    ('room:north-hallway
 116     <room> #f
 117     #:name "North hallway"
 118     #:desc
 119     "You're at the north end of the hallway.  An open window gives a nice
 120  breeze, and the curtains dance merrily in the wind.  Outside appears
 121 to be a pleasant looking lawn.
 122 The hallway continues to the south.  There are some doors to the east
 123 and the west."
 124     #:exits
 125     (list (make <exit>
 126             #:name "west"
 127             #:to-symbol 'room:server-room
 128             #:desc wooden-unlocked-door)
 129           (make <exit>
 130             #:name "east"
 131             #:to-symbol 'room:code-a-plex
 132             #:desc metal-stiff-door)
 133           ;; (make <exit>
 134           ;;   #:name "south"
 135           ;;   #:to-symbol 'center-hallway)
 136           ))
 137
 138    ('room:code-a-plex
 139     <room> #f
 140     #:name "Joar's Code-A-Plex"
 141     #:desc
 142     "You've entered Joar's Code-A-Plex.  What that means is anyone's guess.
 143 Joar apparently hangs out in here sometimes, but you don't see him here right
 144 now.
 145 There's a row of computer desks.  Most of them have computers already on them,
 146 But one looks invitingly empty."
 147     #:exits
 148     (list (make <exit>
 149             #:name "west"
 150             #:to-symbol 'room:north-hallway
 151             #:desc metal-stiff-door)))
 152
 153    ('thing:typewriter
 154     <typewriter> 'room:code-a-plex)
 155
 156    ('thing:fridge
 157     <fridge> 'room:code-a-plex)))
 158
 159 ;;     (room:hallway-intersection
 160 ;;      ,<room>
 161 ;;      #:name "Hallway intersection"
 162 ;;      #:desc "You're at the hallway intersection.  To the east is a door
 163 ;; labeled \"get to work!\".  The hallway continues to the west and to the
 164 ;; south."
 165 ;;      #:exits
 166 ;;      ,(list (make <exit>
 167 ;;               #:name "east"
 168 ;;               #:to-symbol 'room:))
 169 ;;      )
 170
 171 (define (goblin-demo . args)
 172   (run-demo "/tmp/goblin-game.db" goblin-rooms 'room:north-hallway))