worlds/bricabrac.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 ;;; Hotel Bricabrac
  20
  21 (use-modules (mudsync)
  22              (8sync systems actors)
  23              (8sync agenda)
  24              (oop goops)
  25              (ice-9 format))
  26
  27
  28 \f
  29 ;;; Utilities, useful or otherwise
  30 ;;; ==============================
  31
  32 (set! *random-state* (random-state-from-platform))
  33
  34 (define (random-choice lst)
  35   (list-ref lst (random (length lst))))
  36
  37 ;; list of lists, lol.
  38 (define-syntax-rule (lol (list-contents ...) ...)
  39   (list (list list-contents ...) ...))
  40
  41 \f
  42 ;;; Some simple object types.
  43 ;;; =========================
  44
  45 (define readable-commands
  46   (list
  47    (direct-command "read" 'cmd-read)))
  48 (define readable-actions
  49   (build-actions
  50    (cmd-read (wrap-apply readable-cmd-read))))
  51
  52 (define-class <readable> (<gameobj>)
  53   (read-text #:init-value "All it says is: \"Blah blah blah.\""
  54              #:init-keyword #:read-text)
  55   (commands
  56    #:init-value readable-commands)
  57   (message-handler
  58    #:init-value
  59    (simple-dispatcher (append gameobj-actions readable-actions))))
  60
  61 (define (readable-cmd-read actor message)
  62   (<- actor (message-from message) 'tell
  63       #:text (string-append (slot-ref actor 'read-text) "\n")))
  64
  65
  66 \f
  67 ;;; Lobby
  68 ;;; -----
  69
  70 (define-mhandler (npc-chat-randomly actor message)
  71   (define text-to-send
  72     (format #f "~a says: \"~a\"\n"
  73             (slot-ref actor 'name)
  74             (random-choice (slot-ref actor 'catchphrases))))
  75   (<- actor (message-from message) 'tell
  76       #:text text-to-send))
  77
  78 (define chat-commands
  79   (list
  80    (direct-command "chat" 'cmd-chat)))
  81 (define chat-actions
  82   (build-actions
  83    (cmd-chat (wrap-apply npc-chat-randomly))))
  84
  85 (define hotel-owner-grumps
  86   '("Eight sinks!  Eight sinks!  And I couldn't unwind them..."
  87     "Don't mind the mess.  I built this place on a dare, you
  88 know?"
  89     "(*tearfully*) Here, take this parenthesis.  May it serve
  90 you well."
  91     "I gotta get back to the goblin farm soon..."
  92     "Oh, but I was going to make a mansion... a great,
  93 beautiful mansion!  Full of ghosts!  Now all I have is this cruddy
  94 mo... hotel.  Oh... If only I had more time!"
  95     "I told them to paint more of the walls purple.
  96 Why didn't they listen?"
  97     "Listen to that overhead muzak.  Whoever made that doesn't
  98 know how to compose very well!  Have you heard of the bands 'fmt'
  99 or 'skribe'?  Now *that's* composition!"))
 100
 101 (define-class <chatty-npc> (<gameobj>)
 102   (catchphrases #:init-value '("Blarga blarga blarga!")
 103                 #:init-keyword #:catchphrases)
 104   (commands
 105    #:init-value chat-commands)
 106   (message-handler
 107    #:init-value
 108    (simple-dispatcher (append gameobj-actions chat-actions))))
 109
 110 (define random-bricabrac
 111   '("a creepy porcelain doll"
 112     "assorted 1950s robots"
 113     "an exquisite tea set"
 114     "an antique mustard pot"
 115     "the pickled head of Elvis"
 116     "the pickled circuitboard of EVLIS"
 117     "a scroll of teletype paper holding the software Four Freedoms"
 118     "a telephone shaped like an orange cartoon cat"))
 119
 120 (define lobby
 121   (lol
 122    ('room:lobby
 123     <room> #f
 124     #:name "Hotel Lobby"
 125     #:desc
 126     "  You're in some sort of hotel lobby.  You see a large sign hanging
 127 over the desk that says \"Hotel Bricabrac\".  On the desk is a bell
 128 that says \"ring for service\".  Terrible music plays from a speaker
 129 somewhere overhead.
 130   The room is lined with various curio cabinets, filled with all sorts
 131 of kitschy junk.  It looks like whoever decorated this place had great
 132 ambitions, but actually assembled it all in a hurry and used whatever
 133 kind of objects they found lying around.")
 134    ;; NPC: hotel owner
 135    ('npc:hotel-owner
 136     <chatty-npc> 'room:lobby
 137     #:name "a frumpy fellow"
 138     #:desc "  Whoever this is, they looks totally exhausted.  They're
 139 collapsed into the only comfortable looking chair in the room and you
 140 don't get the sense that they're likely to move any time soon.
 141   You notice they're wearing a sticker badly adhesed to their clothing
 142 which says \"Hotel Proprietor\", but they look so disorganized that you
 143 think that can't possibly be true... can it?
 144   Despite their exhaustion, you sense they'd be happy to chat with you,
 145 though the conversation may be a bit one sided."
 146     #:goes-by '("frumpy fellow" "fellow"
 147                 "Chris Webber"  ; heh, did you rtfc?  or was it so obvious?
 148                 "hotel proprietor" "proprietor")
 149     #:catchphrases hotel-owner-grumps)
 150    ;; NPC: desk clerk (comes when you ring the s)
 151    ;;   impatient teenager, only stays around for a few minutes
 152    ;;   complaining, then leaves.
 153
 154    ;; Object: Sign
 155    ('thing:lobby-sign
 156     <readable> 'room:lobby
 157     #:name "the Hotel Bricabrac sign"
 158     #:desc "  It strikes you that there's something funny going on with this sign.
 159 Sure enough, if you look at it hard enough, you can tell that someone
 160 hastily painted over an existing sign and changed the \"M\" to an \"H\".
 161 Classy!"
 162     #:read-text "  All it says is \"Hotel Bricabrac\" in smudged, hasty text."
 163     #:goes-by '("sign"
 164                 "bricabrac sign"
 165                 "hotel sign"
 166                 "hotel bricabrac sign"
 167                 "lobby sign"))
 168
 169    ;; Object: curio cabinets
 170    ('thing:cabinet
 171     <gameobj> 'room:lobby
 172     #:name "a curio cabinet"
 173     #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet")
 174     #:desc (lambda _
 175              (format #f "  The curio cabinet is full of all sorts of oddities!
 176 Something catches your eye!
 177 Ooh, ~a!" (random-choice random-bricabrac))))
 178
 179    ;; Object: desk
 180    ;;  - Object: bell
 181    ;;  - Object: sign in form
 182    ;;  - Object: pamphlet
 183    ;; Object: <invisible bell>: reprimands that you want to ring the
 184    ;;   bell on the desk
 185    )
 186   )
 187
 188
 189 \f
 190 ;;; Playroom
 191 ;;; --------
 192
 193 \f
 194 ;;; Writing room
 195 ;;; ------------
 196
 197 \f
 198 ;;; Armory???
 199 ;;; ---------
 200
 201 ;; ... full of NURPH weapons?
 202
 203 \f
 204 ;;; Smoking parlor
 205 ;;; --------------
 206
 207
 208 \f
 209 ;;; Ennpie's Sea Lounge
 210 ;;; -------------------
 211
 212 \f
 213 ;;; Computer room
 214 ;;; -------------
 215
 216 \f
 217 ;;; Game
 218 ;;; ----
 219
 220 (define game-spec
 221   (append lobby))
 222
 223 (define (run-game . args)
 224   (run-demo "/tmp/bricabrac-game.db" game-spec 'room:lobby))
 225