{-# LANGUAGE MultiWayIf #-} module Graphics.Curves.Style ( CurveAttribute(..) , Style , lineStyle, fillStyle, brushStyle , gradient, dashedOpen, dashedClosed, dashed ) where import Graphics.Curves.Math import Graphics.Curves.Image import Graphics.Curves.Colour import Graphics.Curves.Curve import Graphics.Curves.Attribute import Debug.Trace -- | A style is a list of attribute assignments. type Style = [Assignment Image] -- | Setting the line width, blur and colour. lineStyle :: Scalar -> Scalar -> Colour -> Style lineStyle w b c = [LineWidth := w, LineBlur := b, LineColour := c] -- | Setting the fill blur and colour. fillStyle :: Scalar -> Colour -> Style fillStyle b c = [FillColour := c, FillBlur := b] -- | Dynamic line width style that tapers off at the end points. First argument -- is maximum width and the second the length of the tapering off part. brushStyle :: Scalar -> Scalar -> Style brushStyle w d = [VarLineWidth := \x r _ -> let total = x/r in if | r == 0 -> 0 | x < d -> w * f (2 * x / d - 1) | x > total - d -> w * f (2 * (total - x) / d - 1) | otherwise -> w ] where f t = (1 + t + sin (pi * t) / pi) / 2 modDouble a b = a - b * fromIntegral (floor (a / b)) -- | Fade from the first to the second colour and then back. The third argument -- in the distance in pixels it takes to reach the second colour. gradient :: Colour -> Colour -> Scalar -> Style gradient c1 c2 a = [VarLineColour := \d _ _ -> case modDouble d (2 * a) of x | x <= a -> blend (setAlpha (x / a) c2) c1 | otherwise -> blend (setAlpha ((2 * a - x) / a) c2) c1 ] -- | A dashed line style. The first argument is the approximate length (in -- pixels) of the dashes and the second argument of the gaps. The lengths are -- adjusted to make the curve always end in a dash. dashedOpen :: Scalar -> Scalar -> Style dashedOpen a b = dashed a b ++ [VarLineColour :~ \old d r p -> if | r == 0 -> old d r p | otherwise -> let total = d/r n = round (total / (a + b)) k = total / (fromIntegral n * (a + b) + a) in old (d / k) r p ] -- | A dashed line style. The first argument is the approximate length (in -- pixels) of the dashes and the second argument of the gaps. The lengths are -- adjusted to make the curve always end in a gap so closed curves have a -- smooth transition where the end of the curve meets the start. dashedClosed :: Scalar -> Scalar -> Style dashedClosed a b = dashed a b ++ [VarLineColour :~ \old d r p -> if | r == 0 -> old d r p | otherwise -> let total = d/r n = round (total / (a + b)) k = total / (fromIntegral n * (a + b)) in old (d / k) r p ] -- | A dashed line style. The first argument is the lengths (in pixels) of the -- dashes and the second argument of the gaps. dashed :: Scalar -> Scalar -> Style dashed a b = [VarLineColour :~ \old d r p -> case modDouble d (a + b) of x | x <= a -> old d r p | otherwise -> transparent ]