Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- record Adventure =
- inventory : List-Set Item,
- current-place-name : String,
- places : List-Dict String Place,
- combinations : List Combination,
- func adventure : String -> List (Pair String Place) -> List Combination -> Adventure =
- \current-place-name \places \combinations
- Adventure
- (list-set (==) [])
- current-place-name
- (list-dict (==) invalid-place places)
- combinations
- func current-place : Adventure -> Place =
- \adv
- (at (current-place-name adv) . places) adv
- func current-place : (Place -> Place) -> Adventure -> Adventure =
- \f \adv
- (places . at (current-place-name adv)) f adv
- func show-inventory : Adventure -> String =
- join " " . map name . values . inventory
- record Place =
- description : String,
- items : List-Set Item,
- objects : List-Set Object,
- directions : List-Dict String String,
- func place : String -> List Item -> List Object -> List (Pair String String) -> Place =
- \description \items \objects \directions
- Place
- description
- (list-set (==) items)
- (list-set (==) objects)
- (list-dict (==) "" directions)
- func invalid-place : Place = place "Invalid place. Reaching this place is a bug." [] [] []
- func full-description : Place -> String =
- \place
- yield-all (description place);
- for (values; items place)
- (yield-all . (" " ++) . short-description);
- for (values; objects place)
- (yield-all . (" " ++) . short-description);
- empty
- record Item =
- name : String,
- short-description : String,
- long-description : String,
- func item : String -> String -> String -> Item = Item
- func == : Item -> Item -> Bool =
- \item1 \item2
- name item1 == name item2
- func != : Item -> Item -> Bool =
- not (==)
- record Object =
- name : String,
- short-description : String,
- long-description : String,
- actions : List Action,
- func object : String -> String -> String -> List Action -> Object = Object
- func == : Object -> Object -> Bool =
- \object1 \object2
- name object1 == name object2
- func != : Object -> Object -> Bool =
- not (==)
- record Action =
- name : String,
- description : String,
- items : List-Set Item,
- outcome : Maybe (Adventure -> Adventure),
- func action : String -> String -> List Item -> Maybe (Adventure -> Adventure) -> Action =
- \name \description \items \outcome
- Action
- name
- description
- (list-set (==) items)
- outcome
- record Combination =
- description : String,
- use-items : List-Set Item,
- new-items : List-Set Item,
- func combination : String -> List Item -> List Item -> Combination =
- \description \use-items \new-items
- Combination
- description
- (list-set (==) use-items)
- (list-set (==) new-items)
- func pick : Item -> Adventure -> Adventure =
- \item \adv
- start-with adv;
- (current-place . items) <- remove item;
- inventory <- add item;
- return self
- func use : Object -> Action -> Adventure -> Adventure =
- \object \action \adv
- start-with adv;
- inventory <- - items action;
- if-none (return self);
- let-some (outcome action) \outcome
- (current-place . objects) <- remove object;
- self <- outcome;
- return self
- func combine : Combination -> Adventure -> Adventure =
- \combo \adv
- start-with adv;
- inventory <- - use-items combo;
- inventory <- + new-items combo;
- return self
- func go-to : String -> Adventure -> Adventure =
- \new-place-name \adv
- start-with adv;
- current-place-name := new-place-name;
- return self
- func special-words : Adventure -> List-Set String =
- \adv
- list-set (==);
- yield-all ["end", "inventory", "look", "pick"];
- for (values; inventory adv)
- (yield . name);
- for (values; items; current-place adv)
- (yield . name);
- for (values; objects; current-place adv)
- (yield . name);
- for (values; objects; current-place adv)
- (yield-all . map name . actions);
- for (keys; directions; current-place adv)
- yield;
- empty
- func play : Adventure -> IO =
- \adv
- println "Welcome to the adventure! Are you ready?";
- println "If not, type 'end' to quit the game.";
- println (description; decode-command adv; parse-words adv "look around");
- adv |> recur \loop \adv
- print "> ";
- scanln \input
- let (parse-words adv input) \words
- if (words == list-set (==) ["end"])
- quit;
- let (decode-command adv words) \command
- println (description command);
- loop (change command adv)
- record Command =
- description : String,
- change : Adventure -> Adventure,
- func parse-words : Adventure -> String -> List-Set String =
- \adv \input
- special-words adv & list-set (==) (split-no-empty whitespace? input)
- func decode-command : Adventure -> List-Set String -> Command =
- \adv \words
- if (words == list-set (==) ["inventory"])
- (Command (show-inventory adv) self);
- if (words == list-set (==) ["look"])
- (Command (full-description; current-place adv) self);
- for (values; inventory adv) (
- \item \next
- if (words == list-set (==) ["look", name item])
- (Command (long-description item) self);
- next
- );
- for (values; items; current-place adv) (
- \item \next
- if (words == list-set (==) ["look", name item])
- (Command (long-description item) self);
- let (list-set (==) ["pick", name item]) \pick-words
- if (words == pick-words)
- (Command
- ("You picked " ++ name item ++ ".")
- (pick item));
- next
- );
- for (values; objects; current-place adv) (
- \object \next
- if (words == list-set (==) ["look", name object])
- (Command (long-description object) self);
- for (actions object) (
- \action \next
- let (map name; values; items action) \required-items
- let (list-set (==) (name object :: name action :: required-items)) \use-words
- if ((words == use-words) && (items action <= inventory adv))
- (Command
- (description action)
- (use object action));
- next
- );
- next
- );
- for-pair (entries; directions; current-place adv) (
- \dir \place-name \next
- let (list-set (==) [dir]) \required-words
- if (words == required-words) (
- let (at place-name; places adv) \new-place
- Command
- (full-description new-place)
- (go-to place-name)
- );
- next
- );
- for (combinations adv) (
- \combo \next
- let (list-set (==) (map name; values; use-items combo)) \combo-words
- if ((words == combo-words) && (use-items combo <= inventory adv))
- (Command
- (description combo)
- (combine combo));
- next
- );
- Command "Can't do that." self
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement