Advertisement
Guest User

Untitled

a guest
May 20th, 2019
62
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.19 KB | None | 0 0
  1. record Adventure =
  2. inventory : List-Set Item,
  3. current-place-name : String,
  4. places : List-Dict String Place,
  5. combinations : List Combination,
  6.  
  7. func adventure : String -> List (Pair String Place) -> List Combination -> Adventure =
  8. \current-place-name \places \combinations
  9. Adventure
  10. (list-set (==) [])
  11. current-place-name
  12. (list-dict (==) invalid-place places)
  13. combinations
  14.  
  15. func current-place : Adventure -> Place =
  16. \adv
  17. (at (current-place-name adv) . places) adv
  18.  
  19. func current-place : (Place -> Place) -> Adventure -> Adventure =
  20. \f \adv
  21. (places . at (current-place-name adv)) f adv
  22.  
  23. func show-inventory : Adventure -> String =
  24. join " " . map name . values . inventory
  25.  
  26. record Place =
  27. description : String,
  28. items : List-Set Item,
  29. objects : List-Set Object,
  30. directions : List-Dict String String,
  31.  
  32. func place : String -> List Item -> List Object -> List (Pair String String) -> Place =
  33. \description \items \objects \directions
  34. Place
  35. description
  36. (list-set (==) items)
  37. (list-set (==) objects)
  38. (list-dict (==) "" directions)
  39.  
  40. func invalid-place : Place = place "Invalid place. Reaching this place is a bug." [] [] []
  41.  
  42. func full-description : Place -> String =
  43. \place
  44. yield-all (description place);
  45. for (values; items place)
  46. (yield-all . (" " ++) . short-description);
  47. for (values; objects place)
  48. (yield-all . (" " ++) . short-description);
  49. empty
  50.  
  51. record Item =
  52. name : String,
  53. short-description : String,
  54. long-description : String,
  55.  
  56. func item : String -> String -> String -> Item = Item
  57.  
  58. func == : Item -> Item -> Bool =
  59. \item1 \item2
  60. name item1 == name item2
  61.  
  62. func != : Item -> Item -> Bool =
  63. not (==)
  64.  
  65. record Object =
  66. name : String,
  67. short-description : String,
  68. long-description : String,
  69. actions : List Action,
  70.  
  71. func object : String -> String -> String -> List Action -> Object = Object
  72.  
  73. func == : Object -> Object -> Bool =
  74. \object1 \object2
  75. name object1 == name object2
  76.  
  77. func != : Object -> Object -> Bool =
  78. not (==)
  79.  
  80. record Action =
  81. name : String,
  82. description : String,
  83. items : List-Set Item,
  84. outcome : Maybe (Adventure -> Adventure),
  85.  
  86. func action : String -> String -> List Item -> Maybe (Adventure -> Adventure) -> Action =
  87. \name \description \items \outcome
  88. Action
  89. name
  90. description
  91. (list-set (==) items)
  92. outcome
  93.  
  94. record Combination =
  95. description : String,
  96. use-items : List-Set Item,
  97. new-items : List-Set Item,
  98.  
  99. func combination : String -> List Item -> List Item -> Combination =
  100. \description \use-items \new-items
  101. Combination
  102. description
  103. (list-set (==) use-items)
  104. (list-set (==) new-items)
  105.  
  106. func pick : Item -> Adventure -> Adventure =
  107. \item \adv
  108. start-with adv;
  109. (current-place . items) <- remove item;
  110. inventory <- add item;
  111. return self
  112.  
  113. func use : Object -> Action -> Adventure -> Adventure =
  114. \object \action \adv
  115. start-with adv;
  116. inventory <- - items action;
  117. if-none (return self);
  118. let-some (outcome action) \outcome
  119. (current-place . objects) <- remove object;
  120. self <- outcome;
  121. return self
  122.  
  123. func combine : Combination -> Adventure -> Adventure =
  124. \combo \adv
  125. start-with adv;
  126. inventory <- - use-items combo;
  127. inventory <- + new-items combo;
  128. return self
  129.  
  130. func go-to : String -> Adventure -> Adventure =
  131. \new-place-name \adv
  132. start-with adv;
  133. current-place-name := new-place-name;
  134. return self
  135.  
  136. func special-words : Adventure -> List-Set String =
  137. \adv
  138. list-set (==);
  139. yield-all ["end", "inventory", "look", "pick"];
  140. for (values; inventory adv)
  141. (yield . name);
  142. for (values; items; current-place adv)
  143. (yield . name);
  144. for (values; objects; current-place adv)
  145. (yield . name);
  146. for (values; objects; current-place adv)
  147. (yield-all . map name . actions);
  148. for (keys; directions; current-place adv)
  149. yield;
  150. empty
  151.  
  152. func play : Adventure -> IO =
  153. \adv
  154. println "Welcome to the adventure! Are you ready?";
  155. println "If not, type 'end' to quit the game.";
  156. println (description; decode-command adv; parse-words adv "look around");
  157. adv |> recur \loop \adv
  158. print "> ";
  159. scanln \input
  160. let (parse-words adv input) \words
  161. if (words == list-set (==) ["end"])
  162. quit;
  163. let (decode-command adv words) \command
  164. println (description command);
  165. loop (change command adv)
  166.  
  167. record Command =
  168. description : String,
  169. change : Adventure -> Adventure,
  170.  
  171. func parse-words : Adventure -> String -> List-Set String =
  172. \adv \input
  173. special-words adv & list-set (==) (split-no-empty whitespace? input)
  174.  
  175. func decode-command : Adventure -> List-Set String -> Command =
  176. \adv \words
  177.  
  178. if (words == list-set (==) ["inventory"])
  179. (Command (show-inventory adv) self);
  180.  
  181. if (words == list-set (==) ["look"])
  182. (Command (full-description; current-place adv) self);
  183.  
  184. for (values; inventory adv) (
  185. \item \next
  186. if (words == list-set (==) ["look", name item])
  187. (Command (long-description item) self);
  188. next
  189. );
  190.  
  191. for (values; items; current-place adv) (
  192. \item \next
  193. if (words == list-set (==) ["look", name item])
  194. (Command (long-description item) self);
  195.  
  196. let (list-set (==) ["pick", name item]) \pick-words
  197. if (words == pick-words)
  198. (Command
  199. ("You picked " ++ name item ++ ".")
  200. (pick item));
  201. next
  202. );
  203.  
  204. for (values; objects; current-place adv) (
  205. \object \next
  206. if (words == list-set (==) ["look", name object])
  207. (Command (long-description object) self);
  208.  
  209. for (actions object) (
  210. \action \next
  211. let (map name; values; items action) \required-items
  212. let (list-set (==) (name object :: name action :: required-items)) \use-words
  213. if ((words == use-words) && (items action <= inventory adv))
  214. (Command
  215. (description action)
  216. (use object action));
  217. next
  218. );
  219. next
  220. );
  221.  
  222. for-pair (entries; directions; current-place adv) (
  223. \dir \place-name \next
  224. let (list-set (==) [dir]) \required-words
  225. if (words == required-words) (
  226. let (at place-name; places adv) \new-place
  227. Command
  228. (full-description new-place)
  229. (go-to place-name)
  230. );
  231. next
  232. );
  233.  
  234. for (combinations adv) (
  235. \combo \next
  236. let (list-set (==) (map name; values; use-items combo)) \combo-words
  237. if ((words == combo-words) && (use-items combo <= inventory adv))
  238. (Command
  239. (description combo)
  240. (combine combo));
  241. next
  242. );
  243.  
  244. Command "Can't do that." self
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement