diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for hangman-game + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/Database.hs b/Database.hs new file mode 100644 --- /dev/null +++ b/Database.hs @@ -0,0 +1,1588 @@ +module HangmanAscii.Database + ( conCat + , getWords + ) where + + +import Data.List + + +conCat :: String +conCat = intercalate ", " categoryNames + + +categoryNames :: [String] +categoryNames = + [ "fruites" + , "animals" + , "colours" + , "places" + , "time" + , "weather" + , "misc" + , "foobar" + ] + + +categories :: [[String]] +categories = + [ fruites + , animals + , colours + , places + , time + , weather + , misc + , foobar + ] + + +getWords :: String -> [String] +getWords "all" = mconcat categories +getWords "fruites" = fruites +getWords "animals" = animals +getWords "colours" = colours +getWords "places" = places +getWords "time" = time +getWords "weather" = weather +getWords "misc" = misc +getWords "foobar" = foobar +getWords _ = getWords "all" + + +foobar :: [String] +foobar = + [ "foo" + , "bar" + ] + + +fruites :: [String] +fruites = + [ "apple" + , "apricot" + , "avocado" + , "banana" + , "bilberry" + , "blackberry" + , "blackcurrant" + , "blueberry" + , "boysenberry" + , "currant" + , "cherry" + , "cherimoya" + , "cloudberry" + , "coconut" + , "cranberry" + , "cucumber" + , "damson" + , "date" + , "dragonfruit" + , "durian" + , "elderberry" + , "feijoa" + , "fig" + , "gooseberry" + , "grape" + , "raisin" + , "grapefruit" + , "guava" + , "honeyberry" + , "huckleberry" + , "jabuticaba" + , "jackfruit" + , "jambul" + , "jujube" + , "kiwano" + , "kiwifruit" + , "kumquat" + , "lemon" + , "lime" + , "loquat" + , "longan" + , "lychee" + , "mango" + , "mangosteen" + , "marionberry" + , "melon" + , "cantaloupe" + , "honeydew" + , "watermelon" + , "mulberry" + , "nectarine" + , "nance" + , "olive" + , "orange" + , "clementine" + , "mandarine" + , "tangerine" + , "papaya" + , "passionfruit" + , "peach" + , "pear" + , "persimmon" + , "physalis" + , "plantain" + , "plum" + , "prune" + , "pineapple" + , "plumcot" + , "pomegranate" + , "pomelo" + , "quince" + , "raspberry" + , "salmonberry" + , "rambutan" + , "redcurrant" + , "salak" + , "satsuma" + , "soursop" + , "strawberry" + , "tamarillo" + , "tamarind" + , "yuzu" + ] + + +animals :: [String] +animals = + [ "aardvark" + , "aardwolf" + , "albatross" + , "alligator" + , "alpaca" + , "amphibian" + , "anaconda" + , "angelfish" + , "anglerfish" + , "ant" + , "anteater" + , "antelope" + , "antlion" + , "ape" + , "aphid" + , "armadillo" + , "asp" + , "baboon" + , "badger" + , "bandicoot" + , "barnacle" + , "barracuda" + , "basilisk" + , "bass" + , "bat" + , "bear" + , "beaver" + , "bedbug" + , "bee" + , "beetle" + , "bird" + , "bison" + , "blackbird" + , "boa" + , "boar" + , "bobcat" + , "bobolink" + , "bonobo" + , "booby" + , "bovid" + , "bug" + , "butterfly" + , "buzzard" + , "camel" + , "canid" + , "canidae" + , "capybara" + , "cardinal" + , "caribou" + , "carp" + , "cat" + , "caterpillar" + , "catfish" + , "catshark" + , "cattle" + , "centipede" + , "cephalopod" + , "chameleon" + , "cheetah" + , "chickadee" + , "chicken" + , "chimpanzee" + , "chinchilla" + , "chipmunk" + , "cicada" + , "clam" + , "clownfish" + , "cobra" + , "cockroach" + , "cod" + , "condor" + , "constrictor" + , "coral" + , "cougar" + , "cow" + , "coyote" + , "crab" + , "crane" + , "crawdad" + , "crayfish" + , "cricket" + , "crocodile" + , "crow" + , "cuckoo" + , "damselfly" + , "deer" + , "dingo" + , "dinosaur" + , "dog" + , "dolphin" + , "donkey" + , "dormouse" + , "dove" + , "dragon" + , "dragonfly" + , "duck" + , "eagle" + , "earthworm" + , "earwig" + , "echidna" + , "eel" + , "egret" + , "elephant" + , "elk" + , "emu" + , "ermine" + , "falcon" + , "felidae" + , "ferret" + , "finch" + , "firefly" + , "fish" + , "flamingo" + , "flea" + , "fly" + , "flyingfish" + , "fowl" + , "fox" + , "frog" + , "galliform" + , "gamefowl" + , "gayal" + , "gazelle" + , "gecko" + , "gerbil" + , "gibbon" + , "giraffe" + , "goat" + , "goldfish" + , "goose" + , "gopher" + , "gorilla" + , "grasshopper" + , "grouse" + , "guan" + , "guanaco" + , "guineafowl" + , "gull" + , "guppy" + , "haddock" + , "halibut" + , "hamster" + , "hare" + , "harrier" + , "hawk" + , "hedgehog" + , "heron" + , "herring" + , "hippopotamus" + , "hookworm" + , "hornet" + , "horse" + , "hoverfly" + , "hummingbird" + , "hyena" + , "iguana" + , "impala" + , "jackal" + , "jaguar" + , "jay" + , "jellyfish" + , "junglefowl" + , "kangaroo" + , "kingfisher" + , "kite" + , "kiwi" + , "koala" + , "koi" + , "krill" + , "ladybug" + , "lamprey" + , "landfowl" + , "lark" + , "leech" + , "lemming" + , "lemur" + , "leopard" + , "leopon" + , "limpet" + , "lion" + , "list" + , "lizard" + , "llama" + , "lobster" + , "locust" + , "loon" + , "louse" + , "lungfish" + , "lynx" + , "macaw" + , "mackerel" + , "magpie" + , "manatee" + , "mandrill" + , "marlin" + , "marmoset" + , "marmot" + , "marsupial" + , "marten" + , "mastodon" + , "meadowlark" + , "meerkat" + , "mink" + , "minnow" + , "mite" + , "mockingbird" + , "mole" + , "mollusk" + , "mongoose" + , "monkey" + , "moose" + , "mosquito" + , "moth" + , "mouse" + , "mule" + , "muskox" + , "narwhal" + , "newt" + , "nightingale" + , "ocelot" + , "octopus" + , "opossum" + , "orangutan" + , "orca" + , "ostrich" + , "otter" + , "owl" + , "ox" + , "panda" + , "panther" + , "parakeet" + , "parrot" + , "parrotfish" + , "partridge" + , "peacock" + , "peafowl" + , "pelican" + , "penguin" + , "perch" + , "pheasant" + , "pig" + , "pigeon" + , "pike" + , "pinniped" + , "piranha" + , "planarian" + , "platypus" + , "pony" + , "porcupine" + , "porpoise" + , "possum" + , "prawn" + , "primate" + , "ptarmigan" + , "puffin" + , "puma" + , "python" + , "quail" + , "quelea" + , "quokka" + , "rabbit" + , "raccoon" + , "rat" + , "rattlesnake" + , "raven" + , "reindeer" + , "reptile" + , "rhinoceros" + , "roadrunner" + , "rodent" + , "rook" + , "rooster" + , "roundworm" + , "sailfish" + , "salamander" + , "salmon" + , "sawfish" + , "scallop" + , "scorpion" + , "seahorse" + , "shark" + , "sheep" + , "shrew" + , "shrimp" + , "silkworm" + , "silverfish" + , "skink" + , "skunk" + , "sloth" + , "slug" + , "smelt" + , "snail" + , "snake" + , "snipe" + , "sole" + , "sparrow" + , "spider" + , "spoonbill" + , "squid" + , "squirrel" + , "starfish" + , "stingray" + , "stoat" + , "stork" + , "sturgeon" + , "swallow" + , "swan" + , "swift" + , "swordfish" + , "swordtail" + , "tahr" + , "takin" + , "tapir" + , "tarantula" + , "tarsier" + , "termite" + , "tern" + , "thrush" + , "tick" + , "tiger" + , "tiglon" + , "toad" + , "tortoise" + , "toucan" + , "trout" + , "tuna" + , "turkey" + , "turtle" + , "tyrannosaurus" + , "urial" + , "vicuna" + , "viper" + , "vole" + , "vulture" + , "wallaby" + , "walrus" + , "warbler" + , "wasp" + , "weasel" + , "whale" + , "whippet" + , "whitefish" + , "wildcat" + , "wildebeest" + , "wildfowl" + , "wolf" + , "wolverine" + , "wombat" + , "woodpecker" + , "worm" + , "wren" + , "xerinae" + , "yak" + , "zebra" + ] + + +colours :: [String] +colours = + [ "black" + , "blue" + , "brown" + , "gold" + , "golden" + , "green" + , "grey" + , "orange" + , "pink" + , "purple" + , "red" + , "silver" + , "yellow" + , "white" + ] + + +places :: [String] +places = + [ "apartment" + , "building" + , "bank" + , "bookstore" + , "building" + , "cafe" + , "cafeteria" + , "castle" + , "cinema" + , "clinic" + , "club" + , "college" + , "cottage" + , "department" + , "store" + , "disco" + , "elevator" + , "exit" + , "factory" + , "flat" + , "gallery" + , "garage" + , "hospital" + , "hotel" + , "house" + , "library" + , "lift" + , "museum" + , "office" + , "palace" + , "prison" + , "ruin" + , "school" + , "shop" + , "sports" + , "stadium" + , "supermarket" + , "swimming" + , "tourist" + , "information" + , "centre" + , "tower" + , "university" + , "area" + , "bay" + , "beach" + , "campsite" + , "canal" + , "cliff" + , "desert" + , "earth" + , "farm" + , "field" + , "forest" + , "harbour" + , "hill" + , "island" + , "lake" + , "land" + , "mountain" + , "ocean" + , "path" + , "port" + , "railway" + , "rainforest" + , "region" + , "river" + , "rock" + , "sand" + , "scenery" + , "sea" + , "seaside" + , "sky" + , "stream" + , "valley" + , "village" + , "waterfall" + , "wood" + , "airport" + , "bridge" + , "cashpoint" + , "corner" + , "crossing" + , "crossroads" + , "fountain" + , "market" + , "motorway" + , "monument" + , "park" + , "pavement" + , "playground" + , "road" + , "roundabout" + , "route" + , "signpost" + , "square" + , "station" + , "street" + , "subway" + , "town" + , "tunnel" + , "turning" + , "underground" + , "zoo" + , "bank" + , "cafeteria" + , "cinema" + , "dentist" + , "doctor" + , "gallery" + , "garage" + , "hairdresser" + , "hotel" + , "library" + , "museum" + , "restaurant" + , "theatre" + ] + + +time :: [String] +time = + [ "afternoon" + , "appointment" + , "autumn" + , "birthday" + , "century" + , "clock" + , "daily" + , "date" + , "day" + , "diary" + , "evening" + , "half" + , "holidays" + , "hour" + , "january" + , "february" + , "march" + , "april" + , "may" + , "june" + , "july" + , "august" + , "september" + , "october" + , "november" + , "december" + , "meeting" + , "midnight" + , "minute" + , "moment" + , "monday" + , "tuesday" + , "wednesday" + , "thursday" + , "friday" + , "saturday" + , "sunday" + , "month" + , "monthly" + , "morning" + , "night" + , "noon" + , "clock" + , "past" + , "quarter" + , "second" + , "spring" + , "summer" + , "time" + , "today" + , "tomorrow" + , "tonight" + , "week" + , "weekday" + , "weekend" + , "weekly" + , "winter" + , "year" + , "yesterday" + ] + + +weather :: [String] +weather = + [ "blow" + , "breeze" + , "centigrade" + , "cloud" + , "cloudy" + , "cold" + , "cool" + , "degrees" + , "dry" + , "forecast" + , "fog" + , "foggy" + , "freezing" + , "frozen" + , "gale" + , "heat" + , "hot" + , "humid" + , "ice" + , "icy" + , "lightning" + , "mild" + , "rain" + , "shower" + , "snow" + , "snowfall" + , "storm" + , "sun" + , "sunny" + , "sunshine" + , "temperature" + , "thunder" + , "storm" + , "warm" + , "weather" + , "wet" + , "wind" + , "windy" + ] + + +misc :: [String] +misc = + [ "able" + , "about" + , "account" + , "acid" + , "across" + , "act" + , "addition" + , "adjustment" + , "advertisement" + , "after" + , "again" + , "against" + , "agreement" + , "air" + , "all" + , "almost" + , "among" + , "amount" + , "amusement" + , "and" + , "angle" + , "angry" + , "animal" + , "answer" + , "ant" + , "any" + , "apparatus" + , "apple" + , "approval" + , "arch" + , "argument" + , "arm" + , "army" + , "art" + , "attack" + , "attempt" + , "attention" + , "attraction" + , "authority" + , "automatic" + , "awake" + , "baby" + , "back" + , "bad" + , "bag" + , "balance" + , "ball" + , "band" + , "base" + , "basin" + , "basket" + , "bath" + , "beautiful" + , "because" + , "bed" + , "bee" + , "before" + , "behaviour" + , "belief" + , "bell" + , "bent" + , "berry" + , "between" + , "bird" + , "birth" + , "bit" + , "bite" + , "bitter" + , "black" + , "blade" + , "blood" + , "blow" + , "blue" + , "board" + , "boat" + , "body" + , "boiling" + , "bone" + , "book" + , "boot" + , "bottle" + , "box" + , "boy" + , "brain" + , "brake" + , "branch" + , "brass" + , "bread" + , "breath" + , "brick" + , "bridge" + , "bright" + , "broken" + , "brother" + , "brown" + , "brush" + , "bucket" + , "building" + , "bulb" + , "burn" + , "burst" + , "business" + , "but" + , "butter" + , "button" + , "cake" + , "camera" + , "canvas" + , "card" + , "care" + , "carriage" + , "cart" + , "cat" + , "cause" + , "certain" + , "chain" + , "chalk" + , "chance" + , "change" + , "cheap" + , "cheese" + , "chemical" + , "chest" + , "chief" + , "chin" + , "church" + , "circle" + , "clean" + , "clear" + , "clock" + , "cloth" + , "cloud" + , "coal" + , "coat" + , "cold" + , "collar" + , "colour" + , "comb" + , "come" + , "comfort" + , "committee" + , "common" + , "company" + , "comparison" + , "competition" + , "complete" + , "complex" + , "condition" + , "connection" + , "conscious" + , "control" + , "cook" + , "copper" + , "copy" + , "cord" + , "cork" + , "cotton" + , "cough" + , "country" + , "cover" + , "cow" + , "crack" + , "credit" + , "crime" + , "cruel" + , "crush" + , "cry" + , "cup" + , "cup" + , "current" + , "curtain" + , "curve" + , "cushion" + , "damage" + , "danger" + , "dark" + , "daughter" + , "day" + , "dead" + , "dear" + , "death" + , "debt" + , "decision" + , "deep" + , "degree" + , "delicate" + , "dependent" + , "design" + , "desire" + , "destruction" + , "detail" + , "development" + , "different" + , "digestion" + , "direction" + , "dirty" + , "discovery" + , "discussion" + , "disease" + , "disgust" + , "distance" + , "distribution" + , "division" + , "dog" + , "door" + , "doubt" + , "down" + , "drain" + , "drawer" + , "dress" + , "drink" + , "driving" + , "drop" + , "dry" + , "dust" + , "ear" + , "early" + , "earth" + , "east" + , "edge" + , "education" + , "effect" + , "egg" + , "elastic" + , "electric" + , "end" + , "engine" + , "enough" + , "equal" + , "error" + , "even" + , "event" + , "ever" + , "every" + , "example" + , "exchange" + , "existence" + , "expansion" + , "experience" + , "expert" + , "eye" + , "face" + , "fact" + , "fall" + , "false" + , "family" + , "far" + , "farm" + , "fat" + , "father" + , "fear" + , "feather" + , "feeble" + , "feeling" + , "female" + , "fertile" + , "fiction" + , "field" + , "fight" + , "finger" + , "fire" + , "first" + , "fish" + , "fixed" + , "flag" + , "flame" + , "flat" + , "flight" + , "floor" + , "flower" + , "fly" + , "fold" + , "food" + , "foolish" + , "foot" + , "for" + , "force" + , "fork" + , "form" + , "forward" + , "fowl" + , "frame" + , "free" + , "frequent" + , "friend" + , "from" + , "front" + , "fruit" + , "full" + , "future" + , "garden" + , "general" + , "get" + , "girl" + , "give" + , "glass" + , "glove" + , "goat" + , "gold" + , "good" + , "government" + , "grain" + , "grass" + , "great" + , "green" + , "grey" + , "grip" + , "group" + , "growth" + , "guide" + , "gun" + , "hair" + , "hammer" + , "hand" + , "hanging" + , "happy" + , "harbour" + , "hard" + , "harmony" + , "hat" + , "hate" + , "have" + , "head" + , "healthy" + , "hear" + , "hearing" + , "heart" + , "heat" + , "help" + , "high" + , "history" + , "hole" + , "hollow" + , "hook" + , "hope" + , "horn" + , "horse" + , "hospital" + , "hour" + , "house" + , "how" + , "humour" + , "ice" + , "idea" + , "ill" + , "important" + , "impulse" + , "increase" + , "industry" + , "ink" + , "insect" + , "instrument" + , "insurance" + , "interest" + , "invention" + , "iron" + , "island" + , "jelly" + , "jewel" + , "join" + , "journey" + , "judge" + , "jump" + , "keep" + , "kettle" + , "key" + , "kick" + , "kind" + , "kiss" + , "knee" + , "knife" + , "knot" + , "knowledge" + , "land" + , "language" + , "last" + , "late" + , "laugh" + , "law" + , "lead" + , "leaf" + , "learning" + , "leather" + , "left" + , "leg" + , "let" + , "letter" + , "level" + , "library" + , "lift" + , "light" + , "like" + , "limit" + , "line" + , "linen" + , "lip" + , "liquid" + , "list" + , "little" + , "living" + , "lock" + , "long" + , "look" + , "loose" + , "loss" + , "loud" + , "love" + , "low" + , "machine" + , "make" + , "male" + , "man" + , "manager" + , "map" + , "mark" + , "market" + , "married" + , "mass" + , "match" + , "material" + , "may" + , "meal" + , "measure" + , "meat" + , "medical" + , "meeting" + , "memory" + , "metal" + , "middle" + , "military" + , "milk" + , "mind" + , "mine" + , "minute" + , "mist" + , "mixed" + , "money" + , "monkey" + , "month" + , "moon" + , "morning" + , "mother" + , "motion" + , "mountain" + , "mouth" + , "move" + , "much" + , "muscle" + , "music" + , "nail" + , "name" + , "narrow" + , "nation" + , "natural" + , "near" + , "necessary" + , "neck" + , "need" + , "needle" + , "nerve" + , "net" + , "new" + , "news" + , "night" + , "noise" + , "normal" + , "north" + , "nose" + , "not" + , "note" + , "now" + , "number" + , "nut" + , "observation" + , "off" + , "offer" + , "office" + , "oil" + , "old" + , "only" + , "open" + , "operation" + , "opinion" + , "opposite" + , "orange" + , "order" + , "organization" + , "ornament" + , "other" + , "out" + , "oven" + , "over" + , "owner" + , "page" + , "pain" + , "paint" + , "paper" + , "parallel" + , "parcel" + , "part" + , "past" + , "paste" + , "payment" + , "peace" + , "pen" + , "pencil" + , "person" + , "physical" + , "picture" + , "pig" + , "pin" + , "pipe" + , "place" + , "plane" + , "plant" + , "plate" + , "play" + , "please" + , "pleasure" + , "plough" + , "pocket" + , "point" + , "poison" + , "polish" + , "political" + , "poor" + , "porter" + , "position" + , "possible" + , "pot" + , "potato" + , "powder" + , "power" + , "present" + , "price" + , "print" + , "prison" + , "private" + , "probable" + , "process" + , "produce" + , "profit" + , "property" + , "prose" + , "protest" + , "public" + , "pull" + , "pump" + , "punishment" + , "purpose" + , "push" + , "put" + , "quality" + , "question" + , "quick" + , "quiet" + , "quite" + , "rail" + , "rain" + , "range" + , "rat" + , "rate" + , "ray" + , "reaction" + , "reading" + , "ready" + , "reason" + , "receipt" + , "record" + , "red" + , "regret" + , "regular" + , "relation" + , "religion" + , "representative" + , "request" + , "respect" + , "responsible" + , "rest" + , "reward" + , "rhythm" + , "rice" + , "right" + , "ring" + , "river" + , "road" + , "rod" + , "roll" + , "roof" + , "room" + , "root" + , "rough" + , "round" + , "rub" + , "rule" + , "run" + , "sad" + , "safe" + , "sail" + , "salt" + , "same" + , "sand" + , "say" + , "scale" + , "school" + , "science" + , "scissors" + , "screw" + , "sea" + , "seat" + , "second" + , "secret" + , "secretary" + , "see" + , "seed" + , "seem" + , "selection" + , "self" + , "send" + , "sense" + , "separate" + , "serious" + , "servant" + , "sex" + , "shade" + , "shake" + , "shame" + , "sharp" + , "sheep" + , "shelf" + , "ship" + , "shirt" + , "shock" + , "shoe" + , "short" + , "shut" + , "side" + , "sign" + , "silk" + , "silver" + , "simple" + , "sister" + , "size" + , "skin" + , "skirt" + , "sky" + , "sleep" + , "slip" + , "slope" + , "slow" + , "small" + , "smash" + , "smell" + , "smile" + , "smoke" + , "smooth" + , "snake" + , "sneeze" + , "snow" + , "soap" + , "society" + , "sock" + , "soft" + , "solid" + , "some" + , "son" + , "song" + , "sort" + , "sound" + , "soup" + , "south" + , "space" + , "spade" + , "special" + , "sponge" + , "spoon" + , "spring" + , "square" + , "stage" + , "stamp" + , "star" + , "start" + , "statement" + , "station" + , "steam" + , "steel" + , "stem" + , "step" + , "stick" + , "sticky" + , "stiff" + , "still" + , "stitch" + , "stocking" + , "stomach" + , "stone" + , "stop" + , "store" + , "story" + , "straight" + , "strange" + , "street" + , "stretch" + , "strong" + , "structure" + , "substance" + , "such" + , "sudden" + , "sugar" + , "suggestion" + , "summer" + , "sun" + , "support" + , "surprise" + , "sweet" + , "swim" + , "system" + , "table" + , "tail" + , "take" + , "talk" + , "tall" + , "taste" + , "tax" + , "teaching" + , "tendency" + , "test" + , "than" + , "that" + , "the" + , "then" + , "theory" + , "there" + , "thick" + , "thin" + , "thing" + , "this" + , "thought" + , "thread" + , "throat" + , "through" + , "through" + , "thumb" + , "thunder" + , "ticket" + , "tight" + , "till" + , "time" + , "tin" + , "tired" + , "toe" + , "together" + , "tomorrow" + , "tongue" + , "tooth" + , "top" + , "touch" + , "town" + , "trade" + , "train" + , "transport" + , "tray" + , "tree" + , "trick" + , "trouble" + , "trousers" + , "true" + , "turn" + , "twist" + , "umbrella" + , "under" + , "unit" + , "use" + , "value" + , "verse" + , "very" + , "vessel" + , "view" + , "violent" + , "voice" + , "waiting" + , "walk" + , "wall" + , "war" + , "warm" + , "wash" + , "waste" + , "watch" + , "water" + , "wave" + , "wax" + , "way" + , "weather" + , "week" + , "weight" + , "well" + , "west" + , "wet" + , "wheel" + , "when" + , "where" + , "while" + , "whip" + , "whistle" + , "white" + , "who" + , "why" + , "wide" + , "will" + , "wind" + , "window" + , "wine" + , "wing" + , "winter" + , "wire" + , "wise" + , "with" + , "woman" + , "wood" + , "wool" + , "word" + , "work" + , "worm" + , "wound" + , "writing" + , "wrong" + , "year" + , "yellow" + , "yes" + , "yesterday" + , "you" + , "young" + ] diff --git a/Game.hs b/Game.hs new file mode 100644 --- /dev/null +++ b/Game.hs @@ -0,0 +1,125 @@ +module HangmanAscii.Game + ( Skill(..) + , hangman + ) where + +import Data.Set +import Data.Char +import Data.Bool +import Control.Monad.Trans +import System.Console.Haskeline +import System.Random + +import HangmanAscii.Shape + +rows :: Int +rows = 8 + +maxMistakes :: Skill -> Int +maxMistakes Easy = 18 +maxMistakes Medium = 10 +maxMistakes Hard = 6 + +maxShapeProgress :: Int +maxShapeProgress = maximum $ pSeverity <$> shapeHangman + +shapeProgress :: Skill -> Int -> Int +shapeProgress Easy invalids = invalids +shapeProgress s invalids = maxShapeProgress - (maxMistakes s) + invalids + +data Skill = Easy | Medium | Hard +data Session = Session Int Int +data Game = Game String String Skill (Set Char) (Set Char) +data Status = Playing | GameOver| Won + +randomPick :: [String] -> IO String +randomPick words = (words !!) <$> (randomRIO (0, end)) + where end = (length words) - 1 + +alphabet :: Set Char -> String +alphabet hidden = get.chr <$> [97..122] + where + get :: Char -> Char + get c + | c `member` hidden = ' ' + | otherwise = toUpper c + +printState :: Session -> Status -> Game -> IO () +printState (Session wins fails) st (Game word cat skill valid invalid) = do + putStr $ "\x1b[" ++ (show rows) ++ "A\x1b[0J" + mconcat $ putStrLn <$> zipWith fill + [ "Wins: " ++ (show wins) ++ " Fails: " ++ (show fails) + , mconcat $ (:" ") <$> alphabet (valid `union` invalid) + , "" + , mconcat $ (:" ").wordChar <$> word + , "" + -- , word + , hint st + , "" + ] (shape st <$> [0..6]) + where + fill x y = x ++ replicate (56 - length x) ' ' ++ y + errLen = length invalid + shape Won r = shapeWonRow r 0 + shape _ r = shapeHangmanRow r $ shapeProgress skill errLen + wordChar c + | c `member` valid = c + | otherwise = '_' + hint GameOver = mconcat $ (:" ") <$> word + hint _ = "Category: " ++ cat + +progress :: Char -> Game -> Game +progress c (Game word cat skill valid invalid) + | c `elem` word = Game word cat skill (insert cl valid) invalid + | otherwise = Game word cat skill valid (insert cl invalid) + where cl = toLower c + +status :: Game -> Status +status (Game word cat skill valid invalid) + | (length invalid) == (maxMistakes skill) = GameOver + | (fromList word) == valid = Won + | otherwise = Playing + +stateLoop :: Session -> Game -> InputT IO Bool +stateLoop s g = do + let st = status g + lift (printState s st g) + case st of + GameOver -> outputStrLn "Game Over!" >> return False + Won -> outputStrLn "You won !!!" >> return True + Playing -> do + key <- getInputChar "Guess a character, a ~ z: " + case key of + Nothing -> return False + Just c -> stateLoop s (progress c g) + +continue :: InputT IO Bool +continue = do + key <- getInputChar "Do you want to continue? [Y/n] " + case toLower <$> key of + Nothing -> return False + Just 'n' -> return False + Just 'y' -> return True + Just _ -> do + outputStr "\x1b[1A\x1b[0G" + continue + +updateSession :: Bool -> Session -> Session +updateSession True (Session wins fails) = Session (wins + 1) fails +updateSession False (Session wins fails) = Session wins (fails + 1) + +sessionLoop :: Session -> String -> [String] -> Skill -> InputT IO () +sessionLoop session cat words skill = do + w <- lift (randomPick words) + won <- stateLoop session (Game w cat skill empty empty) + c <- continue + case c of + False -> return () + True -> do + outputStrLn "\x1b[2A\x1b[0J" + sessionLoop (updateSession won session) cat words skill + +hangman :: String -> [String] -> Skill -> IO () +hangman cat words skill = do + mconcat $ replicate rows (putStrLn "") + runInputT defaultSettings $ sessionLoop (Session 0 0) cat words skill diff --git a/HangmanAscii.cabal b/HangmanAscii.cabal new file mode 100644 --- /dev/null +++ b/HangmanAscii.cabal @@ -0,0 +1,38 @@ +-- Initial hangman-game.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: HangmanAscii +version: 0.1.0.1 +synopsis: Yet another Hangman game. +description: + Another command line implementation of the classic + hangman game with ASCII shape and anumation. after + installation with cabal install, execute hangman-ascii + to run the game. + +homepage: https://github.com/pylover/hangman-ascii +license: BSD3 +license-file: LICENSE +author: pylover +maintainer: vahid.mardani@gmail.com +-- copyright: +category: Game +build-type: Simple +extra-source-files: CHANGELOG.md +cabal-version: >=1.10 + +executable hangman-ascii + main-is: Main.hs + other-modules: Game + , Paths_HangmanAscii + , Shape + , Database + -- other-extensions: + build-depends: base >=4.12 && <4.13 + , optparse-applicative >=0.17 && <0.18 + , random >=1.1 && <1.2 + , haskeline >=0.7.4.3 && <0.8 + , mtl >=2.2.2 && <2.3 + , containers >=0.6.0.1 && <0.7 + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2022, pylover + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of pylover nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,62 @@ +module Main where + +import System.IO +import Text.Printf +import Options.Applicative +import Data.Semigroup ((<>)) + +import HangmanAscii.Game +import HangmanAscii.Database +import Paths_HangmanAscii + +data Args = Args + { dbfile :: String + , skill :: String + , category :: String + } + +sample :: Parser Args +sample = Args + <$> strOption + ( long "dbfile" + <> help "Text file, one word per line" + <> value "" + <> metavar "FILENAME" ) + <*> strOption + ( long "skill" + <> short 's' + <> help "easy, medium, hard." + <> showDefault + <> value "medium" + <> metavar "SKILL" ) + <*> strOption + ( long "category" + <> short 'c' + <> help ("Categories: all, " ++ conCat ++ ".") + <> showDefault + <> value "fruites" + <> metavar "SKILL" ) + + +parseArgs :: IO Args +parseArgs = execParser opts + where + opts = info (sample <**> helper) (progDesc "Hangman game") + +loadWords :: String -> String -> IO [String] +loadWords "" category = return $ getWords category +loadWords fn _ = fmap lines $ readFile fn + +getSkill :: String -> Skill +getSkill "easy" = Easy +getSkill "medium" = Medium +getSkill "hard" = Hard + +main :: IO () +main = parseArgs >>= go + where + go :: Args -> IO () + go (Args dbfile skl category) = do + words <- loadWords dbfile category + printf "Total words: %d\r\n" (length words) + hangman category words (getSkill skl) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Shape.hs b/Shape.hs new file mode 100644 --- /dev/null +++ b/Shape.hs @@ -0,0 +1,144 @@ +module HangmanAscii.Shape + ( Pixel(..) + , shapeHangman + , shapeHangmanRow + , shapeWonRow + ) where + + +import Data.Bool + + +data Pixel = Pixel + { pSeverity :: Int + , pRow :: Int + , pColumn :: Int + , pSymbol :: Char + } + deriving (Show) + + +-- +-- +-- \O/ +-- | +-- / \ +-- _________ +-- |_________| + +shapeWon :: [Pixel] +shapeWon = + [ Pixel 0 2 5 'O' + , Pixel 0 2 6 '/' + , Pixel 0 3 5 '|' + , Pixel 0 2 4 '\\' + , Pixel 0 4 4 '/' + , Pixel 0 4 6 '\\' + + , Pixel 0 5 1 '_' + , Pixel 0 5 2 '_' + , Pixel 0 5 3 '_' + , Pixel 0 5 4 '_' + , Pixel 0 5 5 '_' + , Pixel 0 5 6 '_' + , Pixel 0 5 7 '_' + , Pixel 0 5 8 '_' + , Pixel 0 5 9 '_' + + , Pixel 0 6 0 '|' + , Pixel 0 6 1 '_' + , Pixel 0 6 2 '_' + , Pixel 0 6 3 '_' + , Pixel 0 6 4 '_' + , Pixel 0 6 5 '_' + , Pixel 0 6 6 '_' + , Pixel 0 6 7 '_' + , Pixel 0 6 8 '_' + , Pixel 0 6 9 '_' + , Pixel 0 6 10 '|' + ] + +-- +----+ +-- | | +-- | O +-- | /|\ +-- | / \ +-- _|_______ +-- |_________| + +shapeHangman :: [Pixel] +shapeHangman = + [ Pixel 6 0 2 '+' + , Pixel 7 0 3 '-' + , Pixel 8 0 4 '-' + , Pixel 9 0 5 '-' + , Pixel 10 0 6 '-' + , Pixel 11 0 7 '+' + + , Pixel 5 1 2 '|' + , Pixel 12 1 7 '|' + + , Pixel 4 2 2 '|' + , Pixel 13 2 7 'O' + + , Pixel 3 3 2 '|' + , Pixel 14 3 6 '/' + , Pixel 15 3 7 '|' + , Pixel 16 3 8 '\\' + + , Pixel 2 4 2 '|' + , Pixel 17 4 6 '/' + , Pixel 18 4 8 '\\' + + , Pixel 1 5 1 '_' + , Pixel 1 5 2 '|' + , Pixel 1 5 3 '_' + , Pixel 1 5 4 '_' + , Pixel 1 5 5 '_' + , Pixel 1 5 6 '_' + , Pixel 1 5 7 '_' + , Pixel 1 5 8 '_' + , Pixel 1 5 9 '_' + + , Pixel 1 6 0 '|' + , Pixel 1 6 1 '_' + , Pixel 1 6 2 '_' + , Pixel 1 6 3 '_' + , Pixel 1 6 4 '_' + , Pixel 1 6 5 '_' + , Pixel 1 6 6 '_' + , Pixel 1 6 7 '_' + , Pixel 1 6 8 '_' + , Pixel 1 6 9 '_' + , Pixel 1 6 10 '|' + ] + +shapeCharAt :: [Pixel] -> Int -> Int -> Int -> Char +shapeCharAt [] _ _ _ = ' ' +shapeCharAt (x:xs) v r c + | (r == pRow x) && (c == pColumn x) = + bool (pSymbol x) ' ' (v < (pSeverity x)) + | otherwise = shapeCharAt xs v r c + +shapeColumns :: [Pixel] -> Int +shapeColumns s = maximum $ pColumn <$> s + +shapeRows :: [Pixel] -> Int +shapeRows s = maximum $ pRow <$> s + +shapePixels :: [Pixel] -> Int -> Int -> Int -> Int -> Int -> String +shapePixels shape v row col maxRow maxCol + | row > maxRow = "" + | col == maxCol = c : shapePixels shape v (row + 1) 0 maxRow maxCol + | otherwise = c: shapePixels shape v row (col + 1) maxRow maxCol + where c = shapeCharAt shape v row col + +shapeRow :: [Pixel] -> Int -> Int -> String +shapeRow s row v = shapePixels s v row 0 row (shapeColumns s) + +shapeHangmanRow = shapeRow shapeHangman +shapeWonRow = shapeRow shapeWon + +printShape :: Int -> IO () +printShape v = putStrLn $ shapePixels s v 0 0 (shapeRows s) (shapeColumns s) + where s = shapeHangman