Copyright | (c) 2013 diagrams-lib team (see LICENSE) |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | diagrams-discuss@googlegroups.com |
Safe Haskell | None |
Language | Haskell2010 |
Diagrams may have attributes which affect the way they are
rendered. This module defines Textures (Gradients and Colors) in two
dimensions. Like the attriubtes defined in the Diagrams.Attributes module,
all attributes defined here use the Last
or Recommend
semigroup structure.
FillColor
and LineColor
attributes are provided so that backends that
don't support gradients need not be concerned with using textures. Backends
should only implement color attributes or textures attributes, not both.
- data LineWidth
- getLineWidth :: LineWidth -> Measure R2
- lineWidth :: (HasStyle a, V a ~ R2) => Measure R2 -> a -> a
- lineWidthA :: (HasStyle a, V a ~ R2) => LineWidth -> a -> a
- lw :: (HasStyle a, V a ~ R2) => Measure R2 -> a -> a
- lwN :: (HasStyle a, V a ~ R2) => Double -> a -> a
- lwO :: (HasStyle a, V a ~ R2) => Double -> a -> a
- lwL :: (HasStyle a, V a ~ R2) => Double -> a -> a
- lwG :: (HasStyle a, V a ~ R2) => Double -> a -> a
- ultraThin :: Measure R2
- veryThin :: Measure R2
- thin :: Measure R2
- medium :: Measure R2
- thick :: Measure R2
- veryThick :: Measure R2
- ultraThick :: Measure R2
- none :: Measure R2
- tiny :: Measure R2
- verySmall :: Measure R2
- small :: Measure R2
- normal :: Measure R2
- large :: Measure R2
- veryLarge :: Measure R2
- huge :: Measure R2
- data Dashing = Dashing [Measure R2] (Measure R2)
- data DashingA
- getDashing :: DashingA -> Dashing
- dashing :: (HasStyle a, V a ~ R2) => [Measure R2] -> Measure R2 -> a -> a
- dashingN :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a
- dashingO :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a
- dashingL :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a
- dashingG :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a
- data Texture
- solid :: Color a => a -> Texture
- _SC :: Prism' Texture SomeColor
- _LG :: Prism' Texture LGradient
- _RG :: Prism' Texture RGradient
- defaultLG :: Texture
- defaultRG :: Texture
- data GradientStop = GradientStop {}
- stopColor :: Lens' GradientStop SomeColor
- stopFraction :: Lens' GradientStop Double
- mkStops :: [(Colour Double, Double, Double)] -> [GradientStop]
- data SpreadMethod
- lineLGradient :: (HasStyle a, V a ~ R2) => LGradient -> a -> a
- lineRGradient :: (HasStyle a, V a ~ R2) => RGradient -> a -> a
- data LGradient = LGradient {}
- lGradStops :: Lens' LGradient [GradientStop]
- lGradTrans :: Lens' LGradient T2
- lGradStart :: Lens' LGradient P2
- lGradEnd :: Lens' LGradient P2
- lGradSpreadMethod :: Lens' LGradient SpreadMethod
- mkLinearGradient :: [GradientStop] -> P2 -> P2 -> SpreadMethod -> Texture
- data RGradient = RGradient {}
- rGradStops :: Lens' RGradient [GradientStop]
- rGradTrans :: Lens' RGradient T2
- rGradCenter0 :: Lens' RGradient P2
- rGradRadius0 :: Lens' RGradient Double
- rGradCenter1 :: Lens' RGradient P2
- rGradRadius1 :: Lens' RGradient Double
- rGradSpreadMethod :: Lens' RGradient SpreadMethod
- mkRadialGradient :: [GradientStop] -> P2 -> Double -> P2 -> Double -> SpreadMethod -> Texture
- newtype LineTexture = LineTexture (Last Texture)
- getLineTexture :: LineTexture -> Texture
- lineTexture :: (HasStyle a, V a ~ R2) => Texture -> a -> a
- lineTextureA :: (HasStyle a, V a ~ R2) => LineTexture -> a -> a
- mkLineTexture :: Texture -> LineTexture
- styleLineTexture :: Setter' (Style v) Texture
- lineColor :: (Color c, HasStyle a, V a ~ R2) => c -> a -> a
- lc :: (HasStyle a, V a ~ R2) => Colour Double -> a -> a
- lcA :: (HasStyle a, V a ~ R2) => AlphaColour Double -> a -> a
- newtype FillTexture = FillTexture (Recommend (Last Texture))
- getFillTexture :: FillTexture -> Texture
- fillTexture :: (HasStyle a, V a ~ R2) => Texture -> a -> a
- mkFillTexture :: Texture -> FillTexture
- styleFillTexture :: Setter' (Style v) Texture
- fillColor :: (Color c, HasStyle a, V a ~ R2) => c -> a -> a
- fc :: (HasStyle a, V a ~ R2) => Colour Double -> a -> a
- fcA :: (HasStyle a, V a ~ R2) => AlphaColour Double -> a -> a
- recommendFillColor :: (Color c, HasStyle a, V a ~ R2) => c -> a -> a
- splitTextureFills :: forall b v a. Typeable v => RTree b v a -> RTree b v a
Width
Line widths specified on child nodes always override line widths specified at parent nodes.
getLineWidth :: LineWidth -> Measure R2 Source
lwN :: (HasStyle a, V a ~ R2) => Double -> a -> a Source
A convenient synonym for 'lineWidth (Normalized w)'.
lwO :: (HasStyle a, V a ~ R2) => Double -> a -> a Source
A convenient synonym for 'lineWidth (Output w)'.
lwL :: (HasStyle a, V a ~ R2) => Double -> a -> a Source
A convenient sysnonym for 'lineWidth (Local w)'.
lwG :: (HasStyle a, V a ~ R2) => Double -> a -> a Source
A convenient synonym for 'lineWidth (Global w)'.
ultraThick :: Measure R2 Source
Standard Measures
.
Dashing
Create lines that are dashing... er, dashed.
getDashing :: DashingA -> Dashing Source
:: (HasStyle a, V a ~ R2) | |
=> [Measure R2] | A list specifying alternate lengths of on and off portions of the stroke. The empty list indicates no dashing. |
-> Measure R2 | An offset into the dash pattern at which the stroke should start. |
-> a | |
-> a |
Set the line dashing style.
dashingN :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a Source
A convenient synonym for 'dashing (Normalized w)'.
dashingO :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a Source
A convenient synonym for 'dashing (Output w)'.
dashingL :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a Source
A convenient sysnonym for 'dashing (Local w)'.
dashingG :: (HasStyle a, V a ~ R2) => [Double] -> Double -> a -> a Source
A convenient synonym for 'dashing (Global w)'.
Textures
A default is provided so that linear gradients can easily be created using
lenses. For example, lg = defaultLG & lGradStart .~ (0.25 ^& 0.33)
. Note that
no default value is provided for lGradStops
, this must be set before
the gradient value is used, otherwise the object will appear transparent.
A default is provided so that radial gradients can easily be created using
lenses. For example, rg = defaultRG & rGradRadius1 .~ 0.25
. Note that
no default value is provided for rGradStops
, this must be set before
the gradient value is used, otherwise the object will appear transparent.
data GradientStop Source
A gradient stop contains a color and fraction (usually between 0 and 1)
stopColor :: Lens' GradientStop SomeColor Source
A color for the stop.
stopFraction :: Lens' GradientStop Double Source
The fraction for stop.
mkStops :: [(Colour Double, Double, Double)] -> [GradientStop] Source
A convenient function for making gradient stops from a list of triples. (An opaque color, a stop fraction, an opacity).
data SpreadMethod Source
The SpreadMethod
determines what happens before lGradStart
and after
lGradEnd
. GradPad
fills the space before the start of the gradient
with the color of the first stop and the color after end of the gradient
with the color of the last stop. GradRepeat
restarts the gradient and
GradReflect
restarts the gradient with the stops in reverse order.
Linear Gradients
Linear Gradient
LGradient | |
|
lGradStops :: Lens' LGradient [GradientStop] Source
A list of stops (colors and fractions).
lGradTrans :: Lens' LGradient T2 Source
A transformation to be applied to the gradient. Usually this field will start as the identity transform and capture the transforms that are applied to the gradient.
lGradStart :: Lens' LGradient P2 Source
The starting point for the first gradient stop. The coordinates are in
Local
units and the default is (-0.5, 0).
lGradEnd :: Lens' LGradient P2 Source
The ending point for the last gradient stop.The coordinates are in
Local
units and the default is (0.5, 0).
lGradSpreadMethod :: Lens' LGradient SpreadMethod Source
For setting the spread method.
mkLinearGradient :: [GradientStop] -> P2 -> P2 -> SpreadMethod -> Texture Source
Make a linear gradient texture from a stop list, start point, end point,
and SpreadMethod
. The lGradTrans
field is set to the identity
transfrom, to change it use the lGradTrans
lens.
Radial Gradients
Radial Gradient
RGradient | |
|
rGradStops :: Lens' RGradient [GradientStop] Source
A list of stops (colors and fractions).
rGradTrans :: Lens' RGradient T2 Source
A transformation to be applied to the gradient. Usually this field will start as the identity transform and capture the transforms that are applied to the gradient.
rGradCenter0 :: Lens' RGradient P2 Source
The center point of the inner circle.
rGradCenter1 :: Lens' RGradient P2 Source
The center of the outer circle.
rGradSpreadMethod :: Lens' RGradient SpreadMethod Source
For setting the spread method.
mkRadialGradient :: [GradientStop] -> P2 -> Double -> P2 -> Double -> SpreadMethod -> Texture Source
Make a radial gradient texture from a stop list, radius, start point,
end point, and SpreadMethod
. The rGradTrans
field is set to the identity
transfrom, to change it use the rGradTrans
lens.
Line texture
newtype LineTexture Source
The texture with which lines are drawn. Note that child
textures always override parent textures.
More precisely, the semigroup structure on line texture attributes
is that of Last
.
lineTextureA :: (HasStyle a, V a ~ R2) => LineTexture -> a -> a Source
styleLineTexture :: Setter' (Style v) Texture Source
Line color
lineColor :: (Color c, HasStyle a, V a ~ R2) => c -> a -> a Source
Set the line (stroke) color. This function is polymorphic in the
color type (so it can be used with either Colour
or
AlphaColour
), but this can sometimes create problems for type
inference, so the lc
and lcA
variants are provided with more
concrete types.
lcA :: (HasStyle a, V a ~ R2) => AlphaColour Double -> a -> a Source
A synonym for lineColor
, specialized to
(i.e. colors with transparency). See comment in AlphaColour
DoublelineColor
about backends.
Fill texture
newtype FillTexture Source
The texture with which objects are filled. The semigroup structure on fill texture attributes is that of 'Recommed . Last'.
styleFillTexture :: Setter' (Style v) Texture Source
Fill color
fillColor :: (Color c, HasStyle a, V a ~ R2) => c -> a -> a Source
Set the fill color. This function is polymorphic in the color
type (so it can be used with either Colour
or AlphaColour
),
but this can sometimes create problems for type inference, so the
fc
and fcA
variants are provided with more concrete types.
fcA :: (HasStyle a, V a ~ R2) => AlphaColour Double -> a -> a Source
A synonym for fillColor
, specialized to
(i.e. colors with transparency). See comment after AlphaColour
DoublefillColor
about backends.
Compilation utilities
splitTextureFills :: forall b v a. Typeable v => RTree b v a -> RTree b v a Source
Push fill attributes down until they are at the root of subtrees containing only loops. This makes life much easier for backends, which typically have a semantics where fill attributes are applied to linesnon-closed paths as well as loopsclosed paths, whereas in the semantics of diagrams, fill attributes only apply to loops.