2 patches for repository http://code.ouroborus.net/gloss/gloss-stable: Wed Jan 18 19:54:33 PST 2012 Thomas.DuBuisson@gmail.com * Add IO derivitives of simulate, play and animate. Wed Jan 18 20:29:10 PST 2012 Thomas.DuBuisson@gmail.com * Further generalize the monadic varients The reasoning here is: 1) World-stepping should be permitted to be IO because there might be outside influences on the world state (ex: a networked game). 2) Rendering the world should be permitted to be IO because there might be outside information needed (texture loading, map tile retrieving, etc) New patches: [Add IO derivitives of simulate, play and animate. Thomas.DuBuisson@gmail.com**20120119035433 Ignore-this: 34cffe309cd1259296f20e5774af3154 ] hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 4 module Graphics.Gloss.Internals.Interface.Animate ( animate - , animateWithBackend) + , animateWithBackend + , animateIO + , animateWithBackendIO) where import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 42 animate = animateWithBackend defaultBackendState +animateIO :: Display -- ^ Display mode. + -> Color -- ^ Background color. + -> (Float -> IO Picture) -- ^ Action to produce the next frame of animation. + -- It is passed the time in seconds since the program started. + -> IO () +animateIO = animateWithBackendIO defaultBackendState animateWithBackend :: Backend a hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 59 -> IO () animateWithBackend backend display backColor frameFun + = animateWithBackendIO backend display backColor (return . frameFun) + +animateWithBackendIO + :: Backend a + => a -- ^ Initial State of the backend + -> Display -- ^ Display mode. + -> Color -- ^ Background color. + -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation. + -- It is passed the time in seconds since the program started. + -> IO () + +animateWithBackendIO backend display backColor frameOp = do viewSR <- newIORef viewPortInit viewControlSR <- newIORef VPC.stateInit hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 80 let displayFun backendRef = do -- extract the current time from the state - timeS <- animateSR `getsIORef` AN.stateAnimateTime + timeS <- animateSR `getsIORef` AN.stateAnimateTime hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 82 - -- call the user function to get the animation frame - let picture = frameFun (double2Float timeS) + -- call the user action to get the animation frame + picture <- frameOp (double2Float timeS) renderS <- readIORef renderSR viewS <- readIORef viewSR hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 46 play = playWithBackend defaultBackendState +-- | Play a game in a window, using IO actions to build the pictures. +playIO :: forall world + . Display -- ^ Display mode. + -> Color -- ^ Background color. + -> Int -- ^ Number of simulation steps to take for each second of real time. + -> world -- ^ The initial world. + -> (world -> IO Picture) -- ^ An action to convert the world a picture. + -> (Event -> world -> world) -- ^ A function to handle input events. + -> (Float -> world -> world) -- ^ A function to step the world one iteration. + -- It is passed the period of time (in seconds) needing to be advanced. + -> IO () +playIO = playWithBackendIO defaultBackendState + playWithBackend :: forall world a . Backend a hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 67 -> Color -- ^ Background color. -> Int -- ^ Number of simulation steps to take for each second of real time. -> world -- ^ The initial world. - -> (world -> Picture) -- ^ A function to convert the world a picture. + -> (world -> Picture) -- ^ A function to convert the world to a picture. -> (Event -> world -> world) -- ^ A function to handle input events. -> (Float -> world -> world) -- ^ A function to step the world one iteration. -- It is passed the period of time (in seconds) needing to be advanced. hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 82 worldToPicture worldHandleEvent worldAdvance + = playWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldHandleEvent worldAdvance + +playWithBackendIO + :: forall world a + . Backend a + => a -- ^ Initial state of the backend + -> Display -- ^ Display mode. + -> Color -- ^ Background color. + -> Int -- ^ Number of simulation steps to take for each second of real time. + -> world -- ^ The initial world. + -> (world -> IO Picture) -- ^ A function to convert the world to a picture. + -> (Event -> world -> world) -- ^ A function to handle input events. + -> (Float -> world -> world) -- ^ A function to step the world one iteration. + -- It is passed the period of time (in seconds) needing to be advanced. + -> IO () + +playWithBackendIO + backend + display + backgroundColor + simResolution + worldStart + worldToPicture + worldHandleEvent + worldAdvance = do let singleStepTime = 1 hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 126 = do -- convert the world to a picture world <- readIORef worldSR - let picture = worldToPicture world + picture <- worldToPicture world -- display the picture in the current view renderS <- readIORef renderSR hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 5 module Graphics.Gloss.Internals.Interface.Simulate ( simulate - , simulateWithBackend) + , simulateWithBackend + , simulateIO + , simulateWithBackendIO) where import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Color hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 50 simulate = simulateWithBackend defaultBackendState +simulateIO :: forall model + . Display -- ^ Display mode. + -> Color -- ^ Background color. + -> Int -- ^ Number of simulation steps to take for each second of real time. + -> model -- ^ The initial model. + -> (model -> IO Picture) -- ^ A function to convert the model to a picture. + -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the + -- current viewport and the amount of time for this simulation + -- step (in seconds). + -> IO () +simulateIO = simulateWithBackendIO defaultBackendState + simulateWithBackend :: forall model a . Backend a hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 75 -- current viewport and the amount of time for this simulation -- step (in seconds). -> IO () - simulateWithBackend backend display hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 83 worldStart worldToPicture worldAdvance + = simulateWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldAdvance + +simulateWithBackendIO + :: forall model a + . Backend a + => a -- ^ Initial state of the backend + -> Display -- ^ Display mode. + -> Color -- ^ Background color. + -> Int -- ^ Number of simulation steps to take for each second of real time. + -> model -- ^ The initial model. + -> (model -> IO Picture) -- ^ A function to convert the model to a picture. + -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the + -- current viewport and the amount of time for this simulation + -- step (in seconds). + -> IO () + +simulateWithBackendIO + backend + display + backgroundColor + simResolution + worldStart + worldToPicture + worldAdvance = do let singleStepTime = 1 hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 127 = do -- convert the world to a picture world <- readIORef worldSR - let picture = worldToPicture world + picture <- worldToPicture world -- display the picture in the current view renderS <- readIORef renderSR [Further generalize the monadic varients Thomas.DuBuisson@gmail.com**20120119042910 Ignore-this: f9548fd6776df7e679dc338feb99e3b2 The reasoning here is: 1) World-stepping should be permitted to be IO because there might be outside influences on the world state (ex: a networked game). 2) Rendering the world should be permitted to be IO because there might be outside information needed (texture loading, map tile retrieving, etc) ] hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 54 -> world -- ^ The initial world. -> (world -> IO Picture) -- ^ An action to convert the world a picture. -> (Event -> world -> world) -- ^ A function to handle input events. - -> (Float -> world -> world) -- ^ A function to step the world one iteration. + -> (Float -> world -> IO world) -- ^ A function to step the world one iteration. -- It is passed the period of time (in seconds) needing to be advanced. -> IO () playIO = playWithBackendIO defaultBackendState hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 82 worldToPicture worldHandleEvent worldAdvance - = playWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldHandleEvent worldAdvance + = playWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldHandleEvent (\f w -> return (worldAdvance f w)) playWithBackendIO :: forall world a hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 94 -> world -- ^ The initial world. -> (world -> IO Picture) -- ^ A function to convert the world to a picture. -> (Event -> world -> world) -- ^ A function to handle input events. - -> (Float -> world -> world) -- ^ A function to step the world one iteration. + -> (Float -> world -> IO world) -- ^ A function to step the world one iteration. -- It is passed the period of time (in seconds) needing to be advanced. -> IO () hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 56 -> Int -- ^ Number of simulation steps to take for each second of real time. -> model -- ^ The initial model. -> (model -> IO Picture) -- ^ A function to convert the model to a picture. - -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the + -> (ViewPort -> Float -> model -> IO model) -- ^ A function to step the model one iteration. It is passed the -- current viewport and the amount of time for this simulation -- step (in seconds). -> IO () hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 83 worldStart worldToPicture worldAdvance - = simulateWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldAdvance + = simulateWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) (\v f m -> return $ worldAdvance v f m) simulateWithBackendIO :: forall model a hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 94 -> Int -- ^ Number of simulation steps to take for each second of real time. -> model -- ^ The initial model. -> (model -> IO Picture) -- ^ A function to convert the model to a picture. - -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the + -> (ViewPort -> Float -> model -> IO model) -- ^ A function to step the model one iteration. It is passed the -- current viewport and the amount of time for this simulation -- step (in seconds). -> IO () hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 24 -> IORef ViewPort -- ^ the viewport state -> IORef world -- ^ the current world -> world -- ^ the initial world - -> (ViewPort -> Float -> world -> world) -- ^ fn to advance the world + -> (ViewPort -> Float -> world -> IO world) -- ^ fn to advance the world -> Float -- ^ how much time to advance world by -- in single step mode -> IdleCallback hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 67 -> IORef AN.State -> IORef ViewPort -> IORef world - -> (ViewPort -> Float -> world -> world) + -> (ViewPort -> Float -> world -> IO world) -> IdleCallback simulate_run simSR _ viewSR worldSR worldAdvance backendRef hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 106 let nFinal = nStart + thisSteps -- keep advancing the world until we get to the final iteration number - let (_, world') = - until (\(n, _) -> n >= nFinal) - (\(n, w) -> (n+1, worldAdvance viewS timePerStep w)) - (nStart, worldS) - + (_,world') <- untilM (\(n, _) -> n >= nFinal) + (\(n, w) -> liftM (\w' -> (n+1,w')) ( worldAdvance viewS timePerStep w)) + (nStart, worldS) + -- write the world back into its IORef -- We need to seq on the world to avoid space leaks when the window is not showing. world' `seq` writeIORef worldSR world' hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 129 :: IORef SM.State -> IORef ViewPort -> IORef world - -> (ViewPort -> Float -> world -> world) + -> (ViewPort -> Float -> world -> IO world) -> Float -> IdleCallback hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 137 = do viewS <- readIORef viewSR world <- readIORef worldSR - let world' = worldAdvance viewS singleStepTime world + world' <- worldAdvance viewS singleStepTime world writeIORef worldSR world' simSR `modifyIORef` \c -> c hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 150 getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun = liftM fun $ readIORef ref + +untilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a +untilM test op i = go i + where + go x | test x = return x + | otherwise = op x >>= go + Context: [TAG Release 1.6.0.1 Ben Lippmeier **20111228020857 Ignore-this: 8b11cdc5e55cbaf6ecd6dddc346eed61 ] Patch bundle hash: c2deec15b473c29829673326fb4c3fb0319144b6