Refactor, remove dependency of Loop on Preload

src/Loop.hs

@@ -1,6 +1,5 @@
 module Loop
     ( setupLoop
---    , withExits
     ) where
 import SDL
 import qualified Data.Text as T
@@ -11,8 +10,6 @@ import Control.Monad
 import System.Mem
 import Foreign.C
 
-import Preload
-
 import Control.Lens ((.~),(&),(+~))
 
 winConfig :: Int -> Int -> WindowConfig
@@ -26,101 +23,72 @@ winConfig x y = defaultWindow
     , windowResizable =True
     }
 
-setupLoop :: String
-        -> Int
-        -> Int
-        -> IO (PreloadData a)
-        -> (PreloadData a -> IO ())
-        -> IO world
-        -> (PreloadData a -> world -> IO (PreloadData a))
-        -> (world -> Event -> Maybe world)
-        -> (world -> Maybe world)
-        -> IO ()
-setupLoop wName xSize ySize 
-            customInit initCleanup ioStartWorld sideEffects eventFn worldFn = do 
-    startWorld <- ioStartWorld
-    initializeAll
-    bracket (createWindow (T.pack wName) (winConfig xSize ySize)) destroyWindow
-        (\window -> 
-            do bracket (glCreateContext window) (\con -> GL.finish >> glDeleteContext con)
-                 (\_ -> bracket customInit initCleanup $ \setup -> do --  setup <- customInit
---                            swapInterval $= ImmediateUpdates
-                            GL.blend $= GL.Enabled
---                            GL.depthMask $= GL.Enabled
-                            GL.blendEquation $= GL.FuncAdd
-                            GL.blendFunc $= (GL.SrcAlpha,GL.OneMinusSrcAlpha)
-                            GL.clearColor $= GL.Color4 0 0.5 0 1
-                            GL.clearDepth $= (200)
-                            swapInterval $= ImmediateUpdates
-                            GL.lineSmooth $= GL.Enabled
-                            doLoop setup window startWorld
-                                   sideEffects eventFn worldFn
-                 )
-        )
+setupLoop 
+    :: (Int,Int)
+    -> IO params
+    -> (params -> IO ())
+    -> IO world
+    -> (params -> world -> IO params)
+    -> (world -> Event -> Maybe world)
+    -> (world -> Maybe world)
+    -> IO ()
+setupLoop 
+    (xSize,ySize)
+    initParams 
+    paramCleanup 
+    ioStartWorld 
+    sideEffects 
+    eventFn 
+    worldFn = do 
+        startWorld <- ioStartWorld
+        initializeAll
+        bracket 
+            (createWindow (T.pack "A Minimal Game Loop") (winConfig xSize ySize)) 
+            destroyWindow 
+            $ \window -> bracket 
+                (glCreateContext window) 
+                (\con -> GL.finish >> glDeleteContext con)
+                $ \_ -> bracket 
+                    initParams 
+                    paramCleanup 
+                    $ \setup -> doLoop setup window startWorld sideEffects eventFn worldFn
 
-
---doLoop :: setupParams -> Window -> WorldView world0
---            -> (setupParams -> WorldView world0 -> IO ()) 
---            -> (world0 -> Event -> Maybe world0) 
---            -> (world0 -> Maybe world0) 
---            -> IO ()
-doLoop setup window startWorld
-        worldSideEffects 
-        eventFn 
-        worldUpdate 
+doLoop 
+    :: params 
+    -> Window 
+    -> world
+    -> (params -> world -> IO params) 
+    -> (world -> Event -> Maybe world) 
+    -> (world -> Maybe world) 
+    -> IO ()
+doLoop 
+    setup 
+    window 
+    startWorld
+    worldSideEffects 
+    eventFn 
+    worldUpdate 
   = do
-    errs <- GL.errors
-    if length errs > 0 then putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs)
-                       else return ()
     startLoopTicks <- ticks
-    GL.clear [GL.ColorBuffer,GL.DepthBuffer]
-    newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
+    newParams <- worldSideEffects setup startWorld
     glSwapWindow window
-    endSideTicks <- ticks
     events <- pollEvents
-    maybeUpdatedWorld <- applyEventsIO eventFn startWorld events
+    maybeUpdatedWorld <- foldM (applyEventIO eventFn) (Just startWorld) events
     case maybeUpdatedWorld >>= worldUpdate of
         Just updatedWorld -> do 
-            endSimTicks <- ticks
             performGC
             endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)
             let delay = max 0 (20 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
             threadDelay (delay * 1000 )
             endTime <- ticks
-            let newNewParams = newParams & idleTime +~ (endTime - endLoopTicks)
-                                         & gcTime +~ (endLoopTicks - endSimTicks)
-                                         & simTime +~ (endSimTicks - endSideTicks)
-            doLoop newNewParams window updatedWorld worldSideEffects eventFn worldUpdate
-        Nothing -> showTiming setup
-
-applyEvents :: (world0 -> Event -> Maybe world0)
-                -> world0 
-                -> [Event]
-                -> (world0 -> Maybe world0)
-                -> Maybe world0
-applyEvents eventFn startWorld events worldUpdate = 
-    case foldM (applyH eventFn) startWorld events of
-        Just w -> fmap (\w' -> w') $ worldUpdate w
-        Nothing -> Nothing
-    where
-        applyH :: (world0 -> Event -> Maybe world0) -> world0 -> Event -> Maybe world0
-        applyH f w e 
-            = case eventPayload e of
-                QuitEvent -> Nothing
-                WindowClosedEvent _ -> Nothing
-                _ -> f w e
+            doLoop newParams window updatedWorld worldSideEffects eventFn worldUpdate
+        Nothing -> return ()
 
 applyEventIO :: (world -> Event -> Maybe world) -> Maybe world -> Event -> IO (Maybe world)
 applyEventIO fn mw e = case eventPayload e of
-    QuitEvent -> return Nothing
+    QuitEvent           -> return Nothing
     WindowClosedEvent _ -> return Nothing
-    WindowSizeChangedEvent
-     (WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y})
-        -> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e)
-    _   -> return $ mw >>= flip fn e
+    WindowSizeChangedEvent (WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y})
+                        -> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e)
+    _                   -> return $ mw >>= flip fn e
 
-applyEventsIO :: (world0 -> Event -> Maybe world0)
-                -> world0 
-                -> [Event]
-                -> IO (Maybe world0)
-applyEventsIO fn w es = foldM (applyEventIO fn) (Just w) es

src/Picture/Preload.hs

@@ -92,6 +92,16 @@ preloadRender = do
         , _fboRenderbufferObject = fboRBO
         }
 
+-- potential drawing setup
+----                            swapInterval $= ImmediateUpdates
+--                            GL.blend $= GL.Enabled
+----                            GL.depthMask $= GL.Enabled
+--                            GL.blendEquation $= GL.FuncAdd
+--                            GL.blendFunc $= (GL.SrcAlpha,GL.OneMinusSrcAlpha)
+--                            GL.clearColor $= GL.Color4 0 0.5 0 1
+--                            GL.clearDepth $= (200)
+--                            swapInterval $= ImmediateUpdates
+--                            GL.lineSmooth $= GL.Enabled
 
 --------------------end preloadRender