You can now kiss the frog! master
authorChristine Lemmer-Webber <cwebber@dustycloud.org>
Sun, 2 Oct 2022 01:39:47 +0000 (21:39 -0400)
committerChristine Lemmer-Webber <cwebber@dustycloud.org>
Sun, 2 Oct 2022 01:39:47 +0000 (21:39 -0400)
worlds/bricabrac.scm

index 6dc44878fb0667be676aee2bfec4948210d4b633..523546bd5f4c98a3393c49154ee691bb5f4a9c71 100644 (file)
@@ -2555,6 +2555,24 @@ re-orients itself.")))
 a bit."))
       #:exclude player))
 
+(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))
 
 
 (define wedding
@@ -2624,7 +2642,7 @@ To the south is the forest."))
     #:read-text `(pre ,wedding-map-text)
     #:goes-by '("map" "wedding map"))
    ('wedding-entrance:frog
-    <chatty-npc> 'wedding-entrance
+    <frog> 'wedding-entrance
     #:name "a frog"
     #:desc "The frog is sitting on top of the hostess podium and doing
 her best to look dignified.  Actually, to be honest, she's doing a pretty
@@ -2636,7 +2654,8 @@ good job looking dignified.  My gosh!  What a dignified frog!"
       "Welcome, welcome! *Ribbit!*"
       "*Ribbit!* We've been waiting for you, come in come in!"
       "We're so happy you're here!"
-      "Hoo, this wedding took a lot of work to plan but it was WORTH IT!"))
+      "Hoo, this wedding took a lot of work to plan but it was WORTH IT!"
+      "A kiss?  Well... I wouldn't object to it..."))
    ('wedding-entrance:podium
     <gameobj> 'wedding-entrance
     #:name "a hostess podium"