mudsync/worlds/goblin-hq.scm

;;; Mudsync --- Live hackable MUD
;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(use-modules (mudsync)
             (8sync 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 <fridge> (<gameobj>)
  (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 <typewriter> (<gameobj>)
  (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 (typewriter-cmd-type-gibberish actor message)
  (<- (message-from message) 'tell
      #:text "*tikka takka!*  *tikka takka!*
You type some gibberish on the typewriter.\n"))

(define (type-thing actor message type-text)
  (<- (message-from message) 'tell
      #:text
      (format #f "You type out a note.\nThe note says: ~s\n"
              type-text)))

(define (typewriter-cmd-type-something
         actor message direct-obj indir-obj)
  (type-thing actor message direct-obj))

(define (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
    <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 <exit>
            #: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
    <room> #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 <exit>
            #:name "west"
            #:to 'room:server-room
            #:desc wooden-unlocked-door)
          (make <exit>
            #:name "east"
            #:to 'room:code-a-plex
            #:desc metal-stiff-door)
          ;; (make <exit>
          ;;   #:name "south"
          ;;   #:to 'center-hallway)
          ))

   ('room:code-a-plex
    <room> #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 <exit>
            #:name "west"
            #:to 'room:north-hallway
            #:desc metal-stiff-door)))

   ('thing:typewriter
    <typewriter> 'room:code-a-plex)

   ('thing:fridge
    <fridge> 'room:code-a-plex)))

;;     (room:hallway-intersection
;;      ,<room>
;;      #: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 <exit>
;;               #:name "east"
;;               #:to 'room:))
;;      )

(define (goblin-demo . args)
  (run-demo goblin-rooms 'room:north-hallway))