Copyright | (c) 2011 diagrams-lib team (see LICENSE) |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | diagrams-discuss@googlegroups.com |
Safe Haskell | None |
Language | Haskell2010 |
This module defines the two-dimensional vector space R^2, two-dimensional transformations, and various predefined two-dimensional shapes. This module re-exports useful functionality from a group of more specific modules:
- Diagrams.TwoD.Types defines basic types for two-dimensional diagrams, including types representing the 2D Euclidean vector space and various systems of angle measurement.
- Diagrams.TwoD.Align defines alignment combinators specialized to two dimensions (see Diagrams.Align for more general alignment).
- Diagrams.TwoD.Combinators defines ways of combining diagrams specialized to two dimensions (see also Diagrams.Combinators for more general combining).
- Diagrams.TwoD.Transform defines R^2-specific transformations such as rotation by an angle, and scaling, translation, and reflection in the X and Y directions.
- Diagrams.TwoD.Ellipse defines circles and ellipses.
- Diagrams.TwoD.Arc defines circular arcs.
- Diagrams.TwoD.Path exports various operations on two-dimensional paths when viewed as regions of the plane.
- Diagrams.TwoD.Polygons defines general algorithms for drawing various types of polygons.
- Diagrams.TwoD.Shapes defines other two-dimensional shapes, e.g. various polygons.
- Diagrams.TwoD.Arrow contains tools for drawing arrows between things.
- Diagrams.TwoD.Text defines primitive text diagrams.
- Diagrams.TwoD.Image allows importing external images into diagrams.
- Diagrams.TwoD.Vector defines some special 2D vectors and functions for converting between vectors and angles.
- Diagrams.TwoD.Size defines functions for working with the size of 2D objects.
- Diagrams.TwoD.Model defines some aids for visualizing diagrams' internal model (local origins, envelopes, etc.)
- data R2
- r2 :: (Double, Double) -> R2
- unr2 :: R2 -> (Double, Double)
- mkR2 :: Double -> Double -> R2
- type P2 = Point R2
- p2 :: (Double, Double) -> P2
- unp2 :: P2 -> (Double, Double)
- mkP2 :: Double -> Double -> P2
- type T2 = Transformation R2
- unitX :: R2
- unitY :: R2
- unit_X :: R2
- unit_Y :: R2
- direction :: R2 -> Angle
- angleBetween :: R2 -> R2 -> Angle
- fromDirection :: Angle -> R2
- tau :: Floating a => a
- data Angle
- rad :: Iso' Angle Double
- turn :: Iso' Angle Double
- deg :: Iso' Angle Double
- fullTurn :: Angle
- fullCircle :: Angle
- angleRatio :: Angle -> Angle -> Double
- (@@) :: b -> Iso' a b -> a
- stroke :: Renderable (Path R2) b => Path R2 -> Diagram b R2
- stroke' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Path R2 -> Diagram b R2
- strokeTrail :: Renderable (Path R2) b => Trail R2 -> Diagram b R2
- strokeT :: Renderable (Path R2) b => Trail R2 -> Diagram b R2
- strokeTrail' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Trail R2 -> Diagram b R2
- strokeT' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Trail R2 -> Diagram b R2
- strokeLine :: Renderable (Path R2) b => Trail' Line R2 -> Diagram b R2
- strokeLoop :: Renderable (Path R2) b => Trail' Loop R2 -> Diagram b R2
- strokeLocTrail :: Renderable (Path R2) b => Located (Trail R2) -> Diagram b R2
- strokeLocT :: Renderable (Path R2) b => Located (Trail R2) -> Diagram b R2
- strokeLocLine :: Renderable (Path R2) b => Located (Trail' Line R2) -> Diagram b R2
- strokeLocLoop :: Renderable (Path R2) b => Located (Trail' Loop R2) -> Diagram b R2
- data FillRule
- fillRule :: HasStyle a => FillRule -> a -> a
- data StrokeOpts a = StrokeOpts {
- _vertexNames :: [[a]]
- _queryFillRule :: FillRule
- vertexNames :: forall a a'. Lens (StrokeOpts a) (StrokeOpts a') [[a]] [[a']]
- queryFillRule :: forall a. Lens' (StrokeOpts a) FillRule
- clipBy :: (HasStyle a, V a ~ R2) => Path R2 -> a -> a
- clipTo :: Renderable (Path R2) b => Path R2 -> Diagram b R2 -> Diagram b R2
- clipped :: Renderable (Path R2) b => Path R2 -> Diagram b R2 -> Diagram b R2
- hrule :: (TrailLike t, V t ~ R2) => Double -> t
- vrule :: (TrailLike t, V t ~ R2) => Double -> t
- unitCircle :: (TrailLike t, V t ~ R2) => t
- circle :: (TrailLike t, V t ~ R2, Transformable t) => Double -> t
- ellipse :: (TrailLike t, V t ~ R2, Transformable t) => Double -> t
- ellipseXY :: (TrailLike t, V t ~ R2, Transformable t) => Double -> Double -> t
- arc :: (TrailLike t, V t ~ R2) => Angle -> Angle -> t
- arc' :: (TrailLike p, V p ~ R2) => Double -> Angle -> Angle -> p
- arcCW :: (TrailLike t, V t ~ R2) => Angle -> Angle -> t
- wedge :: (TrailLike p, V p ~ R2) => Double -> Angle -> Angle -> p
- arcBetween :: (TrailLike t, V t ~ R2) => P2 -> P2 -> Double -> t
- annularWedge :: (TrailLike p, V p ~ R2) => Double -> Double -> Angle -> Angle -> p
- polygon :: (TrailLike t, V t ~ R2) => PolygonOpts -> t
- polyTrail :: PolygonOpts -> Located (Trail R2)
- data PolygonOpts = PolygonOpts {}
- polyType :: Lens' PolygonOpts PolyType
- polyOrient :: Lens' PolygonOpts PolyOrientation
- polyCenter :: Lens' PolygonOpts P2
- data PolyType
- data PolyOrientation
- data StarOpts
- star :: StarOpts -> [P2] -> Path R2
- regPoly :: (TrailLike t, V t ~ R2) => Int -> Double -> t
- triangle :: (TrailLike t, V t ~ R2) => Double -> t
- eqTriangle :: (TrailLike t, V t ~ R2) => Double -> t
- square :: (TrailLike t, Transformable t, V t ~ R2) => Double -> t
- pentagon :: (TrailLike t, V t ~ R2) => Double -> t
- hexagon :: (TrailLike t, V t ~ R2) => Double -> t
- heptagon :: (TrailLike t, V t ~ R2) => Double -> t
- septagon :: (TrailLike t, V t ~ R2) => Double -> t
- octagon :: (TrailLike t, V t ~ R2) => Double -> t
- nonagon :: (TrailLike t, V t ~ R2) => Double -> t
- decagon :: (TrailLike t, V t ~ R2) => Double -> t
- hendecagon :: (TrailLike t, V t ~ R2) => Double -> t
- dodecagon :: (TrailLike t, V t ~ R2) => Double -> t
- unitSquare :: (TrailLike t, V t ~ R2) => t
- rect :: (TrailLike t, Transformable t, V t ~ R2) => Double -> Double -> t
- roundedRect :: (TrailLike t, V t ~ R2) => Double -> Double -> Double -> t
- roundedRect' :: (TrailLike t, V t ~ R2) => Double -> Double -> RoundedRectOpts -> t
- data RoundedRectOpts = RoundedRectOpts {}
- radiusTL :: Lens' RoundedRectOpts Double
- radiusTR :: Lens' RoundedRectOpts Double
- radiusBL :: Lens' RoundedRectOpts Double
- radiusBR :: Lens' RoundedRectOpts Double
- arrowV :: Renderable (Path R2) b => R2 -> Diagram b R2
- arrowV' :: Renderable (Path R2) b => ArrowOpts -> R2 -> Diagram b R2
- arrowAt :: Renderable (Path R2) b => P2 -> R2 -> Diagram b R2
- arrowAt' :: Renderable (Path R2) b => ArrowOpts -> P2 -> R2 -> Diagram b R2
- arrowBetween :: Renderable (Path R2) b => P2 -> P2 -> Diagram b R2
- arrowBetween' :: Renderable (Path R2) b => ArrowOpts -> P2 -> P2 -> Diagram b R2
- connect :: (Renderable (Path R2) b, IsName n1, IsName n2) => n1 -> n2 -> Diagram b R2 -> Diagram b R2
- connect' :: (Renderable (Path R2) b, IsName n1, IsName n2) => ArrowOpts -> n1 -> n2 -> Diagram b R2 -> Diagram b R2
- connectPerim :: (Renderable (Path R2) b, IsName n1, IsName n2) => n1 -> n2 -> Angle -> Angle -> Diagram b R2 -> Diagram b R2
- connectPerim' :: (Renderable (Path R2) b, IsName n1, IsName n2) => ArrowOpts -> n1 -> n2 -> Angle -> Angle -> Diagram b R2 -> Diagram b R2
- connectOutside :: (Renderable (Path R2) b, IsName n1, IsName n2) => n1 -> n2 -> Diagram b R2 -> Diagram b R2
- connectOutside' :: (Renderable (Path R2) b, IsName n1, IsName n2) => ArrowOpts -> n1 -> n2 -> Diagram b R2 -> Diagram b R2
- arrow :: Renderable (Path R2) b => Double -> Diagram b R2
- arrow' :: Renderable (Path R2) b => ArrowOpts -> Double -> Diagram b R2
- straightShaft :: Trail R2
- module Diagrams.TwoD.Arrowheads
- data ArrowOpts = ArrowOpts {
- _arrowHead :: ArrowHT
- _arrowTail :: ArrowHT
- _arrowShaft :: Trail R2
- _headSize :: Double
- _tailSize :: Double
- _headGap :: Double
- _tailGap :: Double
- _headStyle :: Style R2
- _tailStyle :: Style R2
- _shaftStyle :: Style R2
- arrowHead :: Lens' ArrowOpts ArrowHT
- arrowTail :: Lens' ArrowOpts ArrowHT
- arrowShaft :: Lens' ArrowOpts (Trail R2)
- headSize :: Lens' ArrowOpts Double
- tailSize :: Lens' ArrowOpts Double
- headGap :: Lens' ArrowOpts Double
- tailGap :: Lens' ArrowOpts Double
- gap :: Traversal' ArrowOpts Double
- headColor :: Color c => Setter' ArrowOpts c
- headStyle :: Lens' ArrowOpts (Style R2)
- tailColor :: Color c => Setter' ArrowOpts c
- tailStyle :: Lens' ArrowOpts (Style R2)
- shaftColor :: Color c => Setter' ArrowOpts c
- shaftStyle :: Lens' ArrowOpts (Style R2)
- text :: Renderable Text b => String -> Diagram b R2
- topLeftText :: Renderable Text b => String -> Diagram b R2
- alignedText :: Renderable Text b => Double -> Double -> String -> Diagram b R2
- baselineText :: Renderable Text b => String -> Diagram b R2
- font :: HasStyle a => String -> a -> a
- fontSize :: HasStyle a => Double -> a -> a
- italic :: HasStyle a => a -> a
- oblique :: HasStyle a => a -> a
- bold :: HasStyle a => a -> a
- data Image
- image :: Renderable Image b => FilePath -> Double -> Double -> Diagram b R2
- rotation :: Angle -> T2
- rotate :: (Transformable t, V t ~ R2) => Angle -> t -> t
- rotateBy :: (Transformable t, V t ~ R2) => Double -> t -> t
- rotationAbout :: P2 -> Angle -> T2
- rotateAbout :: (Transformable t, V t ~ R2) => P2 -> Angle -> t -> t
- scalingX :: Double -> T2
- scaleX :: (Transformable t, V t ~ R2) => Double -> t -> t
- scalingY :: Double -> T2
- scaleY :: (Transformable t, V t ~ R2) => Double -> t -> t
- scaling :: (HasLinearMap v, Fractional (Scalar v)) => Scalar v -> Transformation v
- scale :: (Transformable t, Fractional (Scalar (V t)), Eq (Scalar (V t))) => Scalar (V t) -> t -> t
- scaleToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
- scaleToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
- scaleUToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
- scaleUToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
- translationX :: Double -> T2
- translateX :: (Transformable t, V t ~ R2) => Double -> t -> t
- translationY :: Double -> T2
- translateY :: (Transformable t, V t ~ R2) => Double -> t -> t
- translation :: HasLinearMap v => v -> Transformation v
- translate :: (Transformable t, HasLinearMap (V t)) => V t -> t -> t
- reflectionX :: T2
- reflectX :: (Transformable t, V t ~ R2) => t -> t
- reflectionY :: T2
- reflectY :: (Transformable t, V t ~ R2) => t -> t
- reflectionAbout :: P2 -> R2 -> T2
- reflectAbout :: (Transformable t, V t ~ R2) => P2 -> R2 -> t -> t
- shearingX :: Double -> T2
- shearX :: (Transformable t, V t ~ R2) => Double -> t -> t
- shearingY :: Double -> T2
- shearY :: (Transformable t, V t ~ R2) => Double -> t -> t
- parallelX0 :: Deformation R2
- perspectiveX1 :: Deformation R2
- parallelY0 :: Deformation R2
- perspectiveY1 :: Deformation R2
- facingX :: Deformation R2
- facingY :: Deformation R2
- (===) :: (Juxtaposable a, V a ~ R2, Semigroup a) => a -> a -> a
- (|||) :: (Juxtaposable a, V a ~ R2, Semigroup a) => a -> a -> a
- atAngle :: (Juxtaposable a, V a ~ R2, Semigroup a) => Angle -> a -> a -> a
- hcat :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => [a] -> a
- hcat' :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => CatOpts R2 -> [a] -> a
- vcat :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => [a] -> a
- vcat' :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => CatOpts R2 -> [a] -> a
- strutX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m
- strutY :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m
- padX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m -> QDiagram b R2 m
- padY :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m -> QDiagram b R2 m
- extrudeLeft :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m
- extrudeRight :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m
- extrudeBottom :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m
- extrudeTop :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m
- view :: (Backend b R2, Monoid' m) => P2 -> R2 -> QDiagram b R2 m -> QDiagram b R2 m
- boundingRect :: (Enveloped t, Transformable t, TrailLike t, Monoid t, V t ~ R2, Enveloped a, V a ~ R2) => a -> t
- bg :: Renderable (Path R2) b => Colour Double -> Diagram b R2 -> Diagram b R2
- alignL :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignR :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignT :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignB :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignTL :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignTR :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignBL :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignBR :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- alignX :: (Alignable a, HasOrigin a, V a ~ R2) => Double -> a -> a
- alignY :: (Alignable a, HasOrigin a, V a ~ R2) => Double -> a -> a
- centerX :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- centerY :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- centerXY :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
- snugL :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugR :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugT :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugB :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugTL :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugTR :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugBL :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugBR :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugX :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => Double -> a -> a
- snugY :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => Double -> a -> a
- snugCenterX :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugCenterY :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- snugCenterXY :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a
- width :: (Enveloped a, V a ~ R2) => a -> Double
- height :: (Enveloped a, V a ~ R2) => a -> Double
- size2D :: (Enveloped a, V a ~ R2) => a -> (Double, Double)
- sizeSpec2D :: (Enveloped a, V a ~ R2) => a -> SizeSpec2D
- extentX :: (Enveloped a, V a ~ R2) => a -> Maybe (Double, Double)
- extentY :: (Enveloped a, V a ~ R2) => a -> Maybe (Double, Double)
- center2D :: (Enveloped a, V a ~ R2) => a -> P2
- data SizeSpec2D
- mkSizeSpec :: Maybe Double -> Maybe Double -> SizeSpec2D
- sized :: (Transformable a, Enveloped a, V a ~ R2) => SizeSpec2D -> a -> a
- sizedAs :: (Transformable a, Enveloped a, V a ~ R2, Enveloped b, V b ~ R2) => b -> a -> a
- showOrigin :: (Renderable (Path R2) b, Backend b R2, Monoid' m) => QDiagram b R2 m -> QDiagram b R2 m
- showOrigin' :: (Renderable (Path R2) b, Backend b R2, Monoid' m) => OriginOpts -> QDiagram b R2 m -> QDiagram b R2 m
- data OriginOpts = OriginOpts {}
- oColor :: Lens' OriginOpts (Colour Double)
- oScale :: Lens' OriginOpts Double
- oMinSize :: Lens' OriginOpts Double
- showLabels :: (Renderable Text b, Backend b R2, Semigroup m) => QDiagram b R2 m -> QDiagram b R2 Any
R^2
The two-dimensional Euclidean vector space R^2. This type is intentionally abstract.
- To construct a vector, use
r2
, or^&
(from Diagrams.Coordinates):
r2 (3,4) :: R2 3 ^& 4 :: R2
Note that Diagrams.Coordinates is not re-exported by Diagrams.Prelude and must be explicitly imported.
- To construct the vector from the origin to a point
p
, usep
..-.
origin
- To convert a vector
v
into the point obtained by followingv
from the origin, use
.origin
.+^
v - To convert a vector back into a pair of components, use
unv2
orcoords
(from Diagrams.Coordinates). These are typically used in conjunction with theViewPatterns
extension:
foo (unr2 -> (x,y)) = ... foo (coords -> x :& y) = ...
Eq R2 | |
Fractional R2 | |
Num R2 | |
Ord R2 | |
Read R2 | |
Show R2 | |
Transformable R2 | |
Wrapped R2 | Lens wrapped isomorphisms for R2. |
HasBasis R2 | |
VectorSpace R2 | |
InnerSpace R2 | |
AdditiveGroup R2 | |
HasY P2 | |
HasY R2 | |
HasX P2 | |
HasX R2 | |
Coordinates R2 | |
Typeable * R2 | |
Rewrapped R2 R2 | |
Traced (FixedSegment R2) | |
Traced (Trail R2) | |
Traced (Path R2) | |
Traced (Segment Closed R2) | |
Renderable (Path R2) b => TrailLike (QDiagram b R2 Any) | |
type V R2 = R2 | |
type Unwrapped R2 = (Double, Double) | |
type Basis R2 | |
type Scalar R2 = Double | |
type FinalCoord R2 = Double | |
type PrevDim R2 = Double | |
type Decomposition R2 = (:&) Double Double |
unr2 :: R2 -> (Double, Double) Source
Convert a 2D vector back into a pair of components. See also coords
.
Points in R^2. This type is intentionally abstract.
- To construct a point, use
p2
, or^&
(see Diagrams.Coordinates):
p2 (3,4) :: P2 3 ^& 4 :: P2
- To construct a point from a vector
v
, use
.origin
.+^
v - To convert a point
p
into the vector from the origin top
, usep
..-.
origin
- To convert a point back into a pair of coordinates, use
unp2
, orcoords
(from Diagrams.Coordinates). It's common to use these in conjunction with theViewPatterns
extension:
foo (unp2 -> (x,y)) = ... foo (coords -> x :& y) = ...
unp2 :: P2 -> (Double, Double) Source
Convert a 2D point back into a pair of coordinates. See also coords
.
type T2 = Transformation R2 Source
Transformations in R^2.
direction :: R2 -> Angle Source
Compute the direction of a vector, measured counterclockwise from the positive x-axis as a fraction of a full turn. The zero vector is arbitrarily assigned the direction 0.
angleBetween :: R2 -> R2 -> Angle Source
Compute the counterclockwise angle from the first vector to the second.
fromDirection :: Angle -> R2 Source
Convert an angle into a unit vector pointing in that direction.
Angles
The circle constant, the ratio of a circle's circumference to its
radius. Note that pi = tau/2
.
For more information and a well-reasoned argument why we should all be using tau instead of pi, see The Tau Manifesto, http://tauday.com/.
To hear what it sounds like (and to easily memorize the first 30 digits or so), try http://youtu.be/3174T-3-59Q.
Angles can be expressed in a variety of units. Internally, they are represented in radians.
rad :: Iso' Angle Double Source
The radian measure of an Angle
a
can be accessed as a
^. rad
. A new Angle
can be defined in radians as pi @@ rad
.
turn :: Iso' Angle Double Source
The measure of an Angle
a
in full circles can be accessed as
a ^. turn
. A new Angle
of one-half circle can be defined in as
1/2 @@ turn
.
deg :: Iso' Angle Double Source
The degree measure of an Angle
a
can be accessed as a
^. deg
. A new Angle
can be defined in degrees as 180 @@
deg
.
Deprecated synonym for fullTurn
, retained for backwards compatibility.
angleRatio :: Angle -> Angle -> Double Source
Calculate ratio between two angles.
(@@) :: b -> Iso' a b -> a infixl 5 Source
30 @@ deg
is an Angle
of the given measure and units.
More generally, @@
reverses the Iso'
on its right, and
applies the Iso'
to the value on the left. Angle
s are the
motivating example where this order improves readability.
Paths
Stroking
stroke :: Renderable (Path R2) b => Path R2 -> Diagram b R2 Source
Convert a path into a diagram. The resulting diagram has the names 0, 1, ... assigned to each of the path's vertices.
See also stroke'
, which takes an extra options record allowing
its behavior to be customized.
Note that a bug in GHC 7.0.1 causes a context stack overflow when
inferring the type of stroke
. The solution is to give a type
signature to expressions involving stroke
, or (recommended)
upgrade GHC (the bug is fixed in 7.0.2 onwards).
stroke' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Path R2 -> Diagram b R2 Source
A variant of stroke
that takes an extra record of options to
customize its behavior. In particular:
- Names can be assigned to the path's vertices
StrokeOpts
is an instance of Default
, so stroke' (
syntax may be used.with
&
... )
strokeTrail :: Renderable (Path R2) b => Trail R2 -> Diagram b R2 Source
A composition of stroke
and pathFromTrail
for conveniently
converting a trail directly into a diagram.
Note that a bug in GHC 7.0.1 causes a context stack overflow when
inferring the type of stroke
and hence of strokeTrail
as well.
The solution is to give a type signature to expressions involving
strokeTrail
, or (recommended) upgrade GHC (the bug is fixed in 7.0.2
onwards).
strokeT :: Renderable (Path R2) b => Trail R2 -> Diagram b R2 Source
Deprecated synonym for strokeTrail
.
strokeTrail' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Trail R2 -> Diagram b R2 Source
A composition of stroke'
and pathFromTrail
for conveniently
converting a trail directly into a diagram.
strokeT' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Trail R2 -> Diagram b R2 Source
Deprecated synonym for strokeTrail'
.
strokeLine :: Renderable (Path R2) b => Trail' Line R2 -> Diagram b R2 Source
strokeLoop :: Renderable (Path R2) b => Trail' Loop R2 -> Diagram b R2 Source
strokeLocTrail :: Renderable (Path R2) b => Located (Trail R2) -> Diagram b R2 Source
A convenience function for converting a Located Trail
directly
into a diagram; strokeLocTrail = stroke . trailLike
.
strokeLocT :: Renderable (Path R2) b => Located (Trail R2) -> Diagram b R2 Source
Deprecated synonym for strokeLocTrail
.
strokeLocLine :: Renderable (Path R2) b => Located (Trail' Line R2) -> Diagram b R2 Source
A convenience function for converting a Located
line directly
into a diagram; strokeLocLine = stroke . trailLike . mapLoc wrapLine
.
strokeLocLoop :: Renderable (Path R2) b => Located (Trail' Loop R2) -> Diagram b R2 Source
A convenience function for converting a Located
loop directly
into a diagram; strokeLocLoop = stroke . trailLike . mapLoc wrapLoop
.
Enumeration of algorithms or "rules" for determining which points lie in the interior of a (possibly self-intersecting) closed path.
Winding | Interior points are those with a nonzero winding number. See http://en.wikipedia.org/wiki/Nonzero-rule. |
EvenOdd | Interior points are those where a ray extended infinitely in a particular direction crosses the path an odd number of times. See http://en.wikipedia.org/wiki/Even-odd_rule. |
fillRule :: HasStyle a => FillRule -> a -> a Source
Specify the fill rule that should be used for determining which points are inside a path.
data StrokeOpts a Source
A record of options that control how a path is stroked.
StrokeOpts
is an instance of Default
, so a StrokeOpts
records can be created using
notation.with
{ ... }
StrokeOpts | |
|
Default (StrokeOpts a) |
vertexNames :: forall a a'. Lens (StrokeOpts a) (StrokeOpts a') [[a]] [[a']] Source
Atomic names that should be assigned to the vertices of the path so that they can be referenced later. If there are not enough names, the extra vertices are not assigned names; if there are too many, the extra names are ignored. Note that this is a list of lists of names, since paths can consist of multiple trails. The first list of names are assigned to the vertices of the first trail, the second list to the second trail, and so on.
The default value is the empty list.
queryFillRule :: forall a. Lens' (StrokeOpts a) FillRule Source
Clipping
clipBy :: (HasStyle a, V a ~ R2) => Path R2 -> a -> a Source
Clip a diagram by the given path:
- Only the parts of the diagram which lie in the interior of the path will be drawn.
- The envelope of the diagram is unaffected.
clipTo :: Renderable (Path R2) b => Path R2 -> Diagram b R2 -> Diagram b R2 Source
Clip a diagram to the given path setting its envelope to the pointwise minimum of the envelopes of the diagram and path. The trace consists of those parts of the original diagram's trace which fall within the clipping path, or parts of the path's trace within the original diagram.
clipped :: Renderable (Path R2) b => Path R2 -> Diagram b R2 -> Diagram b R2 Source
Clip a diagram to the clip path taking the envelope and trace of the clip path.
Shapes
Rules
hrule :: (TrailLike t, V t ~ R2) => Double -> t Source
Create a centered horizontal (L-R) line of the given length.
hruleEx = vcat' (with & sep .~ 0.2) (map hrule [1..5]) # centerXY # pad 1.1
vrule :: (TrailLike t, V t ~ R2) => Double -> t Source
Create a centered vertical (T-B) line of the given length.
vruleEx = hcat' (with & sep .~ 0.2) (map vrule [1, 1.2 .. 2]) # centerXY # pad 1.1
Circle-ish things
unitCircle :: (TrailLike t, V t ~ R2) => t Source
A circle of radius 1, with center at the origin.
circle :: (TrailLike t, V t ~ R2, Transformable t) => Double -> t Source
A circle of the given radius, centered at the origin. As a path, it begins at (r,0).
ellipse :: (TrailLike t, V t ~ R2, Transformable t) => Double -> t Source
ellipse e
constructs an ellipse with eccentricity e
by
scaling the unit circle in the X direction. The eccentricity must
be within the interval [0,1).
ellipseXY :: (TrailLike t, V t ~ R2, Transformable t) => Double -> Double -> t Source
ellipseXY x y
creates an axis-aligned ellipse, centered at the
origin, with radius x
along the x-axis and radius y
along the
y-axis.
arc :: (TrailLike t, V t ~ R2) => Angle -> Angle -> t Source
Given a start angle s
and an end angle e
,
is the
path of a radius one arc counterclockwise between the two angles.
The origin of the arc is its center.arc
s e
arc' :: (TrailLike p, V p ~ R2) => Double -> Angle -> Angle -> p Source
Given a radus r
, a start angle s
and an end angle e
,
is the path of a radius arc'
r s e(abs r)
arc between
the two angles. If a negative radius is given, the arc will
be clockwise, otherwise it will be counterclockwise. The origin
of the arc is its center.
arc'Ex = mconcat [ arc' r 0 (1/4 \@\@ turn) | r <- [0.5,-1,1.5] ] # centerXY # pad 1.1
wedge :: (TrailLike p, V p ~ R2) => Double -> Angle -> Angle -> p Source
Create a circular wedge of the given radius, beginning at the first angle and extending counterclockwise to the second.
wedgeEx = hcat' (with & sep .~ 0.5) [ wedge 1 (0 \@\@ turn) (1/4) , wedge 1 (7/30 \@\@ turn) (11/30) , wedge 1 (1/8 \@\@ turn) (7/8) ] # fc blue # centerXY # pad 1.1
arcBetween :: (TrailLike t, V t ~ R2) => P2 -> P2 -> Double -> t Source
arcBetween p q height
creates an arc beginning at p
and
ending at q
, with its midpoint at a distance of abs height
away from the straight line from p
to q
. A positive value of
height
results in an arc to the left of the line from p
to
q
; a negative value yields one to the right.
arcBetweenEx = mconcat [ arcBetween origin (p2 (2,1)) ht | ht <- [-0.2, -0.1 .. 0.2] ] # centerXY # pad 1.1
annularWedge :: (TrailLike p, V p ~ R2) => Double -> Double -> Angle -> Angle -> p Source
Create an annular wedge of the given radii, beginning at the first angle and extending counterclockwise to the second. The radius of the outer circle is given first.
annularWedgeEx = hcat' (with & sep .~ 0.50) [ annularWedge 1 0.5 (0 \@\@ turn) (1/4) , annularWedge 1 0.3 (7/30 \@\@ turn) (11/30) , annularWedge 1 0.7 (1/8 \@\@ turn) (7/8) ] # fc blue # centerXY # pad 1.1
General polygons
polygon :: (TrailLike t, V t ~ R2) => PolygonOpts -> t Source
Generate the polygon described by the given options.
polyTrail :: PolygonOpts -> Located (Trail R2) Source
Generate a polygon. See PolygonOpts
for more information.
data PolygonOpts Source
Options for specifying a polygon.
Default PolygonOpts | The default polygon is a regular pentagon of radius 1, centered at the origin, aligned to the x-axis. |
polyType :: Lens' PolygonOpts PolyType Source
Specification for the polygon's vertices.
polyOrient :: Lens' PolygonOpts PolyOrientation Source
Should a rotation be applied to the polygon in order to orient it in a particular way?
polyCenter :: Lens' PolygonOpts P2 Source
Should a translation be applied to the polygon in order to place the center at a particular location?
Method used to determine the vertices of a polygon.
PolyPolar [Angle] [Double] | A "polar" polygon.
To construct an n-gon, use a list of n-1 angles and n radii. Extra angles or radii are ignored. Cyclic polygons (with all vertices lying on a
circle) can be constructed using a second
argument of |
PolySides [Angle] [Double] | A polygon determined by the distance between successive vertices and the angles formed by each three successive vertices. In other words, a polygon specified by "turtle graphics": go straight ahead x1 units; turn by angle a1; go straght ahead x2 units; turn by angle a2; etc. The polygon will be centered at the centroid of its vertices.
To construct an n-gon, use a list of n-2 angles and n-1 edge lengths. Extra angles or lengths are ignored. |
PolyRegular Int Double | A regular polygon with the given number of sides (first argument) and the given radius (second argument). |
data PolyOrientation Source
Determine how a polygon should be oriented.
NoOrient | No special orientation; the first vertex will be at (1,0). This is the default. |
OrientH | Orient horizontally, so the bottommost edge is parallel to the x-axis. |
OrientV | Orient vertically, so the leftmost edge is parallel to the y-axis. |
OrientTo R2 | Orient so some edge is facing in the direction of, that is, perpendicular to, the given vector. |
Star polygons
Options for creating "star" polygons, where the edges connect possibly non-adjacent vertices.
StarFun (Int -> Int) | Specify the order in which the vertices should be connected by a function that maps each vertex index to the index of the vertex that should come next. Indexing of vertices begins at 0. |
StarSkip Int | Specify a star polygon by a "skip". A skip of 1 indicates a normal polygon, where edges go between successive vertices. A skip of 2 means that edges will connect every second vertex, skipping one in between. Generally, a skip of n means that edges will connect every nth vertex. |
star :: StarOpts -> [P2] -> Path R2 Source
Create a generalized star polygon. The StarOpts
are used
to determine in which order the given vertices should be
connected. The intention is that the second argument of type
[P2]
could be generated by a call to polygon
, regPoly
, or
the like, since a list of vertices is TrailLike
. But of course
the list can be generated any way you like. A
is
returned (instead of any Path
R2
TrailLike
) because the resulting path
may have more than one component, for example if the vertices are
to be connected in several disjoint cycles.
Regular polygons
regPoly :: (TrailLike t, V t ~ R2) => Int -> Double -> t Source
Create a regular polygon. The first argument is the number of
sides, and the second is the length of the sides. (Compare to the
polygon
function with a PolyRegular
option, which produces
polygons of a given radius).
The polygon will be oriented with one edge parallel to the x-axis.
triangle :: (TrailLike t, V t ~ R2) => Double -> t Source
An equilateral triangle, with sides of the given length and base parallel to the x-axis.
eqTriangle :: (TrailLike t, V t ~ R2) => Double -> t Source
A synonym for triangle
, provided for backwards compatibility.
square :: (TrailLike t, Transformable t, V t ~ R2) => Double -> t Source
A square with its center at the origin and sides of the given length, oriented parallel to the axes.
pentagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular pentagon, with sides of the given length and base parallel to the x-axis.
hexagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular hexagon, with sides of the given length and base parallel to the x-axis.
heptagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular heptagon, with sides of the given length and base parallel to the x-axis.
septagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A synonym for heptagon
. It is, however, completely inferior,
being a base admixture of the Latin septum (seven) and the
Greek γωνία (angle).
octagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular octagon, with sides of the given length and base parallel to the x-axis.
nonagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular nonagon, with sides of the given length and base parallel to the x-axis.
decagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular decagon, with sides of the given length and base parallel to the x-axis.
hendecagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular hendecagon, with sides of the given length and base parallel to the x-axis.
dodecagon :: (TrailLike t, V t ~ R2) => Double -> t Source
A regular dodecagon, with sides of the given length and base parallel to the x-axis.
Other special polygons
unitSquare :: (TrailLike t, V t ~ R2) => t Source
A square with its center at the origin and sides of length 1, oriented parallel to the axes.
rect :: (TrailLike t, Transformable t, V t ~ R2) => Double -> Double -> t Source
rect w h
is an axis-aligned rectangle of width w
and height
h
, centered at the origin.
Other shapes
roundedRect :: (TrailLike t, V t ~ R2) => Double -> Double -> Double -> t Source
roundedRect w h r
generates a closed trail, or closed path
centered at the origin, of an axis-aligned rectangle with width
w
, height h
, and circular rounded corners of radius r
. If
r
is negative the corner will be cut out in a reverse arc. If
the size of r
is larger than half the smaller dimension of w
and h
, then it will be reduced to fit in that range, to prevent
the corners from overlapping. The trail or path begins with the
right edge and proceeds counterclockwise. If you need to specify
a different radius for each corner individually, use
roundedRect'
instead.
roundedRectEx = pad 1.1 . centerXY $ hcat' (with & sep .~ 0.2) [ roundedRect 0.5 0.4 0.1 , roundedRect 0.5 0.4 (-0.1) , roundedRect' 0.7 0.4 (with & radiusTL .~ 0.2 & radiusTR .~ -0.2 & radiusBR .~ 0.1) ]
roundedRect' :: (TrailLike t, V t ~ R2) => Double -> Double -> RoundedRectOpts -> t Source
roundedRect'
works like roundedRect
but allows you to set the radius of
each corner indivually, using RoundedRectOpts
. The default corner radius is 0.
Each radius can also be negative, which results in the curves being reversed
to be inward instead of outward.
data RoundedRectOpts Source
Arrows
arrowV :: Renderable (Path R2) b => R2 -> Diagram b R2 Source
arrowV v
creates an arrow with the direction and magnitude of
the vector v
(with its tail at the origin), using default
parameters.
arrowV' :: Renderable (Path R2) b => ArrowOpts -> R2 -> Diagram b R2 Source
arrowV' v
creates an arrow with the direction and magnitude of
the vector v
(with its tail at the origin).
arrowAt :: Renderable (Path R2) b => P2 -> R2 -> Diagram b R2 Source
Create an arrow starting at s with length and direction determined by the vector v.
arrowBetween :: Renderable (Path R2) b => P2 -> P2 -> Diagram b R2 Source
arrowBetween s e
creates an arrow pointing from s
to e
with default parameters.
arrowBetween' :: Renderable (Path R2) b => ArrowOpts -> P2 -> P2 -> Diagram b R2 Source
arrowBetween' opts s e
creates an arrow pointing from s
to
e
using the given options. In particular, it scales and
rotates arrowShaft
to go between s
and e
, taking head,
tail, and gaps into account.
connect :: (Renderable (Path R2) b, IsName n1, IsName n2) => n1 -> n2 -> Diagram b R2 -> Diagram b R2 Source
Connect two diagrams with a straight arrow.
connect' :: (Renderable (Path R2) b, IsName n1, IsName n2) => ArrowOpts -> n1 -> n2 -> Diagram b R2 -> Diagram b R2 Source
Connect two diagrams with an arbitrary arrow.
connectPerim :: (Renderable (Path R2) b, IsName n1, IsName n2) => n1 -> n2 -> Angle -> Angle -> Diagram b R2 -> Diagram b R2 Source
Connect two diagrams at point on the perimeter of the diagrams, choosen by angle.
connectPerim' :: (Renderable (Path R2) b, IsName n1, IsName n2) => ArrowOpts -> n1 -> n2 -> Angle -> Angle -> Diagram b R2 -> Diagram b R2 Source
connectOutside :: (Renderable (Path R2) b, IsName n1, IsName n2) => n1 -> n2 -> Diagram b R2 -> Diagram b R2 Source
Draw an arrow from diagram named "n1" to diagram named "n2". The arrow lies on the line between the centres of the diagrams, but is drawn so that it stops at the boundaries of the diagrams, using traces to find the intersection points.
connectOutside' :: (Renderable (Path R2) b, IsName n1, IsName n2) => ArrowOpts -> n1 -> n2 -> Diagram b R2 -> Diagram b R2 Source
arrow :: Renderable (Path R2) b => Double -> Diagram b R2 Source
arrow len
creates an arrow of length len
with default
parameters, starting at the origin and ending at the point
(len,0)
.
arrow' :: Renderable (Path R2) b => ArrowOpts -> Double -> Diagram b R2 Source
arrow' opts len
creates an arrow of length len
using the
given options, starting at the origin and ending at the point
(len,0)
. In particular, it scales the given arrowShaft
so
that the entire arrow has length len
.
straightShaft :: Trail R2 Source
Straight line arrow shaft.
module Diagrams.TwoD.Arrowheads
ArrowOpts | |
|
headColor :: Color c => Setter' ArrowOpts c Source
A lens for setting or modifying the color of an arrowhead. For
example, one may write ... (with & headColor .~ blue)
to get an
arrow with a blue head, or ... (with & headColor %~ blend 0.5
white)
to make an arrow's head a lighter color. For more general
control over the style of arrowheads, see headStyle
.
Note that the most general type of headColor
would be
(Color c, Color c') => Setter ArrowOpts ArrowOpts c c'
but that can cause problems for type inference when setting the
color. However, using it at that more general type may
occasionally be useful, for example, if you want to apply some
opacity to a color, as in ... (with & headColor %~
(`withOpacity` 0.5))
. If you want the more general type, you
can use
in place of headStyle
. styleFillColor
headColor
.
headStyle :: Lens' ArrowOpts (Style R2) Source
Style to apply to the head. headStyle
is modified by using the lens
combinator %~
to change the current style. For example, to change
an opaque black arrowhead to translucent orange:
(with & headStyle %~ fc orange . opacity 0.75)
.
tailColor :: Color c => Setter' ArrowOpts c Source
A lens for setting or modifying the color of an arrow
tail. See headColor
.
shaftColor :: Color c => Setter' ArrowOpts c Source
A lens for setting or modifying the color of an arrow
shaft. See headColor
.
Text
text :: Renderable Text b => String -> Diagram b R2 Source
Create a primitive text diagram from the given string, with center
alignment, equivalent to
.alignedText
0.5 0.5
Note that it takes up no space, as text size information is not available.
topLeftText :: Renderable Text b => String -> Diagram b R2 Source
Create a primitive text diagram from the given string, origin at
the top left corner of the text's bounding box, equivalent to
.alignedText
0 1
Note that it takes up no space.
alignedText :: Renderable Text b => Double -> Double -> String -> Diagram b R2 Source
Create a primitive text diagram from the given string, with the origin set to a point interpolated within the bounding box. The first parameter varies from 0 (left) to 1 (right), and the second parameter from 0 (bottom) to 1 (top).
The height of this box is determined by the font's potential ascent and descent, rather than the height of the particular string.
Note that it takes up no space.
baselineText :: Renderable Text b => String -> Diagram b R2 Source
Create a primitive text diagram from the given string, with the origin set to be on the baseline, at the beginning (although not bounding). This is the reference point of showText in the Cairo graphics library.
Note that it takes up no space.
font :: HasStyle a => String -> a -> a Source
Specify a font family to be used for all text within a diagram.
fontSize :: HasStyle a => Double -> a -> a Source
Set the font size, that is, the size of the font's em-square as
measured within the current local vector space. The default size
is 1
.
Images
An external image primitive, representing an image the backend should import from another file when rendering.
image :: Renderable Image b => FilePath -> Double -> Double -> Diagram b R2 Source
Take an external image from the specified file and turn it into a diagram with the specified width and height, centered at the origin. Note that the image's aspect ratio will be preserved; if the specified width and height have a different ratio than the image's aspect ratio, there will be extra space in one dimension.
Transformations
Rotation
rotation :: Angle -> T2 Source
Create a transformation which performs a rotation about the local
origin by the given angle. See also rotate
.
rotate :: (Transformable t, V t ~ R2) => Angle -> t -> t Source
Rotate about the local origin by the given angle. Positive angles
correspond to counterclockwise rotation, negative to
clockwise. The angle can be expressed using any of the Iso
s on
Angle
. For example, rotate (1/4 @@
, turn
)rotate
(tau/4 @@ rad)
, and rotate (90 @@ deg)
all
represent the same transformation, namely, a counterclockwise
rotation by a right angle. To rotate about some point other than
the local origin, see rotateAbout
.
Note that writing rotate (1/4)
, with no Angle
constructor,
will yield an error since GHC cannot figure out which sort of
angle you want to use. In this common situation you can use
rotateBy
, which interprets its argument as a number of turns.
rotationAbout :: P2 -> Angle -> T2 Source
rotationAbout p
is a rotation about the point p
(instead of
around the local origin).
rotateAbout :: (Transformable t, V t ~ R2) => P2 -> Angle -> t -> t Source
rotateAbout p
is like rotate
, except it rotates around the
point p
instead of around the local origin.
Scaling
scalingX :: Double -> T2 Source
Construct a transformation which scales by the given factor in the x (horizontal) direction.
scaleX :: (Transformable t, V t ~ R2) => Double -> t -> t Source
Scale a diagram by the given factor in the x (horizontal)
direction. To scale uniformly, use scale
.
scalingY :: Double -> T2 Source
Construct a transformation which scales by the given factor in the y (vertical) direction.
scaleY :: (Transformable t, V t ~ R2) => Double -> t -> t Source
Scale a diagram by the given factor in the y (vertical)
direction. To scale uniformly, use scale
.
scaling :: (HasLinearMap v, Fractional (Scalar v)) => Scalar v -> Transformation v
Create a uniform scaling transformation.
scale :: (Transformable t, Fractional (Scalar (V t)), Eq (Scalar (V t))) => Scalar (V t) -> t -> t
Scale uniformly in every dimension by the given scalar.
scaleToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t Source
scaleToX w
scales a diagram in the x (horizontal) direction by
whatever factor required to make its width w
. scaleToX
should not be applied to diagrams with a width of 0, such as
vrule
.
scaleToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t Source
scaleToY h
scales a diagram in the y (vertical) direction by
whatever factor required to make its height h
. scaleToY
should not be applied to diagrams with a height of 0, such as
hrule
.
scaleUToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t Source
scaleUToX w
scales a diagram uniformly by whatever factor
required to make its width w
. scaleUToX
should not be
applied to diagrams with a width of 0, such as vrule
.
scaleUToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t Source
scaleUToY h
scales a diagram uniformly by whatever factor
required to make its height h
. scaleUToY
should not be applied
to diagrams with a height of 0, such as hrule
.
Translation
translationX :: Double -> T2 Source
Construct a transformation which translates by the given distance in the x (horizontal) direction.
translateX :: (Transformable t, V t ~ R2) => Double -> t -> t Source
Translate a diagram by the given distance in the x (horizontal) direction.
translationY :: Double -> T2 Source
Construct a transformation which translates by the given distance in the y (vertical) direction.
translateY :: (Transformable t, V t ~ R2) => Double -> t -> t Source
Translate a diagram by the given distance in the y (vertical) direction.
translation :: HasLinearMap v => v -> Transformation v
Create a translation.
translate :: (Transformable t, HasLinearMap (V t)) => V t -> t -> t
Translate by a vector.
Reflection
reflectionX :: T2 Source
Construct a transformation which flips a diagram from left to right, i.e. sends the point (x,y) to (-x,y).
reflectX :: (Transformable t, V t ~ R2) => t -> t Source
Flip a diagram from left to right, i.e. send the point (x,y) to (-x,y).
reflectionY :: T2 Source
Construct a transformation which flips a diagram from top to bottom, i.e. sends the point (x,y) to (x,-y).
reflectY :: (Transformable t, V t ~ R2) => t -> t Source
Flip a diagram from top to bottom, i.e. send the point (x,y) to (x,-y).
reflectionAbout :: P2 -> R2 -> T2 Source
reflectionAbout p v
is a reflection in the line determined by
the point p
and vector v
.
reflectAbout :: (Transformable t, V t ~ R2) => P2 -> R2 -> t -> t Source
reflectAbout p v
reflects a diagram in the line determined by
the point p
and the vector v
.
Shears
shearingX :: Double -> T2 Source
shearingX d
is the linear transformation which is the identity on
y coordinates and sends (0,1)
to (d,1)
.
shearX :: (Transformable t, V t ~ R2) => Double -> t -> t Source
shearX d
performs a shear in the x-direction which sends
(0,1)
to (d,1)
.
shearingY :: Double -> T2 Source
shearingY d
is the linear transformation which is the identity on
x coordinates and sends (1,0)
to (1,d)
.
shearY :: (Transformable t, V t ~ R2) => Double -> t -> t Source
shearY d
performs a shear in the y-direction which sends
(1,0)
to (1,d)
.
Deformations - non-affine transforms
parallelX0 :: Deformation R2 Source
The parallel projection onto the line x=0
perspectiveX1 :: Deformation R2 Source
The perspective division onto the line x=1 along lines going through the origin.
parallelY0 :: Deformation R2 Source
The parallel projection onto the line y=0
perspectiveY1 :: Deformation R2 Source
The perspective division onto the line y=1 along lines going through the origin.
facingX :: Deformation R2 Source
The viewing transform for a viewer facing along the positive X
axis. X coördinates stay fixed, while Y coördinates are compressed
with increasing distance. asDeformation (translation unitX) <>
parallelX0 <> frustrumX = perspectiveX1
Combinators
Combining multiple diagrams
(===) :: (Juxtaposable a, V a ~ R2, Semigroup a) => a -> a -> a infixl 6 Source
Place two diagrams (or other objects) vertically adjacent to one another, with the first diagram above the second. Since Haskell ignores whitespace in expressions, one can thus write
c === d
to place c
above d
. The local origin of the resulting
combined diagram is the same as the local origin of the first.
(===)
is associative and has mempty
as an identity. See the
documentation of beside
for more information.
(|||) :: (Juxtaposable a, V a ~ R2, Semigroup a) => a -> a -> a infixl 6 Source
Place two diagrams (or other juxtaposable objects) horizontally
adjacent to one another, with the first diagram to the left of
the second. The local origin of the resulting combined diagram
is the same as the local origin of the first. (|||)
is
associative and has mempty
as an identity. See the
documentation of beside
for more information.
atAngle :: (Juxtaposable a, V a ~ R2, Semigroup a) => Angle -> a -> a -> a Source
Place two diagrams (or other juxtaposable objects) adjacent to one
another, with the second diagram placed along a line at angle
th
from the first. The local origin of the resulting combined
diagram is the same as the local origin of the first.
See the documentation of beside
for more information.
hcat :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => [a] -> a Source
Lay out a list of juxtaposable objects in a row from left to right, so that their local origins lie along a single horizontal line, with successive envelopes tangent to one another.
vcat :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => [a] -> a Source
Lay out a list of juxtaposable objects in a column from top to bottom, so that their local origins lie along a single vertical line, with successive envelopes tangent to one another.
Spacing and envelopes
strutX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m Source
strutX w
is an empty diagram with width w
, height 0, and a
centered local origin. Note that strutX (-w)
behaves the same as
strutX w
.
strutY :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m Source
strutY h
is an empty diagram with height h
, width 0, and a
centered local origin. Note that strutY (-h)
behaves the same as
strutY h
.
padX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m -> QDiagram b R2 m Source
padX s
"pads" a diagram in the x-direction, expanding its
envelope horizontally by a factor of s
(factors between 0 and 1
can be used to shrink the envelope). Note that the envelope will
expand with respect to the local origin, so if the origin is not
centered horizontally the padding may appear "uneven". If this
is not desired, the origin can be centered (using centerX
)
before applying padX
.
padY :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m -> QDiagram b R2 m Source
padY s
"pads" a diagram in the y-direction, expanding its
envelope vertically by a factor of s
(factors between
0 and 1 can be used to shrink the envelope). Note that
the envelope will expand with respect to the local origin,
so if the origin is not centered vertically the padding may appear
"uneven". If this is not desired, the origin can be centered
(using centerY
) before applying padY
.
extrudeLeft :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m Source
extrudeLeft s
"extrudes" a diagram in the negative x-direction,
offsetting its envelope by the provided distance. When s < 0
,
the envelope is inset instead.
See the documentation for extrudeEnvelope
for more information.
extrudeRight :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m Source
extrudeRight s
"extrudes" a diagram in the positive x-direction,
offsetting its envelope by the provided distance. When s < 0
,
the envelope is inset instead.
See the documentation for extrudeEnvelope
for more information.
extrudeBottom :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m Source
extrudeBottom s
"extrudes" a diagram in the negative y-direction,
offsetting its envelope by the provided distance. When s < 0
,
the envelope is inset instead.
See the documentation for extrudeEnvelope
for more information.
extrudeTop :: Monoid' m => Double -> QDiagram b R2 m -> QDiagram b R2 m Source
extrudeTop s
"extrudes" a diagram in the positive y-direction,
offsetting its envelope by the provided distance. When s < 0
,
the envelope is inset instead.
See the documentation for extrudeEnvelope
for more information.
view :: (Backend b R2, Monoid' m) => P2 -> R2 -> QDiagram b R2 m -> QDiagram b R2 m Source
view p v
sets the envelope of a diagram to a rectangle whose
lower-left corner is at p
and whose upper-right corner is at p
.+^ v
. Useful for selecting the rectangular portion of a
diagram which should actually be "viewed" in the final render,
if you don't want to see the entire diagram.
Background
boundingRect :: (Enveloped t, Transformable t, TrailLike t, Monoid t, V t ~ R2, Enveloped a, V a ~ R2) => a -> t Source
Construct a bounding rectangle for an enveloped object, that is, the smallest axis-aligned rectangle which encloses the object.
bg :: Renderable (Path R2) b => Colour Double -> Diagram b R2 -> Diagram b R2 Source
"Set the background color" of a diagram. That is, place a diagram atop a bounding rectangle of the given color.
Alignment
alignL :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a Source
Align along the left edge, i.e. translate the diagram in a horizontal direction so that the local origin is on the left edge of the envelope.
alignX :: (Alignable a, HasOrigin a, V a ~ R2) => Double -> a -> a Source
alignX
and snugX
move the local origin horizontally as follows:
alignX (-1)
moves the local origin to the left edge of the boundary;align 1
moves the local origin to the right edge;- any other argument interpolates linearly between these. For
example,
alignX 0
centers,alignX 2
moves the origin one "radius" to the right of the right edge, and so on. snugX
works the same way.
alignY :: (Alignable a, HasOrigin a, V a ~ R2) => Double -> a -> a Source
Like alignX
, but moving the local origin vertically, with an
argument of 1
corresponding to the top edge and (-1)
corresponding
to the bottom edge.
centerX :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a Source
Center the local origin along the X-axis.
centerY :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a Source
Center the local origin along the Y-axis.
centerXY :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a Source
Center along both the X- and Y-axes.
Snugging
snugTL :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
snugTR :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
snugBL :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
snugBR :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
snugX :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => Double -> a -> a Source
See the documentation for alignX
.
snugY :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => Double -> a -> a Source
snugCenterX :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
snugCenterY :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
snugCenterXY :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a, V a ~ R2) => a -> a Source
Size
Computing size
size2D :: (Enveloped a, V a ~ R2) => a -> (Double, Double) Source
Compute the width and height of an enveloped object.
sizeSpec2D :: (Enveloped a, V a ~ R2) => a -> SizeSpec2D Source
Compute the size of an enveloped object as a SizeSpec2D
value.
extentX :: (Enveloped a, V a ~ R2) => a -> Maybe (Double, Double) Source
Compute the absolute x-coordinate range of an enveloped object in
R2, in the form (lo,hi). Return Nothing
for objects with an
empty envelope.
extentY :: (Enveloped a, V a ~ R2) => a -> Maybe (Double, Double) Source
Compute the absolute y-coordinate range of an enveloped object in R2, in the form (lo,hi).
center2D :: (Enveloped a, V a ~ R2) => a -> P2 Source
Compute the point at the center (in the x- and y-directions) of a enveloped object. Return the origin for objects with an empty envelope.
Specifying size
data SizeSpec2D Source
A specification of a (requested) rectangular size.
Width !Double | Specify an explicit width. The height should be determined automatically (so as to preserve aspect ratio). |
Height !Double | Specify an explicit height. The width should be determined automatically (so as to preserve aspect ratio). |
Dims !Double !Double | An explicit specification of a width and height. |
Absolute | Absolute size: use whatever size an object already has; do not rescale. |
mkSizeSpec :: Maybe Double -> Maybe Double -> SizeSpec2D Source
Create a size specification from a possibly-specified width and height.
Adjusting size
sized :: (Transformable a, Enveloped a, V a ~ R2) => SizeSpec2D -> a -> a Source
Uniformly scale any enveloped object so that it fits within the given size.
sizedAs :: (Transformable a, Enveloped a, V a ~ R2, Enveloped b, V b ~ R2) => b -> a -> a Source
Uniformly scale an enveloped object so that it "has the same size as" (fits within the width and height of) some other object.
Visual aids for understanding the internal model
showOrigin :: (Renderable (Path R2) b, Backend b R2, Monoid' m) => QDiagram b R2 m -> QDiagram b R2 m Source
Mark the origin of a diagram by placing a red dot 1/50th its size.
showOrigin' :: (Renderable (Path R2) b, Backend b R2, Monoid' m) => OriginOpts -> QDiagram b R2 m -> QDiagram b R2 m Source
Mark the origin of a diagram, with control over colour and scale of marker dot.
data OriginOpts Source