149 lines
3.9 KiB
Haskell
149 lines
3.9 KiB
Haskell
module Main where
|
|
|
|
import System.Console.ANSI
|
|
import System.IO
|
|
import Language.Words
|
|
import Data.List
|
|
import System.Random
|
|
import Data.Char
|
|
|
|
maxAttempts :: Integer
|
|
maxAttempts = 6
|
|
|
|
err :: String -> IO ()
|
|
err s = do
|
|
setSGR [SetColor Foreground Dull Red]
|
|
putStr s
|
|
setSGR [Reset]
|
|
cursorUpLine 1
|
|
clearLine
|
|
|
|
findGreenMatches :: Char -> String -> String -> Int
|
|
findGreenMatches c (gwc:gwt) (awc:awt) = do
|
|
if gwc == c && gwc == awc then
|
|
1 + findGreenMatches c gwt awt
|
|
else
|
|
findGreenMatches c gwt awt
|
|
findGreenMatches _ _ _ = 0
|
|
|
|
findPossibleMatches :: Char -> String -> Int
|
|
findPossibleMatches c (awc:awt) = do
|
|
if c == awc then
|
|
1 + findPossibleMatches c awt
|
|
else
|
|
findPossibleMatches c awt
|
|
findPossibleMatches _ _ = 0
|
|
|
|
|
|
doGuess :: String -> String -> Int -> IO ()
|
|
doGuess givenWord actualWord i = do
|
|
let gwc = givenWord !! i
|
|
let rwc = actualWord !! i
|
|
if gwc == rwc then do
|
|
setSGR [SetColor Background Dull Green]
|
|
setSGR [SetColor Foreground Vivid Black]
|
|
--else if gwc `elem` actualWord && (length $ filter (\(x, y) -> x == y) $ zip givenWord actualWord) >= 1 then do
|
|
else if gwc `elem` actualWord && (findPossibleMatches gwc actualWord) /= (findGreenMatches gwc givenWord actualWord) then do
|
|
setSGR [SetColor Background Dull Yellow]
|
|
setSGR [SetColor Foreground Vivid Black]
|
|
else if rwc == '_' then
|
|
setSGR [Reset]
|
|
else
|
|
setSGR [SetColor Background Vivid Black]
|
|
|
|
putStr [gwc]
|
|
setSGR [Reset]
|
|
|
|
if i == (length givenWord) - 1 then do
|
|
return ()
|
|
else
|
|
doGuess givenWord actualWord (i + 1)
|
|
|
|
getWord :: String -> Integer -> IO ()
|
|
getWord targetWord attempt = do
|
|
if attempt > maxAttempts then do
|
|
putStrLn $ "you failed! the word was " ++ targetWord
|
|
else do
|
|
hFlush stdout
|
|
clearFromCursorToLineEnd
|
|
word <- getLine
|
|
|
|
case length word of
|
|
5 -> do
|
|
let lowercase = map toLower word
|
|
if ('\'' `elem` lowercase) || (lowercase `notElem` allStringWords) then do
|
|
err "invalid word"
|
|
getWord targetWord attempt
|
|
else do
|
|
cursorUpLine 1
|
|
doGuess lowercase targetWord 0
|
|
if lowercase == targetWord then do
|
|
cursorDownLine 1
|
|
putStrLn "you guessed it! :)"
|
|
else do
|
|
cursorDownLine 1
|
|
putStr "\n"
|
|
cursorUpLine 1
|
|
getWord targetWord (attempt + 1)
|
|
0 -> do
|
|
cursorUpLine 1
|
|
clearLine
|
|
getWord targetWord attempt
|
|
_ -> do
|
|
err "invalid word length! must be 5 chars long"
|
|
getWord targetWord attempt
|
|
|
|
getRandomElem :: StdGen -> [a] -> a
|
|
getRandomElem g list = list !! (fst $ randomR (0, length list - 1) g)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
setSGR [SetConsoleIntensity BoldIntensity]
|
|
putStrLn "\n - wordlehs - "
|
|
setSGR [Reset]
|
|
putStrLn "guess a 5-letter word by making guesses"
|
|
|
|
putStr " - "
|
|
setSGR [SetColor Background Vivid Black]
|
|
putStr "gray"
|
|
setSGR [Reset]
|
|
putStrLn ": no matches found"
|
|
|
|
putStr " - "
|
|
setSGR [SetColor Background Dull Yellow]
|
|
setSGR [SetColor Foreground Vivid Black]
|
|
putStr "yellow"
|
|
setSGR [Reset]
|
|
putStrLn ": letter is in word, but in a different location"
|
|
|
|
putStr " - "
|
|
setSGR [SetColor Background Dull Green]
|
|
setSGR [SetColor Foreground Vivid Black]
|
|
putStr "green"
|
|
setSGR [Reset]
|
|
putStrLn ": correct letter and location"
|
|
|
|
setSGR [SetConsoleIntensity BoldIntensity]
|
|
putStrLn "\n - examples - "
|
|
setSGR [Reset]
|
|
|
|
putStr " "
|
|
doGuess "weary" "w____" 0
|
|
putStrLn "\nthe letter W is in the word and in the correct spot"
|
|
putStr " "
|
|
doGuess "pills" "_____i" 0
|
|
putStrLn "\nthe letter I is in the word but in the wrong spot"
|
|
putStr " "
|
|
doGuess "vague" "___j_" 0
|
|
putStrLn "\nthe letter U is not in the word in any spot\n"
|
|
|
|
putStrLn "now you give it a try!:\n"
|
|
|
|
cursorDownLine 1
|
|
putStr "\n"
|
|
cursorUpLine 1
|
|
g <- getStdGen
|
|
|
|
let randWord = (map toLower $ getRandomElem g $ filter (\x -> length x == 5 && '\'' `notElem` x) allStringWords)
|
|
getWord randWord 1
|