Buffer events with playMSF

This commit is contained in:
Kiana Sheibani 2023-01-25 12:55:15 -05:00
parent e788ddee39
commit 90afdcd7bb
Signed by: toki
GPG key ID: 6CB106C25E86A9F7

View file

@ -10,10 +10,10 @@ import Graphics.Gloss.Interface.IO.Game
-- | Display an MSF outputting a picture value as a window using Gloss.
-- Note that the MSF is not passed a real-time clock.
playMSF :: Display -> Color -> Int -> MSF IO (Maybe Event) Picture -> IO ()
playMSF :: Display -> Color -> Int -> MSF IO [Event] Picture -> IO ()
playMSF display color freq msf = do
-- `react` doesn't allow inputs or outputs, so we have to use IORefs
evRef <- newIORef Nothing
evRef <- newIORef []
picRef <- newIORef blank
handle <- reactInit (constM (readIORef evRef) >>> msf >>> arrM (writeIORef picRef))
@ -23,21 +23,21 @@ playMSF display color freq msf = do
-- A function to handle input events.
handleInput e _ = do
writeIORef evRef (Just e)
modifyIORef evRef (e :)
-- A function to step the world one iteration.
stepWorld _ _ = do
react handle
writeIORef evRef Nothing
writeIORef evRef []
playIO display color freq () toPic handleInput stepWorld
-- * DrawerT
type DrawerT m = WriterT Picture (Control.Monad.Trans.MSF.Reader.ReaderT (Maybe Event) m)
type DrawerT m = WriterT Picture (ReaderT [Event] m)
runDrawerS :: Monad m => MSF (DrawerT m) () () -> MSF m (Maybe Event) Picture
runDrawerS msf = arr (,()) >>> Control.Monad.Trans.MSF.Reader.runReaderS (runWriterS msf) >>> arr fst
runDrawerS :: Monad m => MSF (DrawerT m) () () -> MSF m [Event] Picture
runDrawerS msf = arr (,()) >>> runReaderS (runWriterS msf) >>> arr fst
draw :: Monad m => MSF (DrawerT m) Picture ()
draw = arrM tell