4 次代碼提交 606990a39e ... cec78683f6

作者 SHA1 備註 提交日期
  Christine Lemmer-Webber cec78683f6 You can now kiss the frog! 2 年之前
  Christine Lemmer-Webber 09412a535d non-dead link about scheme's history 2 年之前
  Christine Lemmer-Webber a78f66c9ab You can take the disc, yes 2 年之前
  Christine Lemmer-Webber 8b2cab4df5 Add paper as an alias for teletype paper 2 年之前
共有 1 個文件被更改,包括 25 次插入3 次删除
  1. 25 3
      worlds/bricabrac.scm

+ 25 - 3
worlds/bricabrac.scm

@@ -411,6 +411,7 @@ the four essential freedoms: ")
 English language surrounding the word 'free' have lead to a lot of terminology debates."))
     #:goes-by '("scroll of teletype" "scroll of teletype paper" "teletype scroll"
                 "teletype paper" "scroll" "four freedoms"
+                "paper"
                 "scroll of teletype paper holding the software Four Freedoms"
                 "scroll of teletype paper holding the software four freedoms"))
    ('lobby:orange-cat-phone
@@ -472,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
@@ -2240,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")
@@ -2552,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
@@ -2621,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
@@ -2633,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"