-(use-modules (mudsync))
+(use-modules (mudsync)
+ (8sync systems actors)
+ (8sync agenda)
+ (oop goops)
+ (ice-9 format))
;; MEDIAGOBLIN HQ
;; .-------------.--.--------.-----------.-----------.
;; | Dootacenter | + codea | ballroom | | <- here be
;; | ==== ===== + | plex | | | gandaros
;; | ^-- chris's | ;--------'----+--,---' |
-;; | emacs ai == |@ | schendje's | |
+;; | emacs ai == |@ | [schendje's] | |
;; | server ==== | | graphic design | TOP SECRET |
;; '-------------' + sweatshop + LABORATORY |
;; .--------+-----. | | |
;; | cooridoor + _|_|_|_|_|_|_|_|_|
;; '--------------'
+\f
+;;; 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-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))
+
+
+\f
+;;; 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
- ,<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
+ <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
- ,<room>
- #: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
- ,<room>
- #: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 <exit>
+ #:name "east"
+ #:to-symbol '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-symbol 'room:server-room
+ #:desc wooden-unlocked-door)
+ (make <exit>
+ #:name "east"
+ #:to-symbol 'room:code-a-plex
+ #:desc metal-stiff-door)
+ ;; (make <exit>
+ ;; #:name "south"
+ ;; #:to-symbol '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."
- ((north-hallway
- "west" ,metal-stiff-door)))))
+ #:exits
+ (list (make <exit>
+ #:name "west"
+ #:to-symbol '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-symbol 'room:))
+;; )
(define (goblin-demo . args)
- (run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway))
+ (run-demo "/tmp/goblin-game.db" goblin-rooms 'room:north-hallway))
projects / mudsync.git / blobdiff