switching to 3D

This commit is contained in:
nek0 2017-09-09 16:47:24 +02:00
parent 821550b7cd
commit 46de809202
3 changed files with 51 additions and 41 deletions

View file

@ -72,6 +72,7 @@ library
, clock , clock
, glib , glib
, bytestring , bytestring
, OpenGL
-- , sdl2-image -- , sdl2-image
-- executable example00 -- executable example00

View file

@ -2,6 +2,7 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Affection module Affection
( withAffection ( withAffection
, get
, getAffection , getAffection
, putAffection , putAffection
-- , withWindow -- , withWindow
@ -13,7 +14,7 @@ module Affection
import qualified SDL import qualified SDL
import qualified SDL.Internal.Numbered as SDL (toNumber) import qualified SDL.Internal.Numbered as SDL (toNumber)
import qualified SDL.Raw as Raw import qualified SDL.Raw as Raw
import qualified GEGL as G -- import qualified GEGL as G
import Data.Maybe import Data.Maybe
import Data.IORef import Data.IORef
@ -39,6 +40,8 @@ import Affection.Actor as A
import Affection.Animation as A import Affection.Animation as A
import Affection.Util as A import Affection.Util as A
import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
import qualified BABL as B import qualified BABL as B
-- | Main function which bootstraps everything else. -- | Main function which bootstraps everything else.
@ -52,7 +55,7 @@ withAffection AffectionConfig{..} = do
SDL.initializeAll SDL.initializeAll
Only is -> Only is ->
SDL.initialize is SDL.initialize is
G.gegl_init -- G.gegl_init
-- give SDL render quality -- give SDL render quality
SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
-- just checking… -- just checking…
@ -63,35 +66,36 @@ withAffection AffectionConfig{..} = do
-- construct window -- construct window
window <- SDL.createWindow windowTitle windowConfig window <- SDL.createWindow windowTitle windowConfig
SDL.showWindow window SDL.showWindow window
-- create renderer context <- SDL.glCreateContext(window)
renderer <- SDL.createRenderer -- -- create renderer
window -- renderer <- SDL.createRenderer
(-1) -- window
SDL.defaultRenderer -- (-1)
-- make draw texture -- SDL.defaultRenderer
texture <- SDL.createTexture -- -- make draw texture
renderer -- texture <- SDL.createTexture
SDL.ABGR8888 -- renderer
SDL.TextureAccessStreaming -- SDL.ABGR8888
(case canvasSize of -- SDL.TextureAccessStreaming
Just (cw, ch) -> (SDL.V2 -- (case canvasSize of
(CInt $ fromIntegral cw) -- Just (cw, ch) -> (SDL.V2
(CInt $ fromIntegral ch) -- (CInt $ fromIntegral cw)
) -- (CInt $ fromIntegral ch)
Nothing -> -- )
SDL.windowInitialSize windowConfig -- Nothing ->
) -- SDL.windowInitialSize windowConfig
-- make draw surface -- )
-- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr -- -- make draw surface
-- -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
let SDL.V2 (CInt rw) (CInt rh) = windowInitialSize windowConfig let SDL.V2 (CInt rw) (CInt rh) = windowInitialSize windowConfig
(w, h) = case canvasSize of (w, h) = case canvasSize of
Just (cw, ch) -> (cw, ch) Just (cw, ch) -> (cw, ch)
Nothing -> (fromIntegral rw, fromIntegral rh) Nothing -> (fromIntegral rw, fromIntegral rh)
-- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w -- -- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w
bablFormat = B.PixelFormat B.RGBA B.CFu8 -- bablFormat = B.PixelFormat B.RGBA B.CFu8
cpp = B.babl_components_per_pixel bablFormat -- cpp = B.babl_components_per_pixel bablFormat
!stride = cpp * w -- !stride = cpp * w
format <- B.babl_format bablFormat -- format <- B.babl_format bablFormat
-- get current time -- get current time
SDL.setWindowMode window initScreenMode SDL.setWindowMode window initScreenMode
execTime <- getTime Monotonic execTime <- getTime Monotonic
@ -99,15 +103,16 @@ withAffection AffectionConfig{..} = do
{ quitEvent = False { quitEvent = False
, userState = x , userState = x
, drawWindow = window , drawWindow = window
, windowRenderer = renderer , glContext = context
, drawTexture = texture -- , windowRenderer = renderer
, drawFormat = format -- , drawTexture = texture
-- , drawFormat = format
, drawDimensions = case canvasSize of , drawDimensions = case canvasSize of
Just (cw, ch) -> (cw, ch) Just (cw, ch) -> (cw, ch)
Nothing -> (w, h) Nothing -> (w, h)
, screenMode = initScreenMode , screenMode = initScreenMode
, drawStride = stride -- , drawStride = stride
, drawCPP = cpp -- , drawCPP = cpp
, drawStack = [] , drawStack = []
, elapsedTime = 0 , elapsedTime = 0
, deltaTime = 0 , deltaTime = 0
@ -126,8 +131,8 @@ withAffection AffectionConfig{..} = do
-- Measure time difference form last run -- Measure time difference form last run
now <- liftIO $ getTime Monotonic now <- liftIO $ getTime Monotonic
let lastTime = sysTime ad let lastTime = sysTime ad
-- clean draw requests from last run -- -- clean draw requests from last run
MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad) -- MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad)
-- clean the renderer form last time -- clean the renderer form last time
-- SDL.clear renderer -- SDL.clear renderer
-- compute dt and update elapsedTime -- compute dt and update elapsedTime
@ -144,16 +149,19 @@ withAffection AffectionConfig{..} = do
-- execute user defined update loop -- execute user defined update loop
unless (pausedTime ad) (updateLoop dt) unless (pausedTime ad) (updateLoop dt)
-- execute user defined draw loop -- execute user defined draw loop
liftIO $ GL.clear [ColorBuffer, DepthBuffer]
drawLoop drawLoop
liftIO $ flush
-- handle all new draw requests -- handle all new draw requests
ad2 <- get ad2 <- get
clear <- catMaybes <$> -- clear <- catMaybes <$>
MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2) -- MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
-- save all draw requests to clear in next run -- -- save all draw requests to clear in next run
put $ ad2 -- put $ ad2
{ drawStack = clear } -- { drawStack = clear }
-- actual drawing -- actual drawing
SDL.present (windowRenderer ad2) SDL.glSwapWindow window
-- SDL.present (windowRenderer ad2)
-- save new time -- save new time
ad3 <- get ad3 <- get
when (sysTime ad == sysTime ad3) ( when (sysTime ad == sysTime ad3) (
@ -163,7 +171,7 @@ withAffection AffectionConfig{..} = do
) )
) )
) initContainer ) initContainer
G.gegl_exit -- G.gegl_exit
cleanUp $ userState nState cleanUp $ userState nState
SDL.destroyWindow window SDL.destroyWindow window
SDL.quit SDL.quit

View file

@ -86,6 +86,7 @@ data AffectionData us = AffectionData
{ quitEvent :: Bool -- ^ Loop breaker. { quitEvent :: Bool -- ^ Loop breaker.
, userState :: us -- ^ State data provided by user , userState :: us -- ^ State data provided by user
, drawWindow :: SDL.Window -- ^ SDL window , drawWindow :: SDL.Window -- ^ SDL window
, glContext :: SDL.GLContext -- ^ OpenGL rendering context
, windowRenderer :: SDL.Renderer -- ^ Internal renderer of window , windowRenderer :: SDL.Renderer -- ^ Internal renderer of window
, drawTexture :: SDL.Texture -- ^ SDL Texture to draw to , drawTexture :: SDL.Texture -- ^ SDL Texture to draw to
, drawFormat :: B.BablFormatPtr -- ^ Target format , drawFormat :: B.BablFormatPtr -- ^ Target format