{-| A simple program that implements interaction with the game. -} 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 -- a simple command line interface implemented by simply outputing strings -- | simple help string helpString :: String helpString = "'i'/'k'/'j'/'l' to move, 'q' to quit." -- | pretty print the board to stdout drawBoard :: Gameplay -> IO () drawBoard gp = {- a cell will be represented in the output as following: +-----+ | xxx | +-----+ the pretty-printing strategy is to print the first line and for each row in the board: * print the leftmost "| " * let each cell in the row print " |" * finalize this line by printing out the horizontal "+--+--+..." -} putStrLn horizSeparator >> mapM_ drawRow [0 .. rowCount - 1] where bd = _gpBoard gp (rowCount, colCount) = _grDim . _gpRule $ gp cellWidth = length " 2048 " -- build up the separator: "+--+--+....+" horizSeparator' = intercalate "+" (replicate 4 (replicate cellWidth '-')) horizSeparator = "+" ++ horizSeparator' ++ "+" -- pretty string for a cell (without border) 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 -- prints "| | | ... |" putChar '|' mapM_ (prettyCell rowInd >>> putStr >>> (>> putChar '|')) [0 .. colCount - 1] putChar '\n' putStrLn horizSeparator -- | play game on a given board until user quits or game ends 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 -- handle user move, print the board together with current score, -- return the next user move: -- + return Nothing only if user has pressed "q" -- + return Just if one of "ijkl" is pressed 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 _ -> -- user will not be on this branch -- if an invalid key is pressed 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' -- | The entry of simple CLI. main :: IO () main = do -- turn off buffering to not wait on a newline character. hSetBuffering stdin NoBuffering -- show some helpful messages -- whether the user has read the README or not :) putStrLn helpString -- initialize game based on the random seed void playGame