module Game.H2048.UI.Simple
( main
) where
import Control.Arrow
import Data.Function
import Data.Functor
import Data.List
import System.IO
import System.Random.TF
import Text.Printf
import qualified Data.Map.Strict as M
import Game.H2048.Gameplay
helpString :: String
helpString = "'i'/'k'/'j'/'l' to move, 'q' to quit."
drawBoard :: Gameplay -> IO ()
drawBoard gp =
putStrLn horizSeparator >>
mapM_ drawRow [0 .. rowCount - 1]
where
bd = _gpBoard gp
(rowCount, colCount) = _grDim . _gpRule $ gp
cellWidth = length " 2048 "
horizSeparator' = intercalate "+" (replicate 4 (replicate cellWidth '-'))
horizSeparator = "+" ++ horizSeparator' ++ "+"
prettyCell :: Int -> Int -> String
prettyCell r c = case bd M.!? (r,c) of
Nothing -> replicate cellWidth ' '
Just cell -> printf " %4d " (cellToInt cell)
drawRow :: Int -> IO ()
drawRow rowInd = do
putChar '|'
mapM_ (prettyCell rowInd >>> putStr >>> (>> putChar '|')) [0 .. colCount - 1]
putChar '\n'
putStrLn horizSeparator
playGame :: IO Gameplay
playGame = do
g <- newTFGen
let initState = mkGameplay g standardGameRule
gameLoop (newGame initState)
where
gameLoop gp = do
drawBoard gp
if isAlive gp
then processUserMove gp
else endGame gp
endGame gp = do
putStrLn $ if hasWon gp then "You won" else "Game over"
_ <- printf "Final score: %d\n" (_gpScore gp)
gp <$ hFlush stdout
processUserMove :: Gameplay -> IO Gameplay
processUserMove gp = fix $ \redo -> do
let scoreFormat =
if hasWon gp
then "You win, current score: %d\n"
else "Current score: %d\n"
printf scoreFormat (_gpScore gp)
hFlush stdout
c <- getChar
putStrLn ""
hFlush stdout
case c of
'q' -> pure gp
'i' -> putStrLn "Up" >> handleMove gp DUp
'k' -> putStrLn "Down" >> handleMove gp DDown
'j' -> putStrLn "Left" >> handleMove gp DLeft
'l' -> putStrLn "Right" >> handleMove gp DRight
_ ->
putStrLn helpString >> redo
handleMove :: Gameplay -> Dir -> IO Gameplay
handleMove gp dir = case stepGame dir gp of
Nothing -> putStrLn "Invalid move" >> gameLoop gp
Just gp' -> gameLoop gp'
main :: IO ()
main = do
hSetBuffering stdin NoBuffering
putStrLn helpString
void playGame