From 018caae3113b78f95427923d5ce21f916ccdc9c9 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Thu, 5 May 2016 21:18:55 -0500 Subject: [PATCH] Add Hotel Bricabrac --- worlds/bricabrac.scm | 209 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 209 insertions(+) create mode 100644 worlds/bricabrac.scm diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm new file mode 100644 index 0000000..a42be39 --- /dev/null +++ b/worlds/bricabrac.scm @@ -0,0 +1,209 @@ +;;; Mudsync --- Live hackable MUD +;;; Copyright © 2016 Christopher Allan Webber +;;; +;;; 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 . + +;;; Hotel Bricabrac + +(use-modules (mudsync) + (8sync systems actors) + (8sync agenda) + (oop goops) + (ice-9 format)) + + + +;;; Utilities, useful or otherwise +;;; ============================== + +(set! *random-state* (random-state-from-platform)) + +(define (random-choice lst) + (list-ref lst (random (length lst)))) + +;; list of lists, lol. +(define-syntax-rule (lol (list-contents ...) ...) + (list (list list-contents ...) ...)) + + +;;; Some simple object types. +;;; ========================= + +(define readable-commands + (list + (direct-command "read" 'cmd-read))) +(define readable-actions + (build-actions + (cmd-read (wrap-apply readable-cmd-read)))) + +(define-class () + (read-text #:init-value "All it says is: \"Blah blah blah.\"" + #:init-keyword #:read-text) + (commands + #:init-value readable-commands) + (message-handler + #:init-value + (simple-dispatcher (append gameobj-actions readable-actions)))) + +(define (readable-cmd-read actor message) + (<- actor (message-from message) 'tell + #:text (string-append (slot-ref actor 'read-text) "\n"))) + + + +;;; Lobby +;;; ----- + +(define-class () + ) + +(define-mhandler (npc-chat-randomly actor message) + (define text-to-send + (format #f "~a says: \"~a\"\n" + (slot-ref actor 'name) + (random-choice (slot-ref actor 'catchphrases)))) + (<- actor (message-from message) 'tell + #:text text-to-send)) + +(define chat-commands + (list + (direct-command "chat" 'cmd-chat))) +(define chat-actions + (build-actions + (cmd-chat (wrap-apply npc-chat-randomly)))) + +(define hotel-owner-grumps + '("Eight sinks! Eight sinks! And I couldn't unwind them..." + "Don't mind the mess. I built this place on a dare, you + know?" + "(*tearfully*) Here, take this parenthesis. May it serve + you well." + "I gotta get back to the goblin farm soon..." + "Oh, but I was going to make a mansion... a great, + beautiful mansion! Full of ghosts! Now all I have is this cruddy + mo... hotel. Oh... If only I had more time!" + "I told them to paint more of the walls purple. + Why didn't they listen?" + "Listen to that overhead muzak. Whoever made that doesn't + know how to compose very well! Have you heard of the bands 'fmt' + or 'skribe'? Now *that's* composition!")) + +(define-class () + (catchphrases #:init-value '("Blarga blarga blarga!") + #:init-keyword #:catchphrases) + (commands + #:init-value chat-commands) + (message-handler + #:init-value + (simple-dispatcher (append gameobj-actions chat-actions)))) + +(define lobby + (lol + ('room:lobby + #f + #:name "Hotel Lobby" + #:desc + " You're in some sort of hotel lobby. You see a large sign hanging +over the desk that says \"Hotel Bricabrac\". On the desk is a bell +that says \"ring for service\". Terrible music plays from a speaker +somewhere overhead. + The room is lined with various curio cabinets, filled with all sorts +of kitschy junk. It looks like whoever decorated this place had great +ambitions, but actually assembled it all in a hurry and used whatever +kind of objects they found lying around.") + ;; NPC: hotel owner + ('npc:hotel-owner + 'room:lobby + #:name "a frumpy fellow" + #:desc " Whoever this is, they looks totally exhausted. They're +collapsed into the only comfortable looking chair in the room and you +don't get the sense that they're likely to move any time soon. + You notice they're wearing a sticker badly adhesed to their clothing +which says \"Hotel Proprietor\", but they look so disorganized that you +think that can't possibly be true... can it? + Despite their exhaustion, you sense they'd be happy to chat with you, +though the conversation may be a bit one sided." + #:goes-by '("frumpy fellow" "fellow" + "Chris Webber" ; heh, did you rtfc? or was it so obvious? + "hotel proprietor" "proprietor") + #:catchphrases hotel-owner-grumps) + ;; NPC: desk clerk (comes when you ring the s) + ;; impatient teenager, only stays around for a few minutes + ;; complaining, then leaves. + + ;; Object: Sign + ('thing:lobby-sign + 'room:lobby + #:name "the Hotel Bricabrac sign" + #:desc " It strikes you that there's something funny going on with this sign. +Sure enough, if you look at it hard enough, you can tell that someone +hastily painted over an existing sign and changed the \"M\" to an \"H\". +Classy!" + #:read-text " All it says is \"Hotel Bricabrac\" in smudged, hasty text." + #:goes-by '("sign" + "bricabrac sign" + "hotel sign" + "hotel bricabrac sign" + "lobby sign")) + + ;; Object: desk + ;; - Object: bell + ;; - Object: sign in form + ;; - Object: pamphlet + ;; Object: curio cabinets + ;; Object: : reprimands that you want to ring the + ;; bell on the desk + ) + ) + + + +;;; Playroom +;;; -------- + + +;;; Writing room +;;; ------------ + + +;;; Armory??? +;;; --------- + +;; ... full of NURPH weapons? + + +;;; Smoking parlor +;;; -------------- + + + +;;; Ennpie's Sea Lounge +;;; ------------------- + + +;;; Computer room +;;; ------------- + + +;;; Game +;;; ---- + +(define game-spec + (append lobby)) + +(define (run-game . args) + (run-demo "/tmp/bricabrac-game.db" game-spec 'room:lobby)) + -- 2.31.1