unBABL and unGEGL

affection.cabal

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

src/Affection.hs

@@ -11,6 +11,7 @@ module Affection
     , module A
     ) where
 
+import SDL (($=))
 import qualified SDL
 import qualified SDL.Internal.Numbered as SDL (toNumber)
 import qualified SDL.Raw as Raw
@@ -31,18 +32,18 @@ import Foreign.Storable (peek)
 import Debug.Trace
 
 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.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 Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
 
-import qualified BABL as B
+-- import qualified BABL as B
 
 -- | Main function which bootstraps everything else.
 withAffection
@@ -87,7 +88,7 @@ withAffection AffectionConfig{..} = do
   --     )
   -- -- 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) = SDL.windowInitialSize windowConfig
       (w, h) = case canvasSize of
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (fromIntegral rw, fromIntegral rh)
@@ -98,6 +99,7 @@ withAffection AffectionConfig{..} = do
   -- format <- B.babl_format bablFormat
   -- get current time
   SDL.setWindowMode window initScreenMode
+  SDL.swapInterval $= SDL.SynchronizedUpdates
   execTime <- getTime Monotonic
   initContainer <- (\x -> AffectionData
     { quitEvent       = False
@@ -113,7 +115,7 @@ withAffection AffectionConfig{..} = do
     , screenMode      = initScreenMode
     -- , drawStride      = stride
     -- , drawCPP         = cpp
-    , drawStack       = []
+    -- , drawStack       = []
     , elapsedTime     = 0
     , deltaTime       = 0
     , sysTime         = execTime
@@ -139,8 +141,8 @@ withAffection AffectionConfig{..} = do
         let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9)
             !ne = elapsedTime ad + dt
         put $ ad
-          { drawStack = []
+          -- { drawStack = []
-          , elapsedTime = ne
+          { elapsedTime = ne
           , deltaTime = dt
           }
         -- poll events

src/Affection/Draw.hs

@@ -28,9 +28,8 @@ import System.Glib.GObject
 
 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
 

src/Affection/Types.hs

@@ -1,33 +1,34 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
 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.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 GEGL as G
-import qualified BABL as B
+-- import qualified BABL as B
 
 import Control.Monad.IO.Class
 import Control.Monad.State
@@ -89,9 +90,9 @@ data AffectionData us = AffectionData
   , 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
@@ -101,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
+-- -- | 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
 -- type AffectionStateInner us m a = StateT (AffectionData us) m a
@@ -191,39 +192,39 @@ type Angle = Double
 --   (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry
 --   (==) 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
-  }
+--   }