diff --git a/app/Main.hs b/app/Main.hs index 1d75de0b9..6a07bfaf3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -38,13 +38,17 @@ main :: IO () main = do (sizex,sizey) <- loadConfig setupLoop - "windowName" - sizex sizey + (sizex,sizey) (doPreload >>= resizeSpareFBO sizex sizey) cleanUpPreload (fmap (setWindowSize sizex sizey) firstWorld) ( \preData w -> do startTicks <- SDL.ticks + errs <- errors + if length errs > 0 + then putStrLn $ "GLerror during doLoop: " ++ (unwords $ map show errs) + else return () + clear [ColorBuffer,DepthBuffer] (lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w) diff --git a/src/Loop.hs b/src/Loop.hs index 93b709bfe..b8b10ebfb 100644 --- a/src/Loop.hs +++ b/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 diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 8d30080d7..c3b27ee79 100644 --- a/src/Picture/Preload.hs +++ b/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