unBABL and unGEGL

This commit is contained in:
nek0 2017-10-03 12:47:18 +02:00
parent 46de809202
commit 08c28fe686
4 changed files with 104 additions and 102 deletions

View file

@ -36,14 +36,14 @@ flag examples
library library
exposed-modules: Affection exposed-modules: Affection
, Affection.Draw -- , Affection.Draw
, Affection.Particle -- , Affection.Particle
, Affection.Types , Affection.Types
, Affection.StateMachine , Affection.StateMachine
, Affection.MouseInteractable , Affection.MouseInteractable
, Affection.Property -- , Affection.Property
, Affection.Actor -- , Affection.Actor
, Affection.Animation -- , Affection.Animation
, Affection.Util , Affection.Util
default-extensions: OverloadedStrings default-extensions: OverloadedStrings
@ -60,12 +60,12 @@ library
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
build-depends: base >=4.9 && <4.10 build-depends: base >=4.9
, sdl2 , sdl2
, text , text
, mtl , mtl
, gegl -- , gegl
, babl -- , babl
, monad-loops , monad-loops
, monad-parallel , monad-parallel
, containers , containers

View file

@ -11,6 +11,7 @@ module Affection
, module A , module A
) where ) where
import SDL (($=))
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
@ -31,18 +32,18 @@ import Foreign.Storable (peek)
import Debug.Trace import Debug.Trace
import Affection.Types as A import Affection.Types as A
import Affection.Draw as A -- import Affection.Draw as A
import Affection.Particle as A -- import Affection.Particle as A
import Affection.StateMachine as A import Affection.StateMachine as A
import Affection.MouseInteractable as A import Affection.MouseInteractable as A
import Affection.Property as A -- import Affection.Property as A
import Affection.Actor as A -- 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 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.
withAffection withAffection
@ -87,7 +88,7 @@ withAffection AffectionConfig{..} = do
-- ) -- )
-- -- make draw surface -- -- make draw surface
-- -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr -- -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
let SDL.V2 (CInt rw) (CInt rh) = windowInitialSize windowConfig let SDL.V2 (CInt rw) (CInt rh) = SDL.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)
@ -98,6 +99,7 @@ withAffection AffectionConfig{..} = do
-- format <- B.babl_format bablFormat -- format <- B.babl_format bablFormat
-- get current time -- get current time
SDL.setWindowMode window initScreenMode SDL.setWindowMode window initScreenMode
SDL.swapInterval $= SDL.SynchronizedUpdates
execTime <- getTime Monotonic execTime <- getTime Monotonic
initContainer <- (\x -> AffectionData initContainer <- (\x -> AffectionData
{ quitEvent = False { quitEvent = False
@ -113,7 +115,7 @@ withAffection AffectionConfig{..} = do
, screenMode = initScreenMode , screenMode = initScreenMode
-- , drawStride = stride -- , drawStride = stride
-- , drawCPP = cpp -- , drawCPP = cpp
, drawStack = [] -- , drawStack = []
, elapsedTime = 0 , elapsedTime = 0
, deltaTime = 0 , deltaTime = 0
, sysTime = execTime , sysTime = execTime
@ -139,8 +141,8 @@ withAffection AffectionConfig{..} = do
let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9) let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9)
!ne = elapsedTime ad + dt !ne = elapsedTime ad + dt
put $ ad put $ ad
{ drawStack = [] -- { drawStack = []
, elapsedTime = ne { elapsedTime = ne
, deltaTime = dt , deltaTime = dt
} }
-- poll events -- poll events

View file

@ -28,9 +28,8 @@ import System.Glib.GObject
import qualified SDL import qualified SDL
import qualified BABL as B -- import qualified BABL as B
-- import qualified GEGL as G
import qualified GEGL as G
import Debug.Trace import Debug.Trace

View file

@ -1,33 +1,34 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Affection.Types module Affection.Types
( Affection -- ( Affection
, AffectionData(..) -- , AffectionData(..)
, AffectionConfig(..) -- , AffectionConfig(..)
, AffectionState(..) -- , AffectionState(..)
-- , AffectionDraw(..) -- -- , AffectionDraw(..)
-- , Draw(..) -- -- , Draw(..)
, AffectionStateInner -- , AffectionStateInner
-- , AffectionDrawInner(..) -- -- , AffectionDrawInner(..)
, InitComponents(..) -- , InitComponents(..)
-- , Loop(..) -- -- , Loop(..)
-- , RGBA(..) -- -- , RGBA(..)
, DrawType(..) -- , DrawType(..)
, DrawRequest(..) -- , DrawRequest(..)
, RequestPersist(..) -- , RequestPersist(..)
, Angle(..) -- , Angle(..)
-- , ConvertAngle(..) -- -- , ConvertAngle(..)
-- | Particle system -- -- | Particle system
, Particle(..) -- , Particle(..)
, ParticleSystem(..) -- , ParticleSystem(..)
, ParticleStorage(..) -- , ParticleStorage(..)
-- | Convenience exports -- -- | Convenience exports
, liftIO -- , liftIO
, SDL.WindowConfig(..) -- , SDL.WindowConfig(..)
, SDL.defaultWindow -- , SDL.defaultWindow
-- | GEGL reexports -- -- | GEGL reexports
, G.GeglRectangle(..) -- , G.GeglRectangle(..)
, G.GeglBuffer(..) -- , G.GeglBuffer(..)
) where -- )
where
import qualified SDL.Init as SDL import qualified SDL.Init as SDL
import qualified SDL.Video 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 qualified Data.Text as T
import Data.Map.Strict as M import Data.Map.Strict as M
import qualified GEGL as G -- import qualified GEGL as G
import qualified BABL as B -- import qualified BABL as B
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.State import Control.Monad.State
@ -89,9 +90,9 @@ data AffectionData us = AffectionData
, glContext :: SDL.GLContext -- ^ OpenGL rendering context , 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
, screenMode :: SDL.WindowMode -- ^ current screen mode , 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 , drawDimensions :: (Int, Int) -- ^ Dimensions of target surface
, drawStride :: Int -- ^ Stride of target buffer , drawStride :: Int -- ^ Stride of target buffer
, drawCPP :: Int -- ^ Number of components per pixel , drawCPP :: Int -- ^ Number of components per pixel
@ -101,19 +102,19 @@ data AffectionData us = AffectionData
, pausedTime :: Bool -- ^ Should the update loop be executed? , pausedTime :: Bool -- ^ Should the update loop be executed?
} }
-- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated -- -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
data DrawRequest = DrawRequest -- data DrawRequest = DrawRequest
{ requestArea :: G.GeglRectangle -- ^ The area to update -- { requestArea :: G.GeglRectangle -- ^ The area to update
, requestBuffer :: G.GeglBuffer -- ^ Buffer to draw -- , requestBuffer :: G.GeglBuffer -- ^ Buffer to draw
, requestPersist :: RequestPersist -- ^ Shall the drawRequest persist -- , requestPersist :: RequestPersist -- ^ Shall the drawRequest persist
} -- }
--
data RequestPersist -- data RequestPersist
= Persist -- = Persist
| Kill (Maybe G.GeglNode) -- | Kill (Maybe G.GeglNode)
--
-- | A type for storing 'DrawRequest' results to be executed frequently. TODO -- -- | A type for storing 'DrawRequest' results to be executed frequently. TODO
data DrawAsset = DrawAsset -- data DrawAsset = DrawAsset
-- | Inner 'StateT' monad for the update state -- | Inner 'StateT' monad for the update state
-- type AffectionStateInner us m a = StateT (AffectionData us) m a -- type AffectionStateInner us m a = StateT (AffectionData us) m a
@ -191,39 +192,39 @@ type Angle = Double
-- (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry -- (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry
-- (==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy -- (==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy
-- | A single particle -- -- | A single particle
data Particle = Particle -- data Particle = Particle
{ particleTimeToLive :: Double -- { particleTimeToLive :: Double
-- ^ Time to live in seconds -- -- ^ Time to live in seconds
, particleCreation :: Double -- , particleCreation :: Double
-- ^ Creation time of particle in seconds form program start -- -- ^ Creation time of particle in seconds form program start
, particlePosition :: (Double, Double) -- , particlePosition :: (Double, Double)
-- ^ Position of particle on canvas -- -- ^ Position of particle on canvas
, particleRotation :: Angle -- , particleRotation :: Angle
-- ^ Particle rotation -- -- ^ Particle rotation
, particleVelocity :: (Int, Int) -- , particleVelocity :: (Int, Int)
-- ^ particle velocity as vector of pixels per second -- -- ^ particle velocity as vector of pixels per second
, particlePitchRate :: Angle -- , particlePitchRate :: Angle
-- ^ Rotational velocity of particle in angle per second -- -- ^ Rotational velocity of particle in angle per second
, particleRootNode :: G.GeglNode -- , particleRootNode :: G.GeglNode
-- ^ Root 'G.GeglNode' of 'Particle' -- -- ^ Root 'G.GeglNode' of 'Particle'
, particleNodeGraph :: Map String G.GeglNode -- , particleNodeGraph :: Map String G.GeglNode
-- ^ Node Graph of 'G.GeglNodes' per particle -- -- ^ Node Graph of 'G.GeglNodes' per particle
, particleStackCont :: G.GeglNode -- , particleStackCont :: G.GeglNode
-- ^ 'G.GeglNode' to connect other 'Particle's to -- -- ^ 'G.GeglNode' to connect other 'Particle's to
, particleDrawFlange :: G.GeglNode -- , particleDrawFlange :: G.GeglNode
-- ^ 'G.GeglNode' to connect draw actions to -- -- ^ 'G.GeglNode' to connect draw actions to
} deriving (Eq) -- } deriving (Eq)
--
-- | The particle system -- -- | The particle system
data ParticleSystem = ParticleSystem -- data ParticleSystem = ParticleSystem
{ partSysParts :: ParticleStorage -- { partSysParts :: ParticleStorage
, partSysNode :: G.GeglNode -- , partSysNode :: G.GeglNode
, partSysBuffer :: G.GeglBuffer -- , partSysBuffer :: G.GeglBuffer
} -- }
--
-- | The particle storage datatype -- -- | The particle storage datatype
data ParticleStorage = ParticleStorage -- data ParticleStorage = ParticleStorage
{ partStorLatest :: Maybe Particle -- ^ The particle stored last -- { partStorLatest :: Maybe Particle -- ^ The particle stored last
, partStorList :: [Particle] -- ^ List of particles in ascending order of remaining lifetime -- , partStorList :: [Particle] -- ^ List of particles in ascending order of remaining lifetime
} -- }