Ticket #25: Add-IO-derivitives.patch

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 <benl@ouroborus.net>**20111228020857
 Ignore-this: 8b11cdc5e55cbaf6ecd6dddc346eed61
] 
Patch bundle hash:
c2deec15b473c29829673326fb4c3fb0319144b6