;;; Hotel Bricabrac
(use-modules (mudsync)
- (8sync actors)
- (8sync agenda)
+ (mudsync container)
+ (8sync)
(oop goops)
(ice-9 control)
(ice-9 format)
#:text (string-append (slot-ref actor 'read-text) "\n")))
-;; This one allows you to take from
-
+;; This one allows you to take from items that are proxied by it
(define-actor <proxy-items> (<gameobj>)
((cmd-take-from take-from-proxy))
(proxy-items #:init-keyword #:proxy-items))
(mbody-val (<-wait obj-id 'goes-by)))
(when (ci-member direct-obj goes-by)
(<- obj-id 'cmd-take #:direct-obj direct-obj #:player player)
- (escape)))
+ (escape #f)))
(slot-ref gameobj 'proxy-items))
- (cmd-take-from gameobj message
- #:direct-obj direct-obj #:indir-obj indir-obj
- #:preposition preposition #:player player))))
+ (<- player 'tell
+ #:text `("You don't see any such " ,direct-obj " to take "
+ ,preposition " " ,(slot-ref gameobj 'name) ".")))))
\f
#:allocation #:each-subclass
#:init-thunk (build-commands
("sign" ((prep-direct-command cmd-sign-form '("as"))))))
+
(actions #:allocation #:each-subclass
#:init-thunk (build-actions
(cmd-sign-form sign-cmd-sign-in))))
(take-me? #:init-value
(lambda _
(values #f #:why-not
- `("Hm... no... the cabinet is locked and the properitor "
+ `("Hm, well... the cabinet is locked and the properitor "
"is right over there.")))))
(define lobby
#:desc " A shiny brass bell. Inscribed on its wooden base is the text
\"ring me for service\". You probably could \"ring the bell\" if you
wanted to."
- #:summons 'break-desk-clerk)
+ #:summons 'break-room:desk-clerk)
('lobby:sign-in-form
<sign-in-form> 'lobby
#:desc "It looks like you could sign this form and set your name.")
;; Object: curio cabinets
+ ;; TODO: respond to attempts to open the curio cabinet
('lobby:cabinet
<proxy-items> 'lobby
#:proxy-items '(lobby:porcelain-doll
;;; Grand hallway
;;; -------------
+(define-actor <disc-shield> (<gameobj>)
+ ((cmd-take disc-shield-take)))
+
+(define* (disc-shield-take gameobj message
+ #:key direct-obj
+ (player (message-from message)))
+ (create-gameobj <glowing-disc> (gameobj-gm gameobj)
+ player) ;; set loc to player to put in player's inventory
+ (<- player 'tell
+ #:text '((p "As you attempt to pull the shield / disk platter
+from the statue a shining outline appears around it... and a
+completely separate, glowing copy of the disc materializes into your
+hands!")))
+ (<- (gameobj-loc gameobj) 'tell-room
+ #:text `(,(mbody-val (<-wait player 'get-name))
+ " pulls on the shield of the statue, and a glowing "
+ "copy of it materializes into their hands!")
+ #:exclude player)
+ (<- (gameobj-loc gameobj) 'tell-room
+ #:text
+ '(p "You hear a voice whisper: "
+ (i "\"Share the software... and you'll be free...\""))))
+
+;;; This is the disc that gets put in the player's inventory
+(define-actor <glowing-disc> (<gameobj>)
+ ((cmd-drop glowing-disc-drop-cmd))
+ (initial-props
+ #:allocation #:each-subclass
+ #:init-thunk (build-props
+ '((hd-platter? . #t))))
+ (name #:allocation #:each-subclass
+ #:init-value "a glowing disc")
+ (desc #:allocation #:each-subclass
+ #:init-value "A brightly glowing disc. It's shaped like a hard
+drive platter, not unlike the one from the statue it came from. It's
+labeled \"RL02.5\".")
+ (goes-by #:init-value '("glowing disc" "glowing platter"
+ "glowing disc platter" "glowing disk platter"
+ "platter" "disc" "disk" "glowing shield")))
+
+(define* (glowing-disc-drop-cmd gameobj message
+ #:key direct-obj
+ (player (message-from message)))
+ (<- player 'tell
+ #:text "You drop the glowing disc, and it shatters into a million pieces!")
+ (<- (mbody-val (<-wait player 'get-loc)) 'tell-room
+ #:text `(,(mbody-val (<-wait player 'get-name))
+ " drops a glowing disc, and it shatters into a million pieces!")
+ #:exclude player)
+ (gameobj-self-destruct gameobj))
+
(define grand-hallway
(lol
('grand-hallway
`("Are you seriously considering desecrating a statue?")))
#:goes-by '("hackthena's horns" "horns" "horns of hacktena"))
('grand-hallway:disc-platter
- <gameobj> 'grand-hallway
- #:name "a hard disc platter"
- #:desc "This isn't a shield after all, it seems to be a hard disc
-platter! It looks kind of loose..."
+ <disc-shield> 'grand-hallway
+ #:name "Hackthena's shield"
+ #:desc "No wonder the \"shield\" looks unusual... it seems to be a hard disk
+platter! It has \"RL02.5\" written on it. It looks kind of loose."
#:invisible? #t
- #:goes-by '("hard disc platter" "disc platter" "disc" "shield" "platter"))))
+ #:goes-by '("hackthena's shield" "shield" "platter" "hard disk platter"))))
\f
;;; Playroom
('playroom
<room> #f
#:name "The Playroom"
- #:desc " There are toys scattered everywhere here. It's really unclear
-if this room is intended for children or child-like adults."
+ #:desc '(p (" There are toys scattered everywhere here. It's really unclear
+if this room is intended for children or child-like adults.")
+ (" There are doors to both the east and the west."))
#:exits
(list (make <exit>
#:name "east"
- #:to 'grand-hallway)))
+ #:to 'grand-hallway)
+ (make <exit>
+ #:name "west"
+ #:to 'computer-room)))
('playroom:cubey
<gameobj> 'playroom
#:name "Cubey"
#:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!")
('playroom:toy-chest
- <gameobj> 'playroom
+ <container> 'playroom
#:name "a toy chest"
#:goes-by '("toy chest" "chest")
#:desc (lambda (toy-chest whos-looking)
#:allow-other-keys)
(match (slot-ref clerk 'state)
('on-duty
- (match (assoc (pk 'indir indir-obj) clerk-help-topics)
+ (match (assoc indir-obj clerk-help-topics)
((_ . info)
(<- (message-from message) 'tell
#:text
(begin
(tell-room clerk-slack-excuse-text)
;; back bto the break room
- (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'break-room)))
+ (gameobj-set-loc! clerk (dyn-ref clerk 'break-room))
(tell-room clerk-return-to-slacking-text)
;; annnnnd back to slacking
(slot-set! clerk 'state 'slacking)
;;; Computer room
;;; -------------
+;; Our computer and hard drive are based off the PDP-11 and the RL01 /
+;; RL02 disk drives. However we increment both by .5 (a true heresy)
+;; to distinguish both from the real thing.
+
+(define-actor <hard-drive> (<gameobj>)
+ ((cmd-put-in hard-drive-insert)
+ (cmd-push-button hard-drive-push-button)
+ (get-state hard-drive-act-get-state))
+ (commands #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("insert" ((prep-indir-command cmd-put-in
+ '("in" "inside" "into"))))
+ (("press" "push") ((prep-indir-command cmd-push-button)))))
+ ;; the state moves from: empty -> with-disc -> loading -> ready
+ (state #:init-value 'empty
+ #:accessor .state))
+
+(define (hard-drive-act-get-state hard-drive message)
+ (<-reply message (.state hard-drive)))
+
+(define* (hard-drive-desc hard-drive #:optional whos-looking)
+ `((p "The hard drive is labeled \"RL02.5\". It's a little under a meter tall.")
+ (p "There is a slot where a disk platter could be inserted, "
+ ,(if (eq? (.state hard-drive) 'empty)
+ "which is currently empty"
+ "which contains a glowing platter")
+ ". There is a LOAD button "
+ ,(if (member (.state hard-drive) '(empty with-disc))
+ "which is glowing"
+ "which is pressed in and unlit")
+ ". There is a READY indicator "
+ ,(if (eq? (.state hard-drive) 'ready)
+ "which is glowing."
+ "which is unlit.")
+ ,(if (member (.state hard-drive) '(loading ready))
+ " The machine emits a gentle whirring noise."
+ ""))))
+
+(define* (hard-drive-push-button gameobj message
+ #:key direct-obj indir-obj preposition
+ (player (message-from message)))
+ (define (tell-room text)
+ (<- (gameobj-loc gameobj) 'tell-room
+ #:text text))
+ (define (tell-room-excluding-player text)
+ (<- (gameobj-loc gameobj) 'tell-room
+ #:text text
+ #:exclude player))
+ (cond
+ ((ci-member direct-obj '("button" "load button" "load"))
+ (tell-room-excluding-player
+ `(,(mbody-val (<-wait player 'get-name))
+ " presses the button on the hard disk."))
+ (<- player 'tell
+ #:text "You press the button on the hard disk.")
+
+ (case (.state gameobj)
+ ((empty)
+ ;; I have no idea what this drive did when you didn't have a platter
+ ;; in it and pressed load, but I know there was a FAULT button.
+ (tell-room "You hear some movement inside the hard drive...")
+ (8sleep 1.5)
+ (tell-room
+ '("... but then the FAULT button blinks a couple times. "
+ "What could be missing?")))
+ ((with-disc)
+ (set! (.state gameobj) 'loading)
+ (tell-room "The hard disk begins to spin up!")
+ (8sleep 2)
+ (set! (.state gameobj) 'ready)
+ (tell-room "The READY light turns on!"))
+ ((loading ready)
+ (<- player 'tell
+ #:text '("Pressing the button does nothing right now, "
+ "but it does feel satisfying.")))))
+ (else
+ (<- player 'tell
+ #:text '("How could you think of pressing anything else "
+ "but that tantalizing button right in front of you?")))))
+
+(define* (hard-drive-insert gameobj message
+ #:key direct-obj indir-obj preposition
+ (player (message-from message)))
+ (define our-name (slot-ref gameobj 'name))
+ (define this-thing
+ (call/ec
+ (lambda (return)
+ (for-each (lambda (occupant)
+ (define goes-by (mbody-val (<-wait occupant 'goes-by)))
+ (when (ci-member direct-obj goes-by)
+ (return occupant)))
+ (mbody-val (<-wait player 'get-occupants)))
+ ;; nothing found
+ #f)))
+ (cond
+ ((not this-thing)
+ (<- player 'tell
+ #:text `("You don't seem to have any such " ,direct-obj " to put "
+ ,preposition " " ,our-name ".")))
+ ((not (mbody-val (<-wait this-thing 'get-prop 'hd-platter?)))
+ (<- player 'tell
+ #:text `("It wouldn't make sense to put "
+ ,(mbody-val (<-wait this-thing 'get-name))
+ " " ,preposition " " ,our-name ".")))
+ ((not (eq? (.state gameobj) 'empty))
+ (<- player 'tell
+ #:text "The disk drive already has a platter in it."))
+ (else
+ (set! (.state gameobj) 'with-disc)
+ (<- player 'tell
+ #:text '((p "You insert the glowing disc into the drive.")
+ (p "The LOAD button begins to glow."))))))
+
+(define computer-room
+ (lol
+ ('computer-room
+ <room> #f
+ #:name "Computer Room"
+ #:desc '((p "A sizable computer cabinet covers a good portion of the left
+wall. It emits a pleasant hum which covers the room like a warm blanket.
+Connected to a computer is a large hard drive.")
+ (p "On the floor is a large steel panel. It is closed, but it has
+hinges which suggest it could be opened."))
+ #:exits
+ (list (make <exit>
+ #:name "east"
+ #:to 'playroom)))
+ ('computer-room:hard-drive
+ <hard-drive> 'computer-room
+ #:name "a hard drive"
+ #:desc (wrap-apply hard-drive-desc)
+ #:goes-by '("hard drive" "drive" "hard disk"))))
+
+
\f
;;; Game
;;; ----
(define (game-spec)
(append lobby grand-hallway smoking-parlor
- playroom break-room))
+ playroom break-room computer-room))
;; TODO: Provide command line args
(define (run-game . args)
projects / mudsync.git / blobdiff