Ticket #25: Add-IO-derivitives.patch

File Add-IO-derivitives.patch, 14.1 KB (added by Thomas DuBuisson, 11 years ago)

This is a patch that implements the proposal.

Line 
12 patches for repository http://code.ouroborus.net/gloss/gloss-stable:
2
3Wed Jan 18 19:54:33 PST 2012  Thomas.DuBuisson@gmail.com
4  * Add IO derivitives of simulate, play and animate.
5
6Wed Jan 18 20:29:10 PST 2012  Thomas.DuBuisson@gmail.com
7  * Further generalize the monadic varients
8 
9  The reasoning here is:
10  1) World-stepping should be permitted to be IO because there might be
11  outside influences on the world state (ex: a networked game).
12  2) Rendering the world should be permitted to be IO because there
13  might be outside information needed (texture loading, map tile retrieving, etc)
14
15New patches:
16
17[Add IO derivitives of simulate, play and animate.
18Thomas.DuBuisson@gmail.com**20120119035433
19 Ignore-this: 34cffe309cd1259296f20e5774af3154
20] hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 4
21 
22 module Graphics.Gloss.Internals.Interface.Animate
23        ( animate
24-       , animateWithBackend)
25+       , animateWithBackend
26+        , animateIO
27+        , animateWithBackendIO)
28 where 
29 import Graphics.Gloss.Data.Color
30 import Graphics.Gloss.Data.Picture
31hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 42
32 
33 animate = animateWithBackend defaultBackendState
34 
35+animateIO :: Display             -- ^ Display mode.
36+       -> Color                 -- ^ Background color.
37+       -> (Float -> IO Picture) -- ^ Action to produce the next frame of animation.
38+                                 --   It is passed the time in seconds since the program started.
39+       -> IO ()
40+animateIO = animateWithBackendIO defaultBackendState
41 
42 animateWithBackend
43        :: Backend a
44hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 59
45        -> IO ()
46 
47 animateWithBackend backend display backColor frameFun
48+ = animateWithBackendIO backend display backColor (return . frameFun)
49+
50+animateWithBackendIO
51+       :: Backend a
52+       => a                     -- ^ Initial State of the backend
53+        -> Display               -- ^ Display mode.
54+       -> Color                 -- ^ Background color.
55+       -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation.
56+                                 --     It is passed the time in seconds since the program started.
57+       -> IO ()
58+
59+animateWithBackendIO backend display backColor frameOp
60  = do 
61        viewSR          <- newIORef viewPortInit
62        viewControlSR   <- newIORef VPC.stateInit
63hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 80
64 
65        let displayFun backendRef = do
66                -- extract the current time from the state
67-               timeS           <- animateSR `getsIORef` AN.stateAnimateTime
68+               timeS           <- animateSR `getsIORef` AN.stateAnimateTime
69 
70hunk ./gloss/Graphics/Gloss/Internals/Interface/Animate.hs 82
71-               -- call the user function to get the animation frame
72-               let picture     = frameFun (double2Float timeS)
73+               -- call the user action to get the animation frame
74+               picture         <- frameOp (double2Float timeS)
75 
76                renderS         <- readIORef renderSR
77                viewS           <- readIORef viewSR
78hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 46
79 
80 play    = playWithBackend defaultBackendState
81 
82+-- | Play a game in a window, using IO actions to build the pictures.
83+playIO  :: forall world
84+        .  Display                      -- ^ Display mode.
85+        -> Color                        -- ^ Background color.
86+       -> Int                          -- ^ Number of simulation steps to take for each second of real time.
87+       -> world                        -- ^ The initial world.
88+       -> (world -> IO Picture)        -- ^ An action to convert the world a picture.
89+       -> (Event -> world -> world)    -- ^ A function to handle input events.
90+       -> (Float -> world -> world)    -- ^ A function to step the world one iteration.
91+                                       --   It is passed the period of time (in seconds) needing to be advanced.
92+       -> IO ()
93+playIO = playWithBackendIO defaultBackendState
94+
95 playWithBackend
96        :: forall world a
97        .  Backend a
98hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 67
99        -> Color                        -- ^ Background color.
100        -> Int                          -- ^ Number of simulation steps to take for each second of real time.
101        -> world                        -- ^ The initial world.
102-       -> (world -> Picture)           -- ^ A function to convert the world a picture.
103+       -> (world -> Picture)           -- ^ A function to convert the world to a picture.
104        -> (Event -> world -> world)    -- ^ A function to handle input events.
105        -> (Float -> world -> world)    -- ^ A function to step the world one iteration.
106                                        --   It is passed the period of time (in seconds) needing to be advanced.
107hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 82
108        worldToPicture
109        worldHandleEvent
110        worldAdvance
111+ = playWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldHandleEvent worldAdvance
112+
113+playWithBackendIO
114+       :: forall world a
115+       .  Backend a
116+       => a                            -- ^ Initial state of the backend
117+        -> Display                      -- ^ Display mode.
118+       -> Color                        -- ^ Background color.
119+       -> Int                          -- ^ Number of simulation steps to take for each second of real time.
120+       -> world                        -- ^ The initial world.
121+       -> (world -> IO Picture)        -- ^ A function to convert the world to a picture.
122+       -> (Event -> world -> world)    -- ^ A function to handle input events.
123+       -> (Float -> world -> world)    -- ^ A function to step the world one iteration.
124+                                       --   It is passed the period of time (in seconds) needing to be advanced.
125+       -> IO ()
126+
127+playWithBackendIO
128+       backend
129+        display
130+       backgroundColor
131+       simResolution
132+       worldStart
133+       worldToPicture
134+       worldHandleEvent
135+       worldAdvance
136  = do
137        let singleStepTime      = 1
138 
139hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 126
140             = do
141                -- convert the world to a picture
142                world           <- readIORef worldSR
143-               let picture     = worldToPicture world
144+               picture         <- worldToPicture world
145       
146                -- display the picture in the current view
147                renderS         <- readIORef renderSR
148hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 5
149 
150 module Graphics.Gloss.Internals.Interface.Simulate
151        ( simulate
152-       , simulateWithBackend)
153+       , simulateWithBackend
154+        , simulateIO
155+        , simulateWithBackendIO)
156 where
157 import Graphics.Gloss.Data.Display
158 import Graphics.Gloss.Data.Color
159hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 50
160 
161 simulate = simulateWithBackend defaultBackendState
162 
163+simulateIO :: forall model
164+        .  Display                      -- ^ Display mode.
165+       -> Color                        -- ^ Background color.
166+       -> Int                          -- ^ Number of simulation steps to take for each second of real time.
167+       -> model                        -- ^ The initial model.
168+       -> (model -> IO Picture)        -- ^ A function to convert the model to a picture.
169+       -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the
170+                                                --     current viewport and the amount of time for this simulation
171+                                                --     step (in seconds).
172+       -> IO ()
173+simulateIO = simulateWithBackendIO defaultBackendState
174+
175 simulateWithBackend
176        :: forall model a
177        .  Backend a
178hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 75
179                                                 --     current viewport and the amount of time for this simulation
180                                                 --     step (in seconds).
181        -> IO ()
182-
183 simulateWithBackend
184        backend
185         display
186hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 83
187        worldStart
188        worldToPicture
189        worldAdvance
190+ = simulateWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldAdvance
191+
192+simulateWithBackendIO
193+       :: forall model a
194+       .  Backend a
195+       => a                            -- ^ Initial state of the backend
196+        -> Display                      -- ^ Display mode.
197+       -> Color                        -- ^ Background color.
198+       -> Int                          -- ^ Number of simulation steps to take for each second of real time.
199+       -> model                        -- ^ The initial model.
200+       -> (model -> IO Picture)                -- ^ A function to convert the model to a picture.
201+       -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the
202+                                                --     current viewport and the amount of time for this simulation
203+                                                --     step (in seconds).
204+       -> IO ()
205+
206+simulateWithBackendIO
207+       backend
208+        display
209+       backgroundColor
210+       simResolution
211+       worldStart
212+       worldToPicture
213+       worldAdvance
214  = do
215        let singleStepTime      = 1
216 
217hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 127
218             = do
219                -- convert the world to a picture
220                world           <- readIORef worldSR
221-               let picture     = worldToPicture world
222+               picture         <- worldToPicture world
223       
224                -- display the picture in the current view
225                renderS         <- readIORef renderSR
226[Further generalize the monadic varients
227Thomas.DuBuisson@gmail.com**20120119042910
228 Ignore-this: f9548fd6776df7e679dc338feb99e3b2
229 
230 The reasoning here is:
231 1) World-stepping should be permitted to be IO because there might be
232 outside influences on the world state (ex: a networked game).
233 2) Rendering the world should be permitted to be IO because there
234 might be outside information needed (texture loading, map tile retrieving, etc)
235] hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 54
236        -> world                        -- ^ The initial world.
237        -> (world -> IO Picture)        -- ^ An action to convert the world a picture.
238        -> (Event -> world -> world)    -- ^ A function to handle input events.
239-       -> (Float -> world -> world)    -- ^ A function to step the world one iteration.
240+       -> (Float -> world -> IO world) -- ^ A function to step the world one iteration.
241                                        --   It is passed the period of time (in seconds) needing to be advanced.
242        -> IO ()
243 playIO = playWithBackendIO defaultBackendState
244hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 82
245        worldToPicture
246        worldHandleEvent
247        worldAdvance
248- = playWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldHandleEvent worldAdvance
249+ = playWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldHandleEvent (\f w -> return (worldAdvance f w))
250 
251 playWithBackendIO
252        :: forall world a
253hunk ./gloss/Graphics/Gloss/Internals/Interface/Game.hs 94
254        -> world                        -- ^ The initial world.
255        -> (world -> IO Picture)        -- ^ A function to convert the world to a picture.
256        -> (Event -> world -> world)    -- ^ A function to handle input events.
257-       -> (Float -> world -> world)    -- ^ A function to step the world one iteration.
258+       -> (Float -> world -> IO world) -- ^ A function to step the world one iteration.
259                                        --   It is passed the period of time (in seconds) needing to be advanced.
260        -> IO ()
261 
262hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 56
263        -> Int                          -- ^ Number of simulation steps to take for each second of real time.
264        -> model                        -- ^ The initial model.
265        -> (model -> IO Picture)        -- ^ A function to convert the model to a picture.
266-       -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the
267+       -> (ViewPort -> Float -> model -> IO model) -- ^ A function to step the model one iteration. It is passed the
268                                                 --     current viewport and the amount of time for this simulation
269                                                 --     step (in seconds).
270        -> IO ()
271hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 83
272        worldStart
273        worldToPicture
274        worldAdvance
275- = simulateWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) worldAdvance
276+ = simulateWithBackendIO backend display backgroundColor simResolution worldStart (return . worldToPicture) (\v f m -> return $ worldAdvance v f m)
277 
278 simulateWithBackendIO
279        :: forall model a
280hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate.hs 94
281        -> Int                          -- ^ Number of simulation steps to take for each second of real time.
282        -> model                        -- ^ The initial model.
283        -> (model -> IO Picture)                -- ^ A function to convert the model to a picture.
284-       -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the
285+       -> (ViewPort -> Float -> model -> IO model) -- ^ A function to step the model one iteration. It is passed the
286                                                 --     current viewport and the amount of time for this simulation
287                                                 --     step (in seconds).
288        -> IO ()
289hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 24
290        -> IORef ViewPort                               -- ^ the viewport state
291        -> IORef world                                  -- ^ the current world
292        -> world                                        -- ^ the initial world
293-       -> (ViewPort -> Float -> world -> world)        -- ^ fn to advance the world
294+       -> (ViewPort -> Float -> world -> IO world)     -- ^ fn to advance the world
295        -> Float                                        -- ^ how much time to advance world by
296                                                        --      in single step mode
297        -> IdleCallback
298hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 67
299        -> IORef AN.State
300        -> IORef ViewPort
301        -> IORef world
302-       -> (ViewPort -> Float -> world -> world)
303+       -> (ViewPort -> Float -> world -> IO world)
304        -> IdleCallback
305       
306 simulate_run simSR _ viewSR worldSR worldAdvance backendRef
307hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 106
308        let nFinal      = nStart + thisSteps
309 
310        -- keep advancing the world until we get to the final iteration number
311-       let (_, world') =
312-               until   (\(n, _)        -> n >= nFinal)
313-                       (\(n, w)        -> (n+1, worldAdvance viewS timePerStep w))
314-                       (nStart, worldS)
315-       
316+       (_,world') <- untilM    (\(n, _)        -> n >= nFinal)
317+                               (\(n, w)        -> liftM (\w' -> (n+1,w')) ( worldAdvance viewS timePerStep w))
318+                               (nStart, worldS)
319+
320        -- write the world back into its IORef
321        -- We need to seq on the world to avoid space leaks when the window is not showing.
322        world' `seq` writeIORef worldSR world'
323hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 129
324        :: IORef SM.State
325        -> IORef ViewPort
326        -> IORef world
327-       -> (ViewPort -> Float -> world -> world)
328+       -> (ViewPort -> Float -> world -> IO world)
329        -> Float
330        -> IdleCallback
331 
332hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 137
333  = do
334        viewS           <- readIORef viewSR
335        world           <- readIORef worldSR
336-       let world'      = worldAdvance viewS singleStepTime world
337+       world'          <- worldAdvance viewS singleStepTime world
338       
339        writeIORef worldSR world'
340        simSR `modifyIORef` \c -> c     
341hunk ./gloss/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs 150
342 getsIORef :: IORef a -> (a -> r) -> IO r
343 getsIORef ref fun
344  = liftM fun $ readIORef ref
345+
346+untilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a
347+untilM test op i = go i
348+  where
349+  go x | test x    = return x
350+       | otherwise = op x >>= go
351+       
352
353Context:
354
355[TAG Release 1.6.0.1
356Ben Lippmeier <benl@ouroborus.net>**20111228020857
357 Ignore-this: 8b11cdc5e55cbaf6ecd6dddc346eed61
358]
359Patch bundle hash:
360c2deec15b473c29829673326fb4c3fb0319144b6