nek0/affection
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

working on drawing primitives

Browse source
This commit is contained in:
nek0 2016-12-08 18:22:29 +01:00
parent 334dba9e48
commit 4e20d26c97
6 changed files with 137 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
affection.cabal
View file

@ -33,7 +33,7 @@ flag examples
library
exposed-modules: Affection
-- , Affection.Render
, Affection.Draw
, Affection.Types
default-extensions: OverloadedStrings
@ -56,6 +56,7 @@ library
, linear
, mtl
, gegl
, babl
, monad-loops
, clock
-- , sdl2-image

4
examples/example00.hs
View file

@ -71,7 +71,7 @@ load _ = do
, elapsedTime = 0
}
draw :: AffectionState (AffectionData UserData) IO ()
draw :: Affection UserData ()
draw = do
traceM "drawing"
AffectionData{..} <- get
@ -95,7 +95,7 @@ draw = do
liftIO $ SDL.unlockSurface drawSurface
liftIO $ SDL.updateWindowSurface drawWindow
update :: Double -> AffectionState (AffectionData UserData) IO ()
update :: Double -> Affection UserData ()
update sec = do
traceM "updating"
-- liftIO $ delaySec 5

79
examples/example01.hs
View file

@ -67,44 +67,44 @@ load _ = do
, ("foreground" , bufsrc)
]
let roi = G.GeglRectangle 0 0 20 20
G.iterateOver
buffer
roi
(B.PixelFormat B.RGBA B.CFfloat)
G.GeglAccessReadWrite
G.GeglAbyssNone
(\(G.Pixel px py pc) ->
let dsqr = (((10 - px) ^ 2) + ((10 - py) ^ 2))
(G.CVfloat (CFloat pr), G.CVfloat (CFloat pg), G.CVfloat (CFloat pb), G.CVfloat (CFloat pa)) = pc
dist = (sqrt (fromIntegral dsqr :: Float))
in if dsqr < 100
then
if dist < fromIntegral 9
then
G.Pixel px py
( G.CVfloat $ CFloat 0
, G.CVfloat $ CFloat 0
, G.CVfloat $ CFloat 0
, G.CVfloat $ CFloat $ if pa < 1 then 1 else pa
)
else
let alpha = fromIntegral 10 - dist
dst_a = pa
a = alpha + dst_a * (1 - alpha)
a_term = dst_a * (1 - alpha)
red = 0 * alpha + pr * a_term
gre = 0 * alpha + pg * a_term
blu = 0 * alpha + pb * a_term
in
G.Pixel px py
( G.CVfloat $ CFloat $ red / a
, G.CVfloat $ CFloat $ gre / a
, G.CVfloat $ CFloat $ blu / a
, G.CVfloat $ CFloat $ if pa < alpha then alpha else pa
)
else
G.Pixel px py pc
)
-- G.iterateOver
-- buffer
-- roi
-- (B.PixelFormat B.RGBA B.CFfloat)
-- G.GeglAccessReadWrite
-- G.GeglAbyssNone
-- (\(G.Pixel px py pc) ->
-- let dsqr = (((10 - px) ^ 2) + ((10 - py) ^ 2))
-- (G.CVfloat (CFloat pr), G.CVfloat (CFloat pg), G.CVfloat (CFloat pb), G.CVfloat (CFloat pa)) = pc
-- dist = (sqrt (fromIntegral dsqr :: Float))
-- in if dsqr < 100
-- then
-- if dist < fromIntegral 9
-- then
-- G.Pixel px py
-- ( G.CVfloat $ CFloat 0
-- , G.CVfloat $ CFloat 0
-- , G.CVfloat $ CFloat 0
-- , G.CVfloat $ CFloat $ if pa < 1 then 1 else pa
-- )
-- else
-- let alpha = fromIntegral 10 - dist
-- dst_a = pa
-- a = alpha + dst_a * (1 - alpha)
-- a_term = dst_a * (1 - alpha)
-- red = 0 * alpha + pr * a_term
-- gre = 0 * alpha + pg * a_term
-- blu = 0 * alpha + pb * a_term
-- in
-- G.Pixel px py
-- ( G.CVfloat $ CFloat $ red / a
-- , G.CVfloat $ CFloat $ gre / a
-- , G.CVfloat $ CFloat $ blu / a
-- , G.CVfloat $ CFloat $ if pa < alpha then alpha else pa
-- )
-- else
-- G.Pixel px py pc
-- )
traceM "loading complete"
return $ UserData
{ nodeGraph = myMap
@ -112,7 +112,7 @@ load _ = do
, elapsedTime = 0
}
draw :: AffectionState (AffectionData UserData) IO ()
draw :: Affection UserData ()
draw = do
traceM "drawing"
AffectionData{..} <- get
@ -125,6 +125,7 @@ draw = do
format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8)
SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
let (w, h) = (fromIntegral rw, fromIntegral rh)
drawRect foreground (G.RGB 1 0 0) (Line 2) (G.GeglRectangle 5 5 200 200)
liftIO $ G.gegl_node_blit
(nodeGraph M.! "over" :: G.GeglNode)
1

10
src/Affection.hs
View file

@ -6,10 +6,11 @@ module Affection
, delaySec
, get
, put
, module Types
, module A
) where
import qualified SDL
import qualified SDL.Internal.Numbered as SDL (toNumber)
import qualified SDL.Raw as Raw
import qualified GEGL as G
@ -22,7 +23,8 @@ import Control.Monad.Loops
import Control.Monad.State
import Control.Concurrent.MVar
import Affection.Types as Types
import Affection.Types as A
import Affection.Draw as A
-- | Main function which bootstraps everything else.
withAffection
@ -46,10 +48,10 @@ withAffection AffectionConfig{..} = do
, drawWindow = window
, drawSurface = surface
}) =<< loadState surface
(_, nState) <- runStateT ( Types.runState $
(_, nState) <- runStateT ( A.runState $
whileM_ (do
current <- get
return $ not $ Types.quitEvent current
return $ not $ A.quitEvent current
)
(do
now <- liftIO $ getTime Monotonic

71
src/Affection/Draw.hs Normal file
View file

@ -0,0 +1,71 @@
{-# 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
-> Affection a ()
drawRect buf color dt rect@G.GeglRectangle{..} =
liftIO $ G.iterateOver buf rect (B.PixelFormat B.RGBA B.CFdouble) G.GeglAccessReadWrite G.GeglAbyssNone $
(\(G.Pixel px py pc) ->
case dt of
Fill ->
let col = colorize pc color
in
G.Pixel px py col
Line width ->
if (px >= rectangleX && px <= (rectangleX + width) ||
px <= (rectangleX + rectangleWidth) && px >= (rectangleX + rectangleWidth - width)) &&
(py >= rectangleY && py <= (rectangleY + width) ||
py <= (rectangleY + rectangleHeight) && py >= (rectangleY + rectangleHeight - width))
then
let col = colorize pc color
in G.Pixel px py col
else
G.Pixel px py pc
)
-- | 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
)

17
src/Affection/Types.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Affection.Types
( AffectionData(..)
( Affection
, AffectionData(..)
, AffectionConfig(..)
, AffectionState(..)
-- , AffectionDraw(..)
@ -10,15 +11,20 @@ module Affection.Types
, InitComponents(..)
-- , Loop(..)
, RGBA(..)
, DrawType(..)
, SDL.WindowConfig(..)
, SDL.defaultWindow
-- | Convenience exports
, liftIO
-- | GEGL reexports
, G.GeglRectangle(..)
, G.GeglBuffer(..)
) where
import qualified SDL.Init as SDL
import qualified SDL.Video as SDL
import qualified Data.Text as T
import qualified GEGL as G
import Control.Monad.IO.Class
import Control.Monad.State
@ -71,6 +77,8 @@ newtype AffectionState us m a = AffectionState
{ runState :: AffectionStateInner us m a }
deriving (Functor, Applicative, Monad, MonadIO, MonadState us)
type Affection us a = AffectionState (AffectionData us) IO a
-- -- | Inner 'StateT' monad of Affection
-- type AffectionInner us od a = StateT (AffectionState us od) IO a
--
@ -98,3 +106,10 @@ data RGBA = RGBA
, b :: Int
, a :: Int
}
-- | Type for defining the draw type of draw functions
data DrawType
= Fill -- ^ Fill the specified area completely with color
| Line -- ^ only draw the outline of the area
{ lineWidth :: Int -- ^ Width of line in pixels
}