{- The game of Hangman

   Works only for GHCi, not GHC (due to differences in buffering mode)
   Requires a Unix terminal window (for Windows users: use PuTTY to connect to a unix machine)
 -}


-- Some terminal output primitives defined via control characters

clear_screen :: IO()
clear_screen = putStr "\ESC[2J"

type Pos = (Int,Int)

goto :: Pos -> IO()
goto (x,y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")

writeAt :: Pos -> String -> IO()
writeAt p xs = do goto p
                  putStr xs

-- The game itself

-- main function
main :: IO ()
main = do putStr "Input secret word: "
          word <- getWord ""
          clear_screen
          guess word
          main

-- input secret word
getWord xs =
  do x <- getChar
     if x `elem` "\n" then return xs
     else do putStr "\b-"         -- backspace to overwrite echoed input
             getWord (xs ++ [x])

-- sequence of guesses
guess :: String -> IO ()
guess word = loop "" "" gallows
  where
  loop :: String -> String -> [String] -> IO()
  loop guessed missed gals =
    do let word' = map (\x -> if x `elem` guessed then x else '-') word
       writeAt (1,1) (head gals ++ "\n" ++ "Word: " ++ word' ++ "\nMissed: " ++ missed ++ "\n")
       if length gals == 1 then putStrLn ("YOU ARE DEAD: " ++ word)
       else if word' == word then putStrLn "YOU WIN!"
       else do c <- getChar
               let ok = c `elem` word
               loop (if ok then c:guessed else guessed)
                    (if ok then missed else missed++[c])
                    (if ok then gals else tail gals)

-- ASCII art

gallows :: [String]
gallows = map unlines gallowss

gallowss :: [[String]]
gallowss = [
{- ["",
  "|    ",
  "|    ",
  "|    ",
  "|    ",
  "|"],
 ["_____",
  "|    ",
  "|    ",
  "|    ",
  "|    ",
  "|"],
-}
 ["_____",
  "|/   ",
  "|    ",
  "|    ",
  "|    ",
  "|"],
 ["_____",
  "|/  |",
  "|    ",
  "|    ",
  "|    ",
  "|"],
 ["_____",
  "|/  |",
  "|   0",
  "|    ",
  "|    ",
  "|"],
 ["_____",
  "|/  |",
  "|   0",
  "|   |",
  "|    ",
  "|"],
 ["_____",
  "|/  |",
  "|   0",
  "|  /|",
  "|    ",
  "|"],
 ["_____",
  "|/  |",
  "|   0",
  "|  /|\\",
  "|    ",
  "|"],
 ["_____",
  "|/  |",
  "|   0",
  "|  /|\\",
  "|  / ",
  "|"],
 ["_____",
  "|/  |",
  "|   0",
  "|  /|\\",
  "|  / \\",
  "|"]
 ]