;;; 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 ;; .-------------.--.--------.-----------.-----------. ;; | ==== ===== | | | elrond's | | ;; | ==== ===== | | joar's | goblin | | ;; | Dootacenter | + codea | ballroom | | <- here be ;; | ==== ===== + | plex | | | gandaros ;; | ^-- chris's | ;--------'----+--,---' | ;; | emacs ai == |@ | [schendje's] | | ;; | server ==== | | graphic design | TOP SECRET | ;; '-------------' + sweatshop + LABORATORY | ;; .--------+-----. | | | ;; | deb's | '----------------'---------------' ;; | communication| | | | | | | | | | <- stairs ;; | 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.") ;; 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. #: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." #: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 goblin-rooms 'room:north-hallway))