some linting

examples/example00.hs

@@ -106,7 +106,7 @@ update = do
   ad <- get
   ud@UserData{..} <- getAffection
 
-  sec <- getTick
+  sec <- getDelta
   traceM $ (show $ 1 / sec) ++ " FPS"
   when (elapsedTime ad > 5) $
     put $ ad

examples/example01.hs

@@ -40,7 +40,7 @@ main = do
 data UserData = UserData
   { nodeGraph   :: M.Map String G.GeglNode
   , foreground  :: G.GeglBuffer
-  , lastTick    :: Double
+  -- , lastTick    :: Double
   }
 
 load :: SDL.Surface -> IO UserData
@@ -82,7 +82,7 @@ load _ = do
   return $ UserData
     { nodeGraph = myMap
     , foreground = buffer
-    , lastTick = 0
+    -- , lastTick = 0
     }
 
 draw :: Affection UserData ()
@@ -96,13 +96,13 @@ update :: Affection UserData ()
 update = do
   traceM "updating"
   ud <- getAffection
-  let last = lastTick ud
+  -- let last = lastTick ud
-  tick <- getTick
+  -- tick <- getTick
-  putAffection $ ud { lastTick = tick }
+  -- putAffection $ ud { lastTick = tick }
-  let dt = tick - last
+  dt <- getDelta
   traceM $ (show $ 1 / dt) ++ " FPS"
-
+  elapsed <- getElapsedTime
-  when (tick > 20) $
+  when (elapsed > 20) $
     quit
 
 clean :: UserData -> IO ()

examples/example02.hs

@@ -10,7 +10,7 @@ import Debug.Trace
 
 main :: IO ()
 main = do
-  conf <- return $ AffectionConfig
+  conf <- return AffectionConfig
     { initComponents = All
     , windowTitle    = "Affection: example00"
     , windowConfig   = SDL.defaultWindow
@@ -77,7 +77,7 @@ load _ = do
   actorMap <- return $ M.fromList
     [ ("rect", rectActor)
     ]
-  return $ UserData
+  return UserData
     { nodeGraph = myMap
     , actors    = actorMap
     , foreground = buffer
@@ -100,13 +100,13 @@ update :: Affection UserData ()
 update = do
   traceM "updating"
 
-  tick <- getTick
+  tick <- getElapsedTime
   ud <- getAffection
   putAffection $ ud { lastTick = tick }
 
   let dt = tick - lastTick ud
   return ()
-  traceM $ (show $ 1 / dt) ++ " FPS"
+  traceM $ show (1 / dt) ++ " FPS"
 
 handle :: SDL.EventPayload -> Affection UserData ()
 handle (SDL.MouseMotionEvent dat) = do
@@ -114,11 +114,11 @@ handle (SDL.MouseMotionEvent dat) = do
   ud <- getAffection
   
   nmap <- return $ M.adjust
-    (\a -> Actor (props $ do
+    (Actor (props $ do
       prop "y" (fromIntegral (y - 10) :: Double)
       prop "x" (fromIntegral (x - 10) :: Double)
       )
-      (actorNode a)
+      . actorNode
       )
     "rect"
     (actors ud)

examples/example03.hs

@@ -42,10 +42,14 @@ load _ = do
   traceM "loading"
   root <- G.gegl_node_new
   traceM "new root node"
-  checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation
+  rect <- G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $
-    [ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1
+    props $ do
-    , G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1
+      prop "x" (0 :: Double)
-    ]
+      prop "y" (0 :: Double)
+      prop "width" (800 :: Double)
+      prop "height" (600 :: Double)
+      prop "color" $ G.RGB 0 0 0
+  traceM "rect"
   traceM "checkerboard"
   over <- G.gegl_node_new_child root G.defaultOverOperation
   traceM "over"
@@ -62,13 +66,12 @@ load _ = do
     , G.Property "height" $ G.PropertyDouble 600
     ]
   traceM "crop"
-  G.gegl_node_link_many [checkerboard, over, crop, sink]
+  G.gegl_node_link_many [rect, over, crop, sink]
   G.gegl_node_connect_to nop "output" over "aux"
   traceM "connections made"
   myMap <- return $ M.fromList
     [ ("root"        , root)
     , ("over"        , over)
-    , ("background"  , checkerboard)
     , ("sink"        , sink)
     , ("nop"         , nop)
     , ("crop"        , crop)
@@ -81,29 +84,21 @@ load _ = do
     }
 
 drawInit :: Affection UserData ()
-drawInit = do
+drawInit = return ()
-  UserData{..} <- getAffection
+-- drawInit = do
-  present (GeglRectangle 0 0 800 600) foreground True
+--   UserData{..} <- getAffection
+--   present (GeglRectangle 0 0 800 600) foreground True
 
 draw :: Affection UserData ()
 draw = do
   traceM "drawing"
   UserData{..} <- getAffection
+  drawParticleSystem partsys partDraw
   process $ nodeGraph M.! "sink"
-  -- ad <- get
+  present
-  -- ud <- getAffection
+    (G.GeglRectangle 0 0 800 600)
-  -- drawParticles partDraw $ particles ud
+    foreground
-  -- SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions $ drawSurface ad
+    True
-  -- let (w, h) = (fromIntegral rw, fromIntegral rh)
-  -- liftIO $ clearArea (foreground ud) (GeglRectangle 0 0 w h)
-  -- maybe (return ()) (\(x, y) ->
-  --   drawRect
-  --     (foreground ud)
-  --     (nodeGraph ud M.! "over")
-  --     (G.RGBA 1 0 0 0.5)
-  --     (Line 7)
-  --     (G.GeglRectangle (x - 10) (y - 10) 20 20)
-  --   ) $ coordinates ud
 
 update :: Affection UserData ()
 update = do
@@ -111,17 +106,14 @@ update = do
   ad <- get
   ud <- getAffection
   delta <- getDelta
-  -- let newPart = updateParticles delta partUpd $ particles ud
-  -- putAffection $ ud { particles = newPart }
   traceM $ (show $ 1 / delta) ++ " FPS"
-  -- ev <- liftIO $ SDL.pollEvents
   ud2 <- getAffection
-  !nps <- updateParticleSystem (partsys ud2) delta partUpd partDraw
+  !nps <- updateParticleSystem (partsys ud2) delta partUpd
   putAffection $ ud2 { partsys = nps }
 
 handle (SDL.MouseMotionEvent dat) =
-        if SDL.ButtonLeft `elem` SDL.mouseMotionEventState dat
+  when (SDL.ButtonLeft `elem` SDL.mouseMotionEventState dat)
-        then do
+  $ do
     ad <- get
     ud <- getAffection
     let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat
@@ -169,8 +161,6 @@ handle (SDL.MouseMotionEvent dat) =
     --   liftIO $ G.gegl_node_link
     --     tempOver
     --     (particleStackCont $ head $ psParts $ partsys ud)
-        else
-          return ()
 
 handle (SDL.WindowClosedEvent _) = do
   traceM "seeya!"
@@ -180,7 +170,8 @@ handle _ =
   return ()
 
 clean :: UserData -> IO ()
-clean _ = return ()
+clean ud = do
+  G.gegl_node_drop (nodeGraph ud M.! "root")
 
 partUpd :: Double -> Particle -> Affection UserData Particle
 partUpd sec p = do

src/Affection.hs

@@ -9,7 +9,7 @@ module Affection
     , delaySec
     , get
     , put
-    , getTick
+    , getElapsedTime
     , getDelta
     , quit
     , module A
@@ -81,8 +81,8 @@ withAffection AffectionConfig{..} = do
   pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
   SDL.V2 (CInt rw) (CInt rh) <- liftIO $ SDL.surfaceDimensions surface
   let (w, h) = (fromIntegral rw, fromIntegral rh)
-      stride = (fromIntegral $ Raw.pixelFormatBytesPerPixel pixelFormat) * w
+      stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w
-  pixels <- SDL.surfacePixels $ surface
+  pixels <- SDL.surfacePixels surface
   let bablFormat = B.PixelFormat B.RGBA B.CFu8
       cpp        = B.babl_components_per_pixel bablFormat
   format <- B.babl_format bablFormat
@@ -116,9 +116,9 @@ withAffection AffectionConfig{..} = do
         -- clean draw requests from last run
         mapM_ (invalidateDrawRequest (drawPixels ad) (drawStride ad) (drawCPP ad)) (drawStack ad)
         -- clean the renderer form last time
-        SDL.clear renderer
+        -- SDL.clear renderer
         -- compute dt and update elapsedTime
-        let !dt = (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) / (fromIntegral 10 ^ 9)
+        let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9)
             !ne = elapsedTime ad + dt
         put $ ad
           { drawStack = []
@@ -147,7 +147,7 @@ withAffection AffectionConfig{..} = do
         -- clean the texture
         SDL.destroyTexture texture
         -- save new time
-        liftIO $ writeIORef execTime $ now
+        liftIO $ writeIORef execTime now
       )
     ) initContainer
   G.gegl_exit
@@ -159,7 +159,7 @@ getSurfaces :: SDL.Window -> IO (SDL.Surface, SDL.Surface)
 getSurfaces window = do
   oldSurf@(SDL.Surface ptr _) <- SDL.getWindowSurface window
   rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0
-  let surface = (flip SDL.Surface Nothing) rawSurfacePtr
+  let surface = SDL.Surface rawSurfacePtr Nothing
   return (oldSurf, surface)
 
 -- Prehandle SDL events in case any window events occur
@@ -198,8 +198,8 @@ delaySec
 delaySec dur = SDL.delay (fromIntegral $ dur * 1000)
 
 -- | Get time since start but always the same in the current tick.
-getTick :: Affection us Double
+getElapsedTime :: Affection us Double
-getTick =
+getElapsedTime =
   elapsedTime <$> get
 
 getDelta :: Affection us Double

src/Affection/Draw.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards, BangPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
 
 -- | Module for drawing primitives
 module Affection.Draw
@@ -40,7 +40,7 @@ drawRect
   -> Affection us ()
 drawRect node color Fill rect@GeglRectangle{..} buf = do
   ad <- get
-  tempRoot <- liftIO $ G.gegl_node_new
+  tempRoot <- liftIO G.gegl_node_new
   opNode <- liftIO $ G.gegl_node_new_child tempRoot $ G.Operation "gegl:rectangle"
     [ G.Property "x"      $ G.PropertyDouble $ fromIntegral rectangleX
     , G.Property "y"      $ G.PropertyDouble $ fromIntegral rectangleY
@@ -51,7 +51,7 @@ drawRect node color Fill rect@GeglRectangle{..} buf = do
   diw <- liftIO $ G.gegl_node_connect_to opNode "output" node "input"
   unless diw $ error "Affection.Draw.drawRect: connect failed"
   put $ ad
-    { drawStack = (DrawRequest rect buf (Kill (Just tempRoot))) : drawStack ad
+    { drawStack = DrawRequest rect buf (Kill (Just tempRoot)) : drawStack ad
     }
 
 -- | Force update of a specific region on screen
@@ -64,7 +64,7 @@ present rect buf kill = do
   ad <- get
   let k = if not kill then Kill Nothing else Persist
   put ad
-    { drawStack = (DrawRequest rect buf k) : drawStack ad
+    { drawStack = DrawRequest rect buf k : drawStack ad
     }
 
 process
@@ -106,20 +106,9 @@ handleDrawRequest pixels stride cpp dr@DrawRequest{..} = do
   let surf = drawSurface ad
   mrealRect <- liftIO $ G.gegl_rectangle_intersect
     requestArea
-    (G.GeglRectangle 0 0 (fst $ drawDimensions ad) (snd $ drawDimensions ad))
+    (uncurry (G.GeglRectangle 0 0) (drawDimensions ad))
-  maybe (return()) (\realRect -> do
+  maybe (return()) (\realRect ->
-    liftIO $ SDL.lockSurface surf
+    putToSurface pixels realRect stride cpp dr
-    liftIO $ G.gegl_buffer_get
-      requestBuffer
-      (Just realRect)
-      1
-      (Just $ drawFormat ad)
-      (pixels `plusPtr`
-        (rectangleX realRect * cpp + rectangleY realRect * stride))
-      stride
-      G.GeglAbyssNone
-    liftIO $ SDL.unlockSurface surf
-    -- liftIO $ SDL.updateWindowSurface $ drawWindow ad
     ) mrealRect
   case requestPersist of
     Persist ->
@@ -139,21 +128,10 @@ invalidateDrawRequest pixels stride cpp dr@DrawRequest{..} = do
   ad <- get
   mrealRect <- liftIO $ G.gegl_rectangle_intersect
     requestArea
-    (G.GeglRectangle 0 0 (fst $ drawDimensions ad) (snd $ drawDimensions ad))
+    (uncurry (G.GeglRectangle 0 0) (drawDimensions ad))
   maybe (return()) (\realRect -> do
-    let surf = drawSurface ad
     liftIO $ clearArea requestBuffer realRect
-    liftIO $ SDL.lockSurface surf
+    putToSurface pixels realRect stride cpp dr
-    liftIO $ G.gegl_buffer_get
-      requestBuffer
-      (Just realRect)
-      1
-      (Just $ drawFormat ad)
-      (pixels `plusPtr`
-        (rectangleX realRect * cpp + rectangleY realRect * stride))
-      stride
-      G.GeglAbyssNone
-    liftIO $ SDL.unlockSurface surf
     ) mrealRect
   case requestPersist of
     Kill (Just victim) ->
@@ -177,7 +155,7 @@ colorize (rr, rg, rb, ra) col =
         G.RGB  r g b   -> (r, g, b)
       ca = case col of
         G.RGBA _ _ _ a -> a
-        G.RGB  _ _ _   -> 1
+        G.RGB{}        -> 1
       alpha = ca
       dst_a = ba
       da = alpha + dst_a * (1 - alpha)
@@ -189,7 +167,7 @@ colorize (rr, rg, rb, ra) col =
     ( G.CVdouble $ CDouble $ red / da
     , G.CVdouble $ CDouble $ gre / da
     , G.CVdouble $ CDouble $ blu / da
-    , G.CVdouble $ CDouble $ ca
+    , G.CVdouble $ CDouble ca
     )
 
 unsafeColorize col =
@@ -199,12 +177,12 @@ unsafeColorize col =
       G.RGB  cr cg cb   -> (cr, cg, cb)
     a = case col of
       G.RGBA _ _ _ ca -> ca
-      G.RGB  _ _ _    -> 1
+      G.RGB{}         -> 1
   in
-    ( G.CVdouble $ CDouble $ r
+    ( G.CVdouble $ CDouble r
-    , G.CVdouble $ CDouble $ g
+    , G.CVdouble $ CDouble g
-    , G.CVdouble $ CDouble $ b
+    , G.CVdouble $ CDouble b
-    , G.CVdouble $ CDouble $ a
+    , G.CVdouble $ CDouble a
     )
 
 -- | Clear a specified area of a buffer from all data

src/Affection/Property.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
 module Affection.Property 
-  ( Props(..)
+  ( Props
   , prop
   , props
   ) where
@@ -20,7 +20,7 @@ props = flip execState []
 prop :: IsPropertyValue v => String -> v -> Props ()
 prop k v = do
   ps <- get
-  put $ (G.Property k (toPropertyValue v)) : ps
+  put $ G.Property k (toPropertyValue v) : ps
 
 class IsPropertyValue v where
   toPropertyValue :: v -> G.PropertyValue