You can now kiss the frog!

[mudsync.git] / worlds / bricabrac.scm

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 2b0db93039f86786a3ae1bf105c1afeeb14bc8da..523546bd5f4c98a3393c49154ee691bb5f4a9c71 100644 (file)
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -473,6 +473,8 @@ hands!")))
    #:allocation #:each-subclass
    #:init-thunk (build-props
                  '((hd-platter? . #t))))
+  (take-me? #:allocation #:each-subclass
+            #:init-value #t)
   (name #:allocation #:each-subclass
         #:init-value "a glowing disc")
   (desc #:allocation #:each-subclass
@@ -2241,7 +2243,7 @@ comments, and so on flowing from node to node."
       (p
        (ul
         (li (b "Scheme") " "
-            (a "http://cs.au.dk/~hosc/local/HOSC-11-4-pp399-404.pdf"
+            (a "https://en.wikipedia.org/wiki/History_of_the_Scheme_programming_language"
                "was originally started ")
             " to explore the " (b "actor model")
             ". (It became more focused around studying the " (b "lambda calculus")
@@ -2553,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
@@ -2622,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
@@ -2634,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"