X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fgoblin-hq.scm;h=357f4a6557decaead808d8603e5210e1c394ad3e;hp=7f417da43255ddfa5f3f9fccd964223b23bcf38a;hb=50cd2aba8f13ec7aecb58a683aa55ae665cf83ab;hpb=ce821442c511d803e77233e3086bfd15d1e3eded diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm index 7f417da..357f4a6 100644 --- a/worlds/goblin-hq.scm +++ b/worlds/goblin-hq.scm @@ -1,4 +1,26 @@ -(use-modules (mudsync)) +;;; 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 . + +(use-modules (mudsync) + (8sync systems actors) + (8sync agenda) + (oop goops) + (ice-9 format)) ;; MEDIAGOBLIN HQ ;; .-------------.--.--------.-----------.-----------. @@ -7,7 +29,7 @@ ;; | Dootacenter | + codea | ballroom | | <- here be ;; | ==== ===== + | plex | | | gandaros ;; | ^-- chris's | ;--------'----+--,---' | -;; | emacs ai == |@ | schendje's | | +;; | emacs ai == |@ | [schendje's] | | ;; | server ==== | | graphic design | TOP SECRET | ;; '-------------' + sweatshop + LABORATORY | ;; .--------+-----. | | | @@ -16,51 +38,153 @@ ;; | cooridoor + _|_|_|_|_|_|_|_|_| ;; '--------------' + +;;; Game objects +;;; ============ + +;;; The fridge +;;; ---------- + +(define-class () + (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 () + (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)) + + + +;;; 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 goblin-rooms - `((server-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 + #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." - ;; TODO: Allow walking around further in the dootacenter. - ;; - (("east" north-hallway - ,wooden-unlocked-door))) ; eventually make this locked so you have - ; to kick it down, joeyh style! - (north-hallway - , - #: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." - (("west" server-room ,wooden-unlocked-door) - ("east" code-a-plex ,metal-stiff-door) - ("south" center-hallway #f))) - - (code-a-plex - , - #: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 + #:name "east" + #:to 'room:north-hallway + #:desc wooden-unlocked-door))) ; eventually make this locked so you have + ; to kick it down, joeyh style! + ('room:north-hallway + #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 + #:name "west" + #:to 'room:server-room + #:desc wooden-unlocked-door) + (make + #:name "east" + #:to 'room:code-a-plex + #:desc metal-stiff-door) + ;; (make + ;; #:name "south" + ;; #:to 'center-hallway) + )) + + ('room:code-a-plex + #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. - There's a row of computer desks. Most of them have computers already on them, But one looks invitingly empty." - ((north-hallway - "west" ,metal-stiff-door))))) + #:exits + (list (make + #:name "west" + #:to 'room:north-hallway + #:desc metal-stiff-door))) + + ('thing:typewriter + 'room:code-a-plex) + + ('thing:fridge + 'room:code-a-plex))) + +;; (room:hallway-intersection +;; , +;; #: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 +;; #:name "east" +;; #:to 'room:)) +;; ) (define (goblin-demo . args) - (run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway)) + (run-demo goblin-rooms 'room:north-hallway))