+\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 (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))
+
+
+\f
+;;; Rooms and stuff
+;;; ===============
+