Merge branch '3d'
This commit is contained in:
nek0
commit
1c41f037ac
4 changed files with 155 additions and 143 deletions
|
|
@ -36,14 +36,14 @@ flag examples
|
|||
|
||||
library
|
||||
exposed-modules: Affection
|
||||
, Affection.Draw
|
||||
, Affection.Particle
|
||||
-- , Affection.Draw
|
||||
-- , Affection.Particle
|
||||
, Affection.Types
|
||||
, Affection.StateMachine
|
||||
, Affection.MouseInteractable
|
||||
, Affection.Property
|
||||
, Affection.Actor
|
||||
, Affection.Animation
|
||||
-- , Affection.Property
|
||||
-- , Affection.Actor
|
||||
-- , Affection.Animation
|
||||
, Affection.Util
|
||||
default-extensions: OverloadedStrings
|
||||
|
||||
|
|
@ -60,18 +60,19 @@ library
|
|||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base >=4.9 && <4.11
|
||||
build-depends: base >=4.9
|
||||
, sdl2
|
||||
, text
|
||||
, mtl
|
||||
, gegl
|
||||
, babl
|
||||
-- , gegl
|
||||
-- , babl
|
||||
, monad-loops
|
||||
, monad-parallel
|
||||
, containers
|
||||
, clock
|
||||
, glib
|
||||
, bytestring
|
||||
, OpenGL
|
||||
-- , sdl2-image
|
||||
|
||||
-- executable example00
|
||||
|
|
|
|||
112
src/Affection.hs
112
src/Affection.hs
|
|
@ -2,6 +2,7 @@
|
|||
{-# LANGUAGE BangPatterns #-}
|
||||
module Affection
|
||||
( withAffection
|
||||
, get
|
||||
, getAffection
|
||||
, putAffection
|
||||
-- , withWindow
|
||||
|
|
@ -12,10 +13,11 @@ module Affection
|
|||
, module A
|
||||
) where
|
||||
|
||||
import SDL (($=))
|
||||
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
|
||||
|
|
@ -31,16 +33,18 @@ import Foreign.Storable (peek)
|
|||
import Debug.Trace
|
||||
|
||||
import Affection.Types as A
|
||||
import Affection.Draw as A
|
||||
import Affection.Particle as A
|
||||
-- import Affection.Draw as A
|
||||
-- import Affection.Particle as A
|
||||
import Affection.StateMachine as A
|
||||
import Affection.MouseInteractable as A
|
||||
import Affection.Property as A
|
||||
import Affection.Actor as A
|
||||
import Affection.Animation as A
|
||||
-- import Affection.Property as A
|
||||
-- import Affection.Actor as A
|
||||
-- import Affection.Animation as A
|
||||
import Affection.Util as A
|
||||
|
||||
import qualified BABL as B
|
||||
import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
|
||||
|
||||
-- import qualified BABL as B
|
||||
|
||||
-- | Main function which bootstraps everything else.
|
||||
withAffection
|
||||
|
|
@ -53,7 +57,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…
|
||||
|
|
@ -64,52 +68,55 @@ 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
|
||||
let SDL.V2 (CInt rw) (CInt rh) = windowInitialSize windowConfig
|
||||
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) = SDL.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
|
||||
SDL.swapInterval $= SDL.SynchronizedUpdates
|
||||
execTime <- getTime Monotonic
|
||||
initContainer <- (\x -> AffectionData
|
||||
{ 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
|
||||
, drawStack = []
|
||||
-- , drawStride = stride
|
||||
-- , drawCPP = cpp
|
||||
-- , drawStack = []
|
||||
, elapsedTime = 0
|
||||
, deltaTime = 0
|
||||
, sysTime = execTime
|
||||
|
|
@ -127,16 +134,16 @@ withAffection AffectionConfig{..} = do
|
|||
-- Measure time difference form last run
|
||||
now <- liftIO $ getTime Monotonic
|
||||
let lastTime = sysTime ad
|
||||
-- clean draw requests from last run
|
||||
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
|
||||
let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9)
|
||||
!ne = elapsedTime ad + dt
|
||||
put $ ad
|
||||
{ drawStack = []
|
||||
, elapsedTime = ne
|
||||
-- { drawStack = []
|
||||
{ elapsedTime = ne
|
||||
, deltaTime = dt
|
||||
}
|
||||
-- poll events
|
||||
|
|
@ -145,16 +152,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 <$>
|
||||
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) (
|
||||
|
|
@ -164,7 +174,7 @@ withAffection AffectionConfig{..} = do
|
|||
)
|
||||
)
|
||||
) initContainer
|
||||
G.gegl_exit
|
||||
-- G.gegl_exit
|
||||
cleanUp $ userState nState
|
||||
SDL.destroyWindow window
|
||||
SDL.quit
|
||||
|
|
|
|||
|
|
@ -28,9 +28,8 @@ import System.Glib.GObject
|
|||
|
||||
import qualified SDL
|
||||
|
||||
import qualified BABL as B
|
||||
|
||||
import qualified GEGL as G
|
||||
-- import qualified BABL as B
|
||||
-- import qualified GEGL as G
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
|
|
|
|||
|
|
@ -1,33 +1,34 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
|
||||
module Affection.Types
|
||||
( Affection
|
||||
, AffectionData(..)
|
||||
, AffectionConfig(..)
|
||||
, AffectionState(..)
|
||||
-- , AffectionDraw(..)
|
||||
-- , Draw(..)
|
||||
, AffectionStateInner
|
||||
-- , AffectionDrawInner(..)
|
||||
, InitComponents(..)
|
||||
-- , Loop(..)
|
||||
-- , RGBA(..)
|
||||
, DrawType(..)
|
||||
, DrawRequest(..)
|
||||
, RequestPersist(..)
|
||||
, Angle(..)
|
||||
-- , ConvertAngle(..)
|
||||
-- | Particle system
|
||||
, Particle(..)
|
||||
, ParticleSystem(..)
|
||||
, ParticleStorage(..)
|
||||
-- | Convenience exports
|
||||
, liftIO
|
||||
, SDL.WindowConfig(..)
|
||||
, SDL.defaultWindow
|
||||
-- | GEGL reexports
|
||||
, G.GeglRectangle(..)
|
||||
, G.GeglBuffer(..)
|
||||
) where
|
||||
-- ( Affection
|
||||
-- , AffectionData(..)
|
||||
-- , AffectionConfig(..)
|
||||
-- , AffectionState(..)
|
||||
-- -- , AffectionDraw(..)
|
||||
-- -- , Draw(..)
|
||||
-- , AffectionStateInner
|
||||
-- -- , AffectionDrawInner(..)
|
||||
-- , InitComponents(..)
|
||||
-- -- , Loop(..)
|
||||
-- -- , RGBA(..)
|
||||
-- , DrawType(..)
|
||||
-- , DrawRequest(..)
|
||||
-- , RequestPersist(..)
|
||||
-- , Angle(..)
|
||||
-- -- , ConvertAngle(..)
|
||||
-- -- | Particle system
|
||||
-- , Particle(..)
|
||||
-- , ParticleSystem(..)
|
||||
-- , ParticleStorage(..)
|
||||
-- -- | Convenience exports
|
||||
-- , liftIO
|
||||
-- , SDL.WindowConfig(..)
|
||||
-- , SDL.defaultWindow
|
||||
-- -- | GEGL reexports
|
||||
-- , G.GeglRectangle(..)
|
||||
-- , G.GeglBuffer(..)
|
||||
-- )
|
||||
where
|
||||
|
||||
import qualified SDL.Init as SDL
|
||||
import qualified SDL.Video as SDL
|
||||
|
|
@ -35,8 +36,8 @@ import qualified SDL.Event as SDL
|
|||
import qualified Data.Text as T
|
||||
import Data.Map.Strict as M
|
||||
|
||||
import qualified GEGL as G
|
||||
import qualified BABL as B
|
||||
-- import qualified GEGL as G
|
||||
-- import qualified BABL as B
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.State
|
||||
|
|
@ -86,11 +87,12 @@ 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
|
||||
-- , drawFormat :: B.BablFormatPtr -- ^ Target format
|
||||
, screenMode :: SDL.WindowMode -- ^ current screen mode
|
||||
, drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed
|
||||
-- , drawStack :: [DrawRequest] -- ^ Stack of 'DrawRequest's to be processed
|
||||
, drawDimensions :: (Int, Int) -- ^ Dimensions of target surface
|
||||
, drawStride :: Int -- ^ Stride of target buffer
|
||||
, drawCPP :: Int -- ^ Number of components per pixel
|
||||
|
|
@ -100,19 +102,19 @@ data AffectionData us = AffectionData
|
|||
, pausedTime :: Bool -- ^ Should the update loop be executed?
|
||||
}
|
||||
|
||||
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
|
||||
data DrawRequest = DrawRequest
|
||||
{ requestArea :: G.GeglRectangle -- ^ The area to update
|
||||
, requestBuffer :: G.GeglBuffer -- ^ Buffer to draw
|
||||
, requestPersist :: RequestPersist -- ^ Shall the drawRequest persist
|
||||
}
|
||||
|
||||
data RequestPersist
|
||||
= Persist
|
||||
| Kill (Maybe G.GeglNode)
|
||||
|
||||
-- | A type for storing 'DrawRequest' results to be executed frequently. TODO
|
||||
data DrawAsset = DrawAsset
|
||||
-- -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
|
||||
-- data DrawRequest = DrawRequest
|
||||
-- { requestArea :: G.GeglRectangle -- ^ The area to update
|
||||
-- , requestBuffer :: G.GeglBuffer -- ^ Buffer to draw
|
||||
-- , requestPersist :: RequestPersist -- ^ Shall the drawRequest persist
|
||||
-- }
|
||||
--
|
||||
-- data RequestPersist
|
||||
-- = Persist
|
||||
-- | Kill (Maybe G.GeglNode)
|
||||
--
|
||||
-- -- | A type for storing 'DrawRequest' results to be executed frequently. TODO
|
||||
-- data DrawAsset = DrawAsset
|
||||
|
||||
-- | Inner 'StateT' monad for the update state
|
||||
-- type AffectionStateInner us m a = StateT (AffectionData us) m a
|
||||
|
|
@ -190,39 +192,39 @@ type Angle = Double
|
|||
-- (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry
|
||||
-- (==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy
|
||||
|
||||
-- | A single particle
|
||||
data Particle = Particle
|
||||
{ particleTimeToLive :: Double
|
||||
-- ^ Time to live in seconds
|
||||
, particleCreation :: Double
|
||||
-- ^ Creation time of particle in seconds form program start
|
||||
, particlePosition :: (Double, Double)
|
||||
-- ^ Position of particle on canvas
|
||||
, particleRotation :: Angle
|
||||
-- ^ Particle rotation
|
||||
, particleVelocity :: (Int, Int)
|
||||
-- ^ particle velocity as vector of pixels per second
|
||||
, particlePitchRate :: Angle
|
||||
-- ^ Rotational velocity of particle in angle per second
|
||||
, particleRootNode :: G.GeglNode
|
||||
-- ^ Root 'G.GeglNode' of 'Particle'
|
||||
, particleNodeGraph :: Map String G.GeglNode
|
||||
-- ^ Node Graph of 'G.GeglNodes' per particle
|
||||
, particleStackCont :: G.GeglNode
|
||||
-- ^ 'G.GeglNode' to connect other 'Particle's to
|
||||
, particleDrawFlange :: G.GeglNode
|
||||
-- ^ 'G.GeglNode' to connect draw actions to
|
||||
} deriving (Eq)
|
||||
|
||||
-- | The particle system
|
||||
data ParticleSystem = ParticleSystem
|
||||
{ partSysParts :: ParticleStorage
|
||||
, partSysNode :: G.GeglNode
|
||||
, partSysBuffer :: G.GeglBuffer
|
||||
}
|
||||
|
||||
-- | The particle storage datatype
|
||||
data ParticleStorage = ParticleStorage
|
||||
{ partStorLatest :: Maybe Particle -- ^ The particle stored last
|
||||
, partStorList :: [Particle] -- ^ List of particles in ascending order of remaining lifetime
|
||||
}
|
||||
-- -- | A single particle
|
||||
-- data Particle = Particle
|
||||
-- { particleTimeToLive :: Double
|
||||
-- -- ^ Time to live in seconds
|
||||
-- , particleCreation :: Double
|
||||
-- -- ^ Creation time of particle in seconds form program start
|
||||
-- , particlePosition :: (Double, Double)
|
||||
-- -- ^ Position of particle on canvas
|
||||
-- , particleRotation :: Angle
|
||||
-- -- ^ Particle rotation
|
||||
-- , particleVelocity :: (Int, Int)
|
||||
-- -- ^ particle velocity as vector of pixels per second
|
||||
-- , particlePitchRate :: Angle
|
||||
-- -- ^ Rotational velocity of particle in angle per second
|
||||
-- , particleRootNode :: G.GeglNode
|
||||
-- -- ^ Root 'G.GeglNode' of 'Particle'
|
||||
-- , particleNodeGraph :: Map String G.GeglNode
|
||||
-- -- ^ Node Graph of 'G.GeglNodes' per particle
|
||||
-- , particleStackCont :: G.GeglNode
|
||||
-- -- ^ 'G.GeglNode' to connect other 'Particle's to
|
||||
-- , particleDrawFlange :: G.GeglNode
|
||||
-- -- ^ 'G.GeglNode' to connect draw actions to
|
||||
-- } deriving (Eq)
|
||||
--
|
||||
-- -- | The particle system
|
||||
-- data ParticleSystem = ParticleSystem
|
||||
-- { partSysParts :: ParticleStorage
|
||||
-- , partSysNode :: G.GeglNode
|
||||
-- , partSysBuffer :: G.GeglBuffer
|
||||
-- }
|
||||
--
|
||||
-- -- | The particle storage datatype
|
||||
-- data ParticleStorage = ParticleStorage
|
||||
-- { partStorLatest :: Maybe Particle -- ^ The particle stored last
|
||||
-- , partStorList :: [Particle] -- ^ List of particles in ascending order of remaining lifetime
|
||||
-- }
|
||||
|
|
|
|||
Loading…
Reference in a new issue