How to get input for a game loop in haskell - haskell

Question

http://pastebin.com/2CS1k1Zq
In this game i need to get step the game forward every half a second or so while occasionally getting input to change direction. These too things seem impossible to do with haskell is there a way to do it? Currently I am having an mv tread stall exception.

Answer 1

Update: Found the hWaitForInput function in System.IO which is essentially the same as waitFor.
Here is some code largely based on this answer.
The main difference I made is that the thread waiting for a key press does not perform the getChar directly. The result communicated in the MVar is an indication of timeout or that a key press has occurred. It is the responsibility of the main thread to actually get the character. This prevents a possible race condition in case the char reading thread is killed between getting the character and putting it into the MVar.
import Control.Concurrent
import Control.Monad
import Data.Maybe
import System.IO
import Control.Exception
data Event = CharReady | TimedOut
withRawStdin :: IO a -> IO a
withRawStdin = bracket uncook restore . const
where
uncook = do
oldBuffering <- hGetBuffering stdin
oldEcho <- hGetEcho stdin
hSetBuffering stdin NoBuffering
hSetEcho stdin False
return (oldBuffering, oldEcho)
restore (oldBuffering, oldEcho) = do
hSetBuffering stdin oldBuffering
hSetEcho stdin oldEcho
waitFor :: Int -> IO Event
waitFor delay = do
done <- newEmptyMVar
withRawStdin . bracket (start done) cleanUp $ \_ -> takeMVar done
where
start done = do
t1 <- forkIO $ hLookAhead stdin >> putMVar done CharReady
t2 <- forkIO $ threadDelay delay >> putMVar done TimedOut
return (t1, t2)
cleanUp (t1, t2) = do
killThread t1
killThread t2
loop state = do
if state <= 0
then putStrLn "Game over."
else do putStrLn $ "Rounds to go: " ++ show state
e <- waitFor 3000000
case e of
TimedOut -> do putStrLn "Too late!"; loop state
CharReady -> do c <- getChar -- should not block
if c == 'x'
then do putStrLn "Good job!"; loop (state-1)
else do putStrLn "Wrong key"; loop state
main = loop 3