You could use something like brick as a framework and use it to build your game. That’s probably what I’d recommend.
But another approach worth talking about is reading the user input from a different thread and pass it through using stm and TQueue.
Here’s a working example:
#!/usr/bin/env stack
-- stack --resolver lts-13.29 script
module Main where
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (atomically, TQueue, newTQueueIO, writeTQueue, tryReadTQueue)
import Control.Monad (forever)
import System.IO (hSetBuffering, hSetEcho, stdin, BufferMode(NoBuffering), getChar, hReady)
import System.Process (system)
main :: IO ()
main = do
keysVar <- newTQueueIO -- create a new TQueue that will be passed to both threads
hSetBuffering stdin NoBuffering -- disable input buffering
hSetEcho stdin False
system "tput smcup" -- OS command to open an alternate screen
forkIO $ getKeys keysVar
loop keysVar 0
system "tput rmcup" -- OS command to close the alternate screen
pure ()
type WorldState = Int
data Input
= LeftArrow
| RightArrow
| Quit
-- This runs in a separate thread and will push keys to the input queue
getKeys :: TQueue Input -> IO ()
getKeys keysVar = forever $ do
keys <- getKey
case keys of
"\ESC[C" -> atomically $ writeTQueue keysVar RightArrow
"\ESC[D" -> atomically $ writeTQueue keysVar LeftArrow
"q" -> atomically $ writeTQueue keysVar Quit
_ -> pure ()
-- Taken from https://stackoverflow.com/questions/23068218/haskell-read-raw-keyboard-input/38553473#38553473
getKey :: IO [Char]
getKey = reverse <$> getKey' ""
where
getKey' chars = do
char <- getChar
more <- hReady stdin
(if more then getKey' else return) (char:chars)
loop :: TQueue Input -> WorldState -> IO ()
loop keysVar state = do
maybeKey <- atomically $ tryReadTQueue keysVar
let maybeState' = step maybeKey state
case maybeState' of
Nothing -> pure ()
Just state' -> do
system "clear"
print state'
threadDelay (25 * 1000)
loop keysVar state'
step :: Maybe Input -> WorldState -> Maybe WorldState
step input state = case input of
Nothing -> pure $ state + 1
Just LeftArrow -> pure $ state `div` 2
Just RightArrow -> pure $ state * 2
Just Quit -> Nothing
you can chmod +x example.hs and then ./example.hs if you have stack installed. Note that it will download ghc and the relevant packages in the lts-13.29 resolver if they’re not already installed.