+(define-actor <frog> (<chatty-npc>)
+ ;; TODO: Add "open" verb, since obviously people will try that
+ ((cmd-kiss frog-cmd-kiss))
+ (commands
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("kiss") ((direct-command cmd-kiss))))))
+
+(define* (frog-cmd-kiss actor message #:key direct-obj)
+ (define player (message-from message))
+ (define player-loc (mbody-val (<-wait player 'get-loc)))
+ (define player-name (mbody-val (<-wait player 'get-name)))
+ (<- (message-from message) 'tell
+ #:text '((p "You kiss the frog. She blushes and you get a distinctly "
+ "princess'y vibe off of her!")))
+ (<- player-loc 'tell-room
+ #:text `((p ,player-name " kisses the frog! The frog blushes!"))
+ #:exclude player))