From 46de809202e13cf69a2624d9a1b4124aa1f74c57 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 9 Sep 2017 16:47:24 +0200 Subject: [PATCH] switching to 3D --- affection.cabal | 1 + src/Affection.hs | 90 +++++++++++++++++++++++------------------- src/Affection/Types.hs | 1 + 3 files changed, 51 insertions(+), 41 deletions(-) diff --git a/affection.cabal b/affection.cabal index 7d65f3b..2ef28de 100644 --- a/affection.cabal +++ b/affection.cabal @@ -72,6 +72,7 @@ library , clock , glib , bytestring + , OpenGL -- , sdl2-image -- executable example00 diff --git a/src/Affection.hs b/src/Affection.hs index e3f9d4a..1f96651 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -2,6 +2,7 @@ {-# LANGUAGE BangPatterns #-} module Affection ( withAffection + , get , getAffection , putAffection -- , withWindow @@ -13,7 +14,7 @@ module Affection import qualified SDL import qualified SDL.Internal.Numbered as SDL (toNumber) import qualified SDL.Raw as Raw -import qualified GEGL as G +-- import qualified GEGL as G import Data.Maybe import Data.IORef @@ -39,6 +40,8 @@ import Affection.Actor as A import Affection.Animation as A import Affection.Util as A +import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..)) + import qualified BABL as B -- | Main function which bootstraps everything else. @@ -52,7 +55,7 @@ withAffection AffectionConfig{..} = do SDL.initializeAll Only is -> SDL.initialize is - G.gegl_init + -- G.gegl_init -- give SDL render quality SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear -- just checking… @@ -63,35 +66,36 @@ withAffection AffectionConfig{..} = do -- construct window window <- SDL.createWindow windowTitle windowConfig SDL.showWindow window - -- create renderer - renderer <- SDL.createRenderer - window - (-1) - SDL.defaultRenderer - -- make draw texture - texture <- SDL.createTexture - renderer - SDL.ABGR8888 - SDL.TextureAccessStreaming - (case canvasSize of - Just (cw, ch) -> (SDL.V2 - (CInt $ fromIntegral cw) - (CInt $ fromIntegral ch) - ) - Nothing -> - SDL.windowInitialSize windowConfig - ) - -- make draw surface - -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr + context <- SDL.glCreateContext(window) + -- -- create renderer + -- renderer <- SDL.createRenderer + -- window + -- (-1) + -- SDL.defaultRenderer + -- -- make draw texture + -- texture <- SDL.createTexture + -- renderer + -- SDL.ABGR8888 + -- SDL.TextureAccessStreaming + -- (case canvasSize of + -- Just (cw, ch) -> (SDL.V2 + -- (CInt $ fromIntegral cw) + -- (CInt $ fromIntegral ch) + -- ) + -- Nothing -> + -- SDL.windowInitialSize windowConfig + -- ) + -- -- make draw surface + -- -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr let SDL.V2 (CInt rw) (CInt rh) = windowInitialSize windowConfig (w, h) = case canvasSize of Just (cw, ch) -> (cw, ch) Nothing -> (fromIntegral rw, fromIntegral rh) - -- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w - bablFormat = B.PixelFormat B.RGBA B.CFu8 - cpp = B.babl_components_per_pixel bablFormat - !stride = cpp * w - format <- B.babl_format bablFormat + -- -- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w + -- bablFormat = B.PixelFormat B.RGBA B.CFu8 + -- cpp = B.babl_components_per_pixel bablFormat + -- !stride = cpp * w + -- format <- B.babl_format bablFormat -- get current time SDL.setWindowMode window initScreenMode execTime <- getTime Monotonic @@ -99,15 +103,16 @@ withAffection AffectionConfig{..} = do { quitEvent = False , userState = x , drawWindow = window - , windowRenderer = renderer - , drawTexture = texture - , drawFormat = format + , glContext = context + -- , windowRenderer = renderer + -- , drawTexture = texture + -- , drawFormat = format , drawDimensions = case canvasSize of Just (cw, ch) -> (cw, ch) Nothing -> (w, h) , screenMode = initScreenMode - , drawStride = stride - , drawCPP = cpp + -- , drawStride = stride + -- , drawCPP = cpp , drawStack = [] , elapsedTime = 0 , deltaTime = 0 @@ -126,8 +131,8 @@ withAffection AffectionConfig{..} = do -- Measure time difference form last run now <- liftIO $ getTime Monotonic let lastTime = sysTime ad - -- clean draw requests from last run - MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) + -- -- clean draw requests from last run + -- MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) -- clean the renderer form last time -- SDL.clear renderer -- compute dt and update elapsedTime @@ -144,16 +149,19 @@ withAffection AffectionConfig{..} = do -- execute user defined update loop unless (pausedTime ad) (updateLoop dt) -- execute user defined draw loop + liftIO $ GL.clear [ColorBuffer, DepthBuffer] drawLoop + liftIO $ flush -- handle all new draw requests ad2 <- get - clear <- catMaybes <$> - MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2) - -- save all draw requests to clear in next run - put $ ad2 - { drawStack = clear } + -- clear <- catMaybes <$> + -- MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2) + -- -- save all draw requests to clear in next run + -- put $ ad2 + -- { drawStack = clear } -- actual drawing - SDL.present (windowRenderer ad2) + SDL.glSwapWindow window + -- SDL.present (windowRenderer ad2) -- save new time ad3 <- get when (sysTime ad == sysTime ad3) ( @@ -163,7 +171,7 @@ withAffection AffectionConfig{..} = do ) ) ) initContainer - G.gegl_exit + -- G.gegl_exit cleanUp $ userState nState SDL.destroyWindow window SDL.quit diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index c94d2c5..800ad5f 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -86,6 +86,7 @@ data AffectionData us = AffectionData { quitEvent :: Bool -- ^ Loop breaker. , userState :: us -- ^ State data provided by user , drawWindow :: SDL.Window -- ^ SDL window + , glContext :: SDL.GLContext -- ^ OpenGL rendering context , windowRenderer :: SDL.Renderer -- ^ Internal renderer of window , drawTexture :: SDL.Texture -- ^ SDL Texture to draw to , drawFormat :: B.BablFormatPtr -- ^ Target format