worlds/goblin-hq.scm

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