module Hs2048.Main
( direction
, getChars
, getMove
, play
) where
import qualified Hs2048.Board as B
import qualified Hs2048.Direction as D
import qualified Hs2048.Game as G
import Hs2048.Renderer (renderGame)
import System.IO (BufferMode (NoBuffering), hSetBuffering,
hSetEcho, stdin)
import qualified System.Random as R
direction :: String -> Maybe D.Direction
direction "\ESC[D" = Just D.West
direction "\ESC[B" = Just D.South
direction "\ESC[C" = Just D.East
direction "\ESC[A" = Just D.North
direction _ = Nothing
getChars :: IO (Maybe String)
getChars = do
a <- getChar
if a /= '\ESC' then return Nothing else do
b <- getChar
if b /= '[' then return Nothing else do
c <- getChar
return $ if c `elem` "ABCD"
then Just [a, b, c]
else Nothing
getMove :: IO (Maybe D.Direction)
getMove = fmap (maybe Nothing direction) getChars
play :: R.RandomGen r => (B.Board, r) -> IO ()
play (b, r) = do
hSetBuffering stdin NoBuffering
hSetEcho stdin False
putStr (renderGame b)
if G.hasWon b then putStrLn "You won!" else do
if G.isOver b then putStrLn "You lost." else do
m <- getMove
case m of
Nothing -> putStrLn "Unknown move." >> play (b, r)
Just d -> if B.canMove b d
then putStrLn (D.render d) >> play (G.addRandomTile (B.move b d) r)
else putStrLn "Invalid move." >> play (b, r)