goblin-hq.scm 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  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. (use-modules (mudsync)
  19. (8sync actors)
  20. (8sync agenda)
  21. (oop goops)
  22. (ice-9 format))
  23. ;; MEDIAGOBLIN HQ
  24. ;; .-------------.--.--------.-----------.-----------.
  25. ;; | ==== ===== | | | elrond's | |
  26. ;; | ==== ===== | | joar's | goblin | |
  27. ;; | Dootacenter | + codea | ballroom | | <- here be
  28. ;; | ==== ===== + | plex | | | gandaros
  29. ;; | ^-- chris's | ;--------'----+--,---' |
  30. ;; | emacs ai == |@ | [schendje's] | |
  31. ;; | server ==== | | graphic design | TOP SECRET |
  32. ;; '-------------' + sweatshop + LABORATORY |
  33. ;; .--------+-----. | | |
  34. ;; | deb's | '----------------'---------------'
  35. ;; | communication| | | | | | | | | | <- stairs
  36. ;; | cooridoor + _|_|_|_|_|_|_|_|_|
  37. ;; '--------------'
  38. ;;; Game objects
  39. ;;; ============
  40. ;;; The fridge
  41. ;;; ----------
  42. (define-class <fridge> (<gameobj>)
  43. (name #:init-value "fridge")
  44. (desc #:init-value "The refrigerator is humming. To you? To itself?
  45. Only the universe knows."))
  46. ;;; The typewriter
  47. ;;; --------------
  48. (define typewriter-commands
  49. (list
  50. (direct-command "type" 'cmd-type-gibberish)
  51. (indir-command "type" 'cmd-type-something)
  52. (direct-greedy-command "type" 'cmd-type-anything)))
  53. (define typewriter-actions
  54. (build-actions
  55. (cmd-type-gibberish (wrap-apply typewriter-cmd-type-gibberish))
  56. (cmd-type-something (wrap-apply typewriter-cmd-type-something))
  57. (cmd-type-anything (wrap-apply typewriter-cmd-type-anything))))
  58. (define typewriter-dispatch
  59. (simple-dispatcher (append typewriter-actions
  60. gameobj-actions)))
  61. (define-class <typewriter> (<gameobj>)
  62. (name #:init-value "fancy typewriter")
  63. (goes-by #:init-value '("typewriter"
  64. "fancy typewriter"))
  65. (commands #:init-value typewriter-commands)
  66. (message-handler
  67. #:init-value
  68. (wrap-apply typewriter-dispatch)))
  69. (define (typewriter-cmd-type-gibberish actor message)
  70. (<- (message-from message) 'tell
  71. #:text "*tikka takka!* *tikka takka!*
  72. You type some gibberish on the typewriter.\n"))
  73. (define (type-thing actor message type-text)
  74. (<- (message-from message) 'tell
  75. #:text
  76. (format #f "You type out a note.\nThe note says: ~s\n"
  77. type-text)))
  78. (define (typewriter-cmd-type-something
  79. actor message direct-obj indir-obj)
  80. (type-thing actor message direct-obj))
  81. (define (typewriter-cmd-type-anything
  82. actor message direct-obj rest)
  83. (type-thing actor message rest))
  84. ;;; Rooms and stuff
  85. ;;; ===============
  86. (define wooden-unlocked-door "A wooden door. It appears to be unlocked.")
  87. (define metal-stiff-door "A stiff metal door.
  88. It looks like with a hard shove, you could step through it.")
  89. ;; list of lists
  90. (define-syntax-rule (lol (list-contents ...) ...)
  91. (list (list list-contents ...) ...))
  92. (define goblin-rooms
  93. (lol
  94. ('room:server-room
  95. <room> #f
  96. #:name "The dootacenter"
  97. #:desc
  98. "You've entered the server room. The isles alternate between hot and
  99. cold here. It's not not very comfortable in here, and the combined
  100. noise of hundreds, maybe thousands, of fans and various computing
  101. mechanisms creates an unpleasant din. Who'd choose to work in such a
  102. place?
  103. Still, you have to admit that all the machines look pretty nice."
  104. ;; TODO: Allow walking around further in the dootacenter.
  105. #:exits
  106. (list (make <exit>
  107. #:name "east"
  108. #:to 'room:north-hallway
  109. #:desc wooden-unlocked-door))) ; eventually make this locked so you have
  110. ; to kick it down, joeyh style!
  111. ('room:north-hallway
  112. <room> #f
  113. #:name "North hallway"
  114. #:desc
  115. "You're at the north end of the hallway. An open window gives a nice
  116. breeze, and the curtains dance merrily in the wind. Outside appears
  117. to be a pleasant looking lawn.
  118. The hallway continues to the south. There are some doors to the east
  119. and the west."
  120. #:exits
  121. (list (make <exit>
  122. #:name "west"
  123. #:to 'room:server-room
  124. #:desc wooden-unlocked-door)
  125. (make <exit>
  126. #:name "east"
  127. #:to 'room:code-a-plex
  128. #:desc metal-stiff-door)
  129. ;; (make <exit>
  130. ;; #:name "south"
  131. ;; #:to 'center-hallway)
  132. ))
  133. ('room:code-a-plex
  134. <room> #f
  135. #:name "Joar's Code-A-Plex"
  136. #:desc
  137. "You've entered Joar's Code-A-Plex. What that means is anyone's guess.
  138. Joar apparently hangs out in here sometimes, but you don't see him here right
  139. now.
  140. There's a row of computer desks. Most of them have computers already on them,
  141. But one looks invitingly empty."
  142. #:exits
  143. (list (make <exit>
  144. #:name "west"
  145. #:to 'room:north-hallway
  146. #:desc metal-stiff-door)))
  147. ('thing:typewriter
  148. <typewriter> 'room:code-a-plex)
  149. ('thing:fridge
  150. <fridge> 'room:code-a-plex)))
  151. ;; (room:hallway-intersection
  152. ;; ,<room>
  153. ;; #:name "Hallway intersection"
  154. ;; #:desc "You're at the hallway intersection. To the east is a door
  155. ;; labeled \"get to work!\". The hallway continues to the west and to the
  156. ;; south."
  157. ;; #:exits
  158. ;; ,(list (make <exit>
  159. ;; #:name "east"
  160. ;; #:to 'room:))
  161. ;; )
  162. (define (goblin-demo . args)
  163. (run-demo goblin-rooms 'room:north-hallway))