{-# LANGUAGE RecordWildCards #-} -- | Module for drawing primitives module Affection.Draw ( drawRect ) where import Affection.Types (DrawType(..), Affection, GeglRectangle(..), liftIO) import Foreign.C.Types import qualified BABL as B import qualified GEGL as G -- | Draw a rectangle on target buffer drawRect :: G.GeglBuffer -- ^ Target buffer -> G.Color -- ^ Color to draw in -> DrawType -- ^ Draw type -> GeglRectangle -- ^ Dimensions of Rectangle -> IO () drawRect buf color (Fill) rect@G.GeglRectangle{..} = G.pixelPoke buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $ (\(x, y) -> let col = unsafeColorize color in G.Pixel x y col ) drawRect buf color (Line size) rect@G.GeglRectangle{..} = do drawRect buf color Fill (G.GeglRectangle rectangleX rectangleY rectangleWidth size) drawRect buf color Fill (G.GeglRectangle rectangleX rectangleY size rectangleHeight) drawRect buf color Fill (G.GeglRectangle (rectangleWidth - size) rectangleY size rectangleHeight) drawRect buf color Fill (G.GeglRectangle rectangleX (rectangleHeight - size) rectangleWidth size) -- | compute color for a single pixel colorize :: (G.ComponentValue, G.ComponentValue, G.ComponentValue, G.ComponentValue) -- ^ Pixel information in buffer -> G.Color -- ^ Color to draw over -> (G.ComponentValue, G.ComponentValue, G.ComponentValue, G.ComponentValue) -- ^ Resulting colour colorize (rr, rg, rb, ra) col = let (G.CVdouble (CDouble br)) = rr (G.CVdouble (CDouble bg)) = rg (G.CVdouble (CDouble bb)) = rb (G.CVdouble (CDouble ba)) = ra (cr, cg, cb) = case col of G.RGBA r g b _ -> (r, g, b) G.RGB r g b -> (r, g, b) ca = case col of G.RGBA _ _ _ a -> a G.RGB _ _ _ -> 1 alpha = ca dst_a = ba da = alpha + dst_a * (1 - alpha) a_term = dst_a * (1 - alpha) red = cr * alpha + br * a_term gre = cg * alpha + bg * a_term blu = cb * alpha + bb * a_term in ( G.CVdouble $ CDouble $ red / da , G.CVdouble $ CDouble $ gre / da , G.CVdouble $ CDouble $ blu / da , G.CVdouble $ CDouble $ ca ) unsafeColorize col = let (r, g, b) = case col of G.RGBA cr cg cb _ -> (cr, cg, cb) G.RGB cr cg cb -> (cr, cg, cb) a = case col of G.RGBA _ _ _ ca -> ca G.RGB _ _ _ -> 1 in ( G.CVdouble $ CDouble $ r , G.CVdouble $ CDouble $ g , G.CVdouble $ CDouble $ b , G.CVdouble $ CDouble $ a )