Copyright | (c) 2011-2015 diagrams-lib team (see LICENSE) |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | diagrams-discuss@googlegroups.com |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Diagrams may have attributes which affect the way they are rendered. This module defines some common attributes; particular backends may also define more backend-specific attributes.
Every attribute type must have a semigroup structure, that is, an
associative binary operation for combining two attributes into one.
Unless otherwise noted, all the attributes defined here use the
Last
structure, that is, combining two attributes simply keeps
the second one and throws away the first. This means that child
attributes always override parent attributes.
Synopsis
- ultraThin :: OrderedField n => Measure n
- veryThin :: OrderedField n => Measure n
- thin :: OrderedField n => Measure n
- medium :: OrderedField n => Measure n
- thick :: OrderedField n => Measure n
- veryThick :: OrderedField n => Measure n
- ultraThick :: OrderedField n => Measure n
- none :: OrderedField n => Measure n
- tiny :: OrderedField n => Measure n
- verySmall :: OrderedField n => Measure n
- small :: OrderedField n => Measure n
- normal :: OrderedField n => Measure n
- large :: OrderedField n => Measure n
- veryLarge :: OrderedField n => Measure n
- huge :: OrderedField n => Measure n
- data LineWidth n
- getLineWidth :: LineWidth n -> n
- _LineWidth :: Iso' (LineWidth n) n
- _LineWidthM :: Iso' (LineWidthM n) (Measure n)
- lineWidth :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a
- lineWidthM :: (N a ~ n, HasStyle a, Typeable n) => LineWidthM n -> a -> a
- _lineWidth :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)
- _lw :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)
- _lineWidthU :: Typeable n => Lens' (Style v n) (Maybe n)
- lw :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a
- lwN :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
- lwO :: (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
- lwL :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
- lwG :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
- data Dashing n = Dashing [n] n
- getDashing :: Dashing n -> Dashing n
- dashing :: (N a ~ n, HasStyle a, Typeable n) => [Measure n] -> Measure n -> a -> a
- dashingN :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
- dashingO :: (N a ~ n, HasStyle a, Typeable n) => [n] -> n -> a -> a
- dashingL :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
- dashingG :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a
- _dashing :: Typeable n => Lens' (Style v n) (Maybe (Measured n (Dashing n)))
- _dashingU :: Typeable n => Lens' (Style v n) (Maybe (Dashing n))
- class Color c where
- toAlphaColour :: c -> AlphaColour Double
- fromAlphaColour :: AlphaColour Double -> c
- data SomeColor = forall c.Color c => SomeColor c
- _SomeColor :: Iso' SomeColor (AlphaColour Double)
- someToAlpha :: SomeColor -> AlphaColour Double
- data Opacity
- _Opacity :: Iso' Opacity Double
- getOpacity :: Opacity -> Double
- opacity :: HasStyle a => Double -> a -> a
- _opacity :: Lens' (Style v n) Double
- data FillOpacity
- _FillOpacity :: Iso' FillOpacity Double
- getFillOpacity :: FillOpacity -> Double
- fillOpacity :: HasStyle a => Double -> a -> a
- _fillOpacity :: Lens' (Style v n) Double
- data StrokeOpacity
- _StrokeOpacity :: Iso' StrokeOpacity Double
- getStrokeOpacity :: StrokeOpacity -> Double
- strokeOpacity :: HasStyle a => Double -> a -> a
- _strokeOpacity :: Lens' (Style v n) Double
- colorToSRGBA :: Color c => c -> (Double, Double, Double, Double)
- colorToRGBA :: Color c => c -> (Double, Double, Double, Double)
- data LineCap
- getLineCap :: LineCap -> LineCap
- lineCap :: HasStyle a => LineCap -> a -> a
- _lineCap :: Lens' (Style v n) LineCap
- data LineJoin
- getLineJoin :: LineJoin -> LineJoin
- lineJoin :: HasStyle a => LineJoin -> a -> a
- _lineJoin :: Lens' (Style v n) LineJoin
- newtype LineMiterLimit = LineMiterLimit (Last Double)
- _LineMiterLimit :: Iso' LineMiterLimit Double
- getLineMiterLimit :: LineMiterLimit -> Double
- lineMiterLimit :: HasStyle a => Double -> a -> a
- lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a
- _lineMiterLimit :: Lens' (Style v n) Double
- _Recommend :: Prism' (Recommend a) a
- _Commit :: Prism' (Recommend a) a
- _recommend :: Lens (Recommend a) (Recommend b) a b
- isCommitted :: Lens' (Recommend a) Bool
- committed :: Iso (Recommend a) (Recommend b) a b
Standard measures
ultraThin :: OrderedField n => Measure n Source #
veryThin :: OrderedField n => Measure n Source #
thin :: OrderedField n => Measure n Source #
medium :: OrderedField n => Measure n Source #
thick :: OrderedField n => Measure n Source #
veryThick :: OrderedField n => Measure n Source #
ultraThick :: OrderedField n => Measure n Source #
none :: OrderedField n => Measure n Source #
tiny :: OrderedField n => Measure n Source #
verySmall :: OrderedField n => Measure n Source #
small :: OrderedField n => Measure n Source #
normal :: OrderedField n => Measure n Source #
large :: OrderedField n => Measure n Source #
veryLarge :: OrderedField n => Measure n Source #
huge :: OrderedField n => Measure n Source #
Line width
Line widths specified on child nodes always override line widths specified at parent nodes.
Instances
Semigroup (LineWidth n) Source # | |
Typeable n => AttributeClass (LineWidth n) Source # | |
Defined in Diagrams.Attributes |
getLineWidth :: LineWidth n -> n Source #
_LineWidth :: Iso' (LineWidth n) n Source #
_LineWidthM :: Iso' (LineWidthM n) (Measure n) Source #
lineWidth :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a Source #
Set the line (stroke) width.
lineWidthM :: (N a ~ n, HasStyle a, Typeable n) => LineWidthM n -> a -> a Source #
Apply a LineWidth
attribute.
_lineWidth :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n) Source #
Lens onto a measured line width in a style.
_lw :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n) Source #
Lens onto a measured line width in a style.
_lineWidthU :: Typeable n => Lens' (Style v n) (Maybe n) Source #
Lens onto the unmeasured linewith attribute. This is useful for backends to use on styles once they have been unmeasured. Using on a diagram style could lead to unexpected results.
lwN :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a Source #
A convenient synonym for 'lineWidth (normalized w)'.
lwO :: (N a ~ n, HasStyle a, Typeable n) => n -> a -> a Source #
A convenient synonym for 'lineWidth (output w)'.
lwL :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a Source #
A convenient sysnonym for 'lineWidth (local w)'.
lwG :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a Source #
A convenient synonym for 'lineWidth (global w)'.
Dashing
Create lines that are dashing... er, dashed.
Dashing [n] n |
getDashing :: Dashing n -> Dashing n Source #
:: (N a ~ n, HasStyle a, Typeable n) | |
=> [Measure n] | A list specifying alternate lengths of on and off portions of the stroke. The empty list indicates no dashing. |
-> Measure n | An offset into the dash pattern at which the stroke should start. |
-> a | |
-> a |
Set the line dashing style.
dashingN :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a Source #
A convenient synonym for 'dashing (normalized w)'.
dashingO :: (N a ~ n, HasStyle a, Typeable n) => [n] -> n -> a -> a Source #
A convenient synonym for 'dashing (output w)'.
dashingL :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a Source #
A convenient sysnonym for 'dashing (local w)'.
dashingG :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a Source #
A convenient synonym for 'dashing (global w)'.
_dashing :: Typeable n => Lens' (Style v n) (Maybe (Measured n (Dashing n))) Source #
Lens onto a measured dashing attribute in a style.
_dashingU :: Typeable n => Lens' (Style v n) (Maybe (Dashing n)) Source #
Lens onto the unmeasured Dashing
attribute. This is useful for
backends to use on styles once they have been unmeasured. Using on
a diagram style could lead to unexpected results.
Color
Diagrams outsources all things color-related to Russell O'Connor's very nice colour package (http://hackage.haskell.org/package/colour). For starters, it provides a large collection of standard color names. However, it also provides a rich set of combinators for combining and manipulating colors; see its documentation for more information.
The Color
type class encompasses color representations which
can be used by the Diagrams library. Instances are provided for
both the Colour
and AlphaColour
types
from the Data.Colour library.
toAlphaColour :: c -> AlphaColour Double Source #
Convert a color to its standard representation, AlphaColour.
fromAlphaColour :: AlphaColour Double -> c Source #
Convert from an AlphaColour Double. Note that this direction
may lose some information. For example, the instance for
Colour
drops the alpha channel.
Instances
Color SomeColor Source # | |
Defined in Diagrams.Attributes | |
a ~ Double => Color (AlphaColour a) Source # | |
Defined in Diagrams.Attributes toAlphaColour :: AlphaColour a -> AlphaColour Double Source # fromAlphaColour :: AlphaColour Double -> AlphaColour a Source # | |
a ~ Double => Color (Colour a) Source # | |
Defined in Diagrams.Attributes toAlphaColour :: Colour a -> AlphaColour Double Source # fromAlphaColour :: AlphaColour Double -> Colour a Source # |
An existential wrapper for instances of the Color
class.
_SomeColor :: Iso' SomeColor (AlphaColour Double) Source #
Isomorphism between SomeColor
and AlphaColour
Double
.
someToAlpha :: SomeColor -> AlphaColour Double Source #
Opacity
Although the individual colors in a diagram can have
transparency, the opacity/transparency of a diagram as a whole
can be specified with the Opacity
attribute. The opacity is a
value between 1 (completely opaque, the default) and 0
(completely transparent). Opacity is multiplicative, that is,
. In other
words, for example, opacity
o1 . opacity
o2 === opacity
(o1 * o2)opacity 0.8
means "decrease this diagram's
opacity to 80% of its previous opacity".
getOpacity :: Opacity -> Double Source #
opacity :: HasStyle a => Double -> a -> a Source #
Multiply the opacity (see Opacity
) by the given value. For
example, opacity 0.8
means "decrease this diagram's opacity to
80% of its previous opacity".
data FillOpacity Source #
Like Opacity
, but set the opacity only for fills (as opposed to strokes).
As with Opacity
, the fill opacity is a value between 1
(completely opaque, the default) and 0 (completely transparent),
and is multiplicative.
Instances
Semigroup FillOpacity Source # | |
Defined in Diagrams.Attributes (<>) :: FillOpacity -> FillOpacity -> FillOpacity # sconcat :: NonEmpty FillOpacity -> FillOpacity # stimes :: Integral b => b -> FillOpacity -> FillOpacity # | |
AttributeClass FillOpacity Source # | |
Defined in Diagrams.Attributes |
getFillOpacity :: FillOpacity -> Double Source #
fillOpacity :: HasStyle a => Double -> a -> a Source #
Multiply the fill opacity (see FillOpacity
) by the given value. For
example, fillOpacity 0.8
means "decrease this diagram's fill opacity to
80% of its previous value".
data StrokeOpacity Source #
Like Opacity
, but set the opacity only for strokes (as opposed to fills).
As with Opacity
, the fill opacity is a value between 1
(completely opaque, the default) and 0 (completely transparent),
and is multiplicative.
Instances
Semigroup StrokeOpacity Source # | |
Defined in Diagrams.Attributes (<>) :: StrokeOpacity -> StrokeOpacity -> StrokeOpacity # sconcat :: NonEmpty StrokeOpacity -> StrokeOpacity # stimes :: Integral b => b -> StrokeOpacity -> StrokeOpacity # | |
AttributeClass StrokeOpacity Source # | |
Defined in Diagrams.Attributes |
strokeOpacity :: HasStyle a => Double -> a -> a Source #
Multiply the stroke opacity (see StrokeOpacity
) by the given value. For
example, strokeOpacity 0.8
means "decrease this diagram's
stroke opacity to 80% of its previous value".
Converting colors
colorToRGBA :: Color c => c -> (Double, Double, Double, Double) Source #
Deprecated: Renamed to colorToSRGBA.
Convert to sRGBA.
Line stuff
Cap style
What sort of shape should be placed at the endpoints of lines?
LineCapButt | Lines end precisely at their endpoints. |
LineCapRound | Lines are capped with semicircles centered on endpoints. |
LineCapSquare | Lines are capped with a squares centered on endpoints. |
getLineCap :: LineCap -> LineCap Source #
Join style
How should the join points between line segments be drawn?
LineJoinMiter | Use a "miter" shape (whatever that is). |
LineJoinRound | Use rounded join points. |
LineJoinBevel | Use a "bevel" shape (whatever that is). Are these... carpentry terms? |
getLineJoin :: LineJoin -> LineJoin Source #
Miter limit
newtype LineMiterLimit Source #
Miter limit attribute affecting the LineJoinMiter
joins.
For some backends this value may have additional effects.
Instances
Semigroup LineMiterLimit Source # | |
Defined in Diagrams.Attributes (<>) :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit # sconcat :: NonEmpty LineMiterLimit -> LineMiterLimit # stimes :: Integral b => b -> LineMiterLimit -> LineMiterLimit # | |
Default LineMiterLimit Source # | |
Defined in Diagrams.Attributes def :: LineMiterLimit # | |
AttributeClass LineMiterLimit Source # | |
Defined in Diagrams.Attributes | |
Eq LineMiterLimit Source # | |
Defined in Diagrams.Attributes (==) :: LineMiterLimit -> LineMiterLimit -> Bool # (/=) :: LineMiterLimit -> LineMiterLimit -> Bool # | |
Ord LineMiterLimit Source # | |
Defined in Diagrams.Attributes compare :: LineMiterLimit -> LineMiterLimit -> Ordering # (<) :: LineMiterLimit -> LineMiterLimit -> Bool # (<=) :: LineMiterLimit -> LineMiterLimit -> Bool # (>) :: LineMiterLimit -> LineMiterLimit -> Bool # (>=) :: LineMiterLimit -> LineMiterLimit -> Bool # max :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit # min :: LineMiterLimit -> LineMiterLimit -> LineMiterLimit # |
lineMiterLimit :: HasStyle a => Double -> a -> a Source #
Set the miter limit for joins with LineJoinMiter
.
lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a Source #
Apply a LineMiterLimit
attribute.
Recommend optics
committed :: Iso (Recommend a) (Recommend b) a b Source #
Commit
a value for any Recommend
. This is *not* a valid ReifiedIso
because the resulting Recommend b
is always a Commit
. This is
useful because it means any Recommend
styles set with a lens will
not be accidentally overridden. If you want a valid lens onto a
recommend value use _recommend
.
Other lenses that use this are labeled with a warning.