diff --git a/src/Diagrams/Backend/Canvas.hs b/src/Diagrams/Backend/Canvas.hs index 1365ff2..d4a898d 100644 --- a/src/Diagrams/Backend/Canvas.hs +++ b/src/Diagrams/Backend/Canvas.hs @@ -61,6 +61,7 @@ canvasStyle s = foldr (>>) (return ()) , handle lWidth , handle lJoin , handle lCap + , handle opacity_ ] where handle :: (AttributeClass a) => (a -> C.Render ()) -> Maybe (C.Render ()) handle f = f `fmap` getAttr s @@ -69,6 +70,7 @@ canvasStyle s = foldr (>>) (return ()) lWidth = C.lineWidth . getLineWidth lCap = C.lineCap . getLineCap lJoin = C.lineJoin . getLineJoin + opacity_ = C.globalAlpha . getOpacity canvasTransf :: Transformation R2 -> C.Render () canvasTransf t = C.transform a1 a2 b1 b2 c1 c2 diff --git a/src/Graphics/Rendering/Canvas.hs b/src/Graphics/Rendering/Canvas.hs index 794750e..988f376 100644 --- a/src/Graphics/Rendering/Canvas.hs +++ b/src/Graphics/Rendering/Canvas.hs @@ -23,6 +23,7 @@ module Graphics.Rendering.Canvas , lineWidth , lineCap , lineJoin + , globalAlpha , withStyle ) where @@ -43,11 +44,12 @@ data DrawState = DS , dsCap :: LineCap , dsJoin :: LineJoin , dsWidth :: Float + , dsAlpha :: Float , dsTransform :: (Float,Float,Float,Float,Float,Float) } deriving (Eq) emptyDS :: DrawState -emptyDS = DS 0 (0,0,0,1) 0 LineCapButt LineJoinMiter 0 (1,0,0,1,0,0) +emptyDS = DS 0 (0,0,0,1) 0 LineCapButt LineJoinMiter 0 1 (1,0,0,1,0,0) data RenderState = RS { drawState :: DrawState @@ -202,6 +204,12 @@ fromLineJoin LineJoinRound = show "round" fromLineJoin LineJoinBevel = show "bevel" fromLineJoin _ = show "miter" +globalAlpha :: Double -> Render () +globalAlpha a = setDSWhen + (\ds -> ds { dsAlpha = a' }) + (canvas $ C.globalAlpha a') + where a' = realToFrac a + -- TODO: update the transform's state for translate, scale, and rotate translate :: Double -> Double -> Render () translate x y = canvas $ C.translate (realToFrac x,realToFrac y)