Maintainer | diagrams-discuss@googlegroups.com |
---|---|
Safe Haskell | None |
The core library of primitives forming the basis of an embedded domain-specific language for describing and rendering diagrams.
Diagrams.Core.Types defines types and classes for primitives, diagrams, and backends.
- type UpAnnots b v m = Deletable (Envelope v) ::: (Deletable (Trace v) ::: (SubMap b v m ::: (Query v m ::: ())))
- type DownAnnots v = (Split (Transformation v) :+: Style v) ::: (Name ::: ())
- newtype QDiagram b v m = QD {
- unQD :: DUALTree (DownAnnots v) (UpAnnots b v m) () (Prim b v)
- mkQD :: Prim b v -> Envelope v -> Trace v -> SubMap b v m -> Query v m -> QDiagram b v m
- type Diagram b v = QDiagram b v Any
- prims :: HasLinearMap v => QDiagram b v m -> [(Prim b v, (Split (Transformation v), Style v))]
- envelope :: Ord (Scalar v) => QDiagram b v m -> Envelope v
- trace :: (Ord (Scalar v), VectorSpace v, HasLinearMap v) => QDiagram b v m -> Trace v
- subMap :: QDiagram b v m -> SubMap b v m
- names :: HasLinearMap v => QDiagram b v m -> [(Name, [Point v])]
- query :: Monoid m => QDiagram b v m -> Query v m
- sample :: Monoid m => QDiagram b v m -> Point v -> m
- value :: Monoid m => m -> QDiagram b v Any -> QDiagram b v m
- resetValue :: (Eq m, Monoid m) => QDiagram b v m -> QDiagram b v Any
- clearValue :: QDiagram b v m -> QDiagram b v Any
- atop :: (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Semigroup m) => QDiagram b v m -> QDiagram b v m -> QDiagram b v m
- named :: (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => n -> QDiagram b v m -> QDiagram b v m
- nameSub :: (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => (QDiagram b v m -> Subdiagram b v m) -> n -> QDiagram b v m -> QDiagram b v m
- namePoint :: (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => (QDiagram b v m -> Point v) -> n -> QDiagram b v m -> QDiagram b v m
- withName :: IsName n => n -> (Subdiagram b v m -> QDiagram b v m -> QDiagram b v m) -> QDiagram b v m -> QDiagram b v m
- withNameAll :: IsName n => n -> ([Subdiagram b v m] -> QDiagram b v m -> QDiagram b v m) -> QDiagram b v m -> QDiagram b v m
- withNames :: IsName n => [n] -> ([Subdiagram b v m] -> QDiagram b v m -> QDiagram b v m) -> QDiagram b v m -> QDiagram b v m
- freeze :: forall v b m. (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => QDiagram b v m -> QDiagram b v m
- setEnvelope :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Monoid' m) => Envelope v -> QDiagram b v m -> QDiagram b v m
- setTrace :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Semigroup m) => Trace v -> QDiagram b v m -> QDiagram b v m
- data Subdiagram b v m = Subdiagram (QDiagram b v m) (DownAnnots v)
- mkSubdiagram :: QDiagram b v m -> Subdiagram b v m
- getSub :: (HasLinearMap v, InnerSpace v, Floating (Scalar v), Ord (Scalar v), Semigroup m) => Subdiagram b v m -> QDiagram b v m
- rawSub :: Subdiagram b v m -> QDiagram b v m
- location :: HasLinearMap v => Subdiagram b v m -> Point v
- subPoint :: (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => Point v -> Subdiagram b v m
- newtype SubMap b v m = SubMap (Map Name [Subdiagram b v m])
- fromNames :: IsName a => [(a, Subdiagram b v m)] -> SubMap b v m
- rememberAs :: IsName a => a -> QDiagram b v m -> SubMap b v m -> SubMap b v m
- lookupSub :: IsName n => n -> SubMap b v m -> Maybe [Subdiagram b v m]
- data Prim b v where
- Prim :: Renderable p b => p -> Prim b (V p)
- nullPrim :: (HasLinearMap v, Monoid (Render b v)) => Prim b v
- class (HasLinearMap v, Monoid (Render b v)) => Backend b v where
- data Render b v :: *
- type Result b v :: *
- data Options b v :: *
- withStyle :: b -> Style v -> Transformation v -> Render b v -> Render b v
- doRender :: b -> Options b v -> Render b v -> Result b v
- adjustDia :: Monoid' m => b -> Options b v -> QDiagram b v m -> (Options b v, QDiagram b v m)
- renderDia :: (InnerSpace v, OrderedField (Scalar v), Monoid' m) => b -> Options b v -> QDiagram b v m -> Result b v
- class Backend b v => MultiBackend b v where
- renderDias :: (InnerSpace v, OrderedField (Scalar v), Monoid' m) => b -> Options b v -> [QDiagram b v m] -> Result b v
- data NullBackend
- type D v = Diagram NullBackend v
- class Transformable t => Renderable t b where
Diagrams
Annotations
type UpAnnots b v m = Deletable (Envelope v) ::: (Deletable (Trace v) ::: (SubMap b v m ::: (Query v m ::: ())))Source
Monoidal annotations which travel up the diagram tree, i.e. which are aggregated from component diagrams to the whole:
- envelopes (see Diagrams.Core.Envelope). The envelopes are "deletable" meaning that at any point we can throw away the existing envelope and replace it with a new one; sometimes we want to consider a diagram as having a different envelope unrelated to its "natural" envelope.
- traces (see Diagrams.Core.Trace), also deletable.
- name/subdiagram associations (see Diagrams.Core.Names)
- query functions (see Diagrams.Core.Query)
type DownAnnots v = (Split (Transformation v) :+: Style v) ::: (Name ::: ())Source
Monoidal annotations which travel down the diagram tree, i.e. which accumulate along each path to a leaf (and which can act on the upwards-travelling annotations):
- transformations (split at the innermost freeze): see Diagrams.Core.Transform
- styles (see Diagrams.Core.Style)
- names (see Diagrams.Core.Names)
The fundamental diagram type is represented by trees of
primitives with various monoidal annotations. The Q
in
QDiagram
stands for "Queriable", as distinguished from
Diagram
, a synonym for QDiagram
with the query type
specialized to Any
.
Typeable3 QDiagram | |
Functor (QDiagram b v) | |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => Monoid (QDiagram b v m) | Diagrams form a monoid since each of their components do: the empty diagram has no primitives, an empty envelope, an empty trace, no named subdiagrams, and a constantly empty query function. Diagrams compose by aligning their respective local origins. The new diagram has all the primitives and all the names from the two diagrams combined, and query functions are combined pointwise. The first diagram goes on top of the second. "On top of" probably only makes sense in vector spaces of dimension lower than 3, but in theory it could make sense for, say, 3-dimensional diagrams when viewed by 4-dimensional beings. |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => Semigroup (QDiagram b v m) | |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => Qualifiable (QDiagram b v m) | Diagrams can be qualified so that all their named points can now be referred to using the qualification prefix. |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => HasOrigin (QDiagram b v m) | Every diagram has an intrinsic "local origin" which is the basis for all combining operations. |
(HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Semigroup m) => Transformable (QDiagram b v m) | Diagrams can be transformed by transforming each of their components appropriately. |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => HasStyle (QDiagram b v m) | |
(HasLinearMap v, VectorSpace v, Ord (Scalar v)) => Traced (QDiagram b v m) | |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v)) => Enveloped (QDiagram b v m) | |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => Juxtaposable (QDiagram b v m) | |
Newtype (QDiagram b v m) (DUALTree (DownAnnots v) (UpAnnots b v m) () (Prim b v)) |
mkQD :: Prim b v -> Envelope v -> Trace v -> SubMap b v m -> Query v m -> QDiagram b v mSource
Create a diagram from a single primitive, along with an envelope, trace, subdiagram map, and query function.
Operations on diagrams
Extracting information
prims :: HasLinearMap v => QDiagram b v m -> [(Prim b v, (Split (Transformation v), Style v))]Source
Extract a list of primitives from a diagram, together with their associated transformations and styles.
trace :: (Ord (Scalar v), VectorSpace v, HasLinearMap v) => QDiagram b v m -> Trace vSource
Get the trace of a diagram.
subMap :: QDiagram b v m -> SubMap b v mSource
Get the subdiagram map (i.e. an association from names to subdiagrams) of a diagram.
names :: HasLinearMap v => QDiagram b v m -> [(Name, [Point v])]Source
Get a list of names of subdiagrams and their locations.
query :: Monoid m => QDiagram b v m -> Query v mSource
Get the query function associated with a diagram.
sample :: Monoid m => QDiagram b v m -> Point v -> mSource
Sample a diagram's query function at a given point.
clearValue :: QDiagram b v m -> QDiagram b v AnySource
Set all the query values of a diagram to False
.
Combining diagrams
For many more ways of combining diagrams, see Diagrams.Combinators from the diagrams-lib package.
atop :: (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Semigroup m) => QDiagram b v m -> QDiagram b v m -> QDiagram b v mSource
A convenient synonym for mappend
on diagrams, designed to be
used infix (to help remember which diagram goes on top of which
when combining them, namely, the first on top of the second).
Modifying diagrams
Names
named :: (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => n -> QDiagram b v m -> QDiagram b v mSource
Attach an atomic name to a diagram.
nameSub :: (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => (QDiagram b v m -> Subdiagram b v m) -> n -> QDiagram b v m -> QDiagram b v mSource
Attach an atomic name to a certain subdiagram, computed from the given diagram.
namePoint :: (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => (QDiagram b v m -> Point v) -> n -> QDiagram b v m -> QDiagram b v mSource
Attach an atomic name to a certain point (which may be computed from the given diagram), treated as a subdiagram with no content and a point envelope.
withName :: IsName n => n -> (Subdiagram b v m -> QDiagram b v m -> QDiagram b v m) -> QDiagram b v m -> QDiagram b v mSource
Given a name and a diagram transformation indexed by a subdiagram, perform the transformation using the most recent subdiagram associated with (some qualification of) the name, or perform the identity transformation if the name does not exist.
withNameAll :: IsName n => n -> ([Subdiagram b v m] -> QDiagram b v m -> QDiagram b v m) -> QDiagram b v m -> QDiagram b v mSource
Given a name and a diagram transformation indexed by a list of subdiagrams, perform the transformation using the collection of all such subdiagrams associated with (some qualification of) the given name.
withNames :: IsName n => [n] -> ([Subdiagram b v m] -> QDiagram b v m -> QDiagram b v m) -> QDiagram b v m -> QDiagram b v mSource
Given a list of names and a diagram transformation indexed by a list of subdiagrams, perform the transformation using the list of most recent subdiagrams associated with (some qualification of) each name. Do nothing (the identity transformation) if any of the names do not exist.
Other
freeze :: forall v b m. (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => QDiagram b v m -> QDiagram b v mSource
By default, diagram attributes are not affected by
transformations. This means, for example, that lw 0.01 circle
and scale 2 (lw 0.01 circle)
will be drawn with lines of the
same width, and scaleY 3 circle
will be an ellipse drawn with
a uniform line. Once a diagram is frozen, however,
transformations do affect attributes, so, for example, scale 2
(freeze (lw 0.01 circle))
will be drawn with a line twice as
thick as lw 0.01 circle
, and scaleY 3 (freeze circle)
will be
drawn with a "stretched", variable-width line.
Another way of thinking about it is that pre-freeze
, we are
transforming the "abstract idea" of a diagram, and the
transformed version is then drawn; when doing a freeze
, we
produce a concrete drawing of the diagram, and it is this visual
representation itself which is acted upon by subsequent
transformations.
setEnvelope :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Monoid' m) => Envelope v -> QDiagram b v m -> QDiagram b v mSource
Replace the envelope of a diagram.
setTrace :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Semigroup m) => Trace v -> QDiagram b v m -> QDiagram b v mSource
Replace the trace of a diagram.
Subdiagrams
data Subdiagram b v m Source
A Subdiagram
represents a diagram embedded within the context
of a larger diagram. Essentially, it consists of a diagram
paired with any accumulated information from the larger context
(transformations, attributes, etc.).
Subdiagram (QDiagram b v m) (DownAnnots v) |
Functor (Subdiagram b v) | |
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v)) => HasOrigin (Subdiagram b v m) | |
(HasLinearMap v, InnerSpace v, Floating (Scalar v)) => Transformable (Subdiagram b v m) | |
(Ord (Scalar v), VectorSpace v, HasLinearMap v) => Traced (Subdiagram b v m) | |
(OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => Enveloped (Subdiagram b v m) | |
Newtype (SubMap b v m) (Map Name [Subdiagram b v m]) |
mkSubdiagram :: QDiagram b v m -> Subdiagram b v mSource
Turn a diagram into a subdiagram with no accumulated context.
getSub :: (HasLinearMap v, InnerSpace v, Floating (Scalar v), Ord (Scalar v), Semigroup m) => Subdiagram b v m -> QDiagram b v mSource
Turn a subdiagram into a normal diagram, including the enclosing
context. Concretely, a subdiagram is a pair of (1) a diagram and
(2) a "context" consisting of an extra transformation and
attributes. getSub
simply applies the transformation and
attributes to the diagram to get the corresponding "top-level"
diagram.
rawSub :: Subdiagram b v m -> QDiagram b v mSource
Extract the "raw" content of a subdiagram, by throwing away the context.
location :: HasLinearMap v => Subdiagram b v m -> Point vSource
Get the location of a subdiagram; that is, the location of its local origin with respect to the vector space of its parent diagram. In other words, the point where its local origin "ended up".
subPoint :: (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => Point v -> Subdiagram b v mSource
Create a "point subdiagram", that is, a pointDiagram
(with no
content and a point envelope) treated as a subdiagram with local
origin at the given point. Note this is not the same as
mkSubdiagram . pointDiagram
, which would result in a subdiagram
with local origin at the parent origin, rather than at the given
point.
Subdiagram maps
A SubMap
is a map associating names to subdiagrams. There can
be multiple associations for any given name.
SubMap (Map Name [Subdiagram b v m]) |
Action Name (SubMap b v m) | A name acts on a name map by qualifying every name in it. |
Functor (SubMap b v) | |
Monoid (SubMap b v m) |
|
Semigroup (SubMap b v m) | |
Qualifiable (SubMap b v m) |
|
(OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => HasOrigin (SubMap b v m) | |
(InnerSpace v, Floating (Scalar v), HasLinearMap v) => Transformable (SubMap b v m) | |
Newtype (SubMap b v m) (Map Name [Subdiagram b v m]) | |
Newtype (QDiagram b v m) (DUALTree (DownAnnots v) (UpAnnots b v m) () (Prim b v)) |
fromNames :: IsName a => [(a, Subdiagram b v m)] -> SubMap b v mSource
Construct a SubMap
from a list of associations between names
and subdiagrams.
rememberAs :: IsName a => a -> QDiagram b v m -> SubMap b v m -> SubMap b v mSource
Add a name/diagram association to a submap.
lookupSub :: IsName n => n -> SubMap b v m -> Maybe [Subdiagram b v m]Source
Look for the given name in a name map, returning a list of subdiagrams associated with that name. If no names match the given name exactly, return all the subdiagrams associated with names of which the given name is a suffix.
Primtives
Ultimately, every diagram is essentially a list of primitives,
basic building blocks which can be rendered by backends. However,
not every backend must be able to render every type of primitive;
the collection of primitives a given backend knows how to render is
determined by instances of Renderable
.
A value of type Prim b v
is an opaque (existentially quantified)
primitive which backend b
knows how to render in vector space v
.
Prim :: Renderable p b => p -> Prim b (V p) |
HasLinearMap v => Transformable (Prim b v) | The |
HasLinearMap v => Renderable (Prim b v) b | The |
Newtype (QDiagram b v m) (DUALTree (DownAnnots v) (UpAnnots b v m) () (Prim b v)) |
nullPrim :: (HasLinearMap v, Monoid (Render b v)) => Prim b vSource
The null primitive, which every backend can render by doing nothing.
Backends
class (HasLinearMap v, Monoid (Render b v)) => Backend b v whereSource
Abstract diagrams are rendered to particular formats by
backends. Each backend/vector space combination must be an
instance of the Backend
class. A minimal complete definition
consists of the three associated types and implementations for
withStyle
and doRender
.
The type of rendering operations used by this backend, which
must be a monoid. For example, if Render b v = M ()
for some
monad M
, a monoid instance can be made with mempty = return
()
and mappend = (>>)
.
The result of running/interpreting a rendering operation.
Backend-specific rendering options.
:: b | Backend token (needed only for type inference) |
-> Style v | Style to use |
-> Transformation v | Transformation to be applied to the style |
-> Render b v | Rendering operation to run |
-> Render b v | Rendering operation using the style locally |
Perform a rendering operation with a local style.
:: b | Backend token (needed only for type inference) |
-> Options b v | Backend-specific collection of rendering options |
-> Render b v | Rendering operation to perform |
-> Result b v | Output of the rendering operation |
doRender
is used to interpret rendering operations.
adjustDia :: Monoid' m => b -> Options b v -> QDiagram b v m -> (Options b v, QDiagram b v m)Source
adjustDia
allows the backend to make adjustments to the final
diagram (e.g. to adjust the size based on the options) before
rendering it. It can also make adjustments to the options
record, usually to fill in incompletely specified size
information. A default implementation is provided which makes
no adjustments. See the diagrams-lib package for other useful
implementations.
renderDia :: (InnerSpace v, OrderedField (Scalar v), Monoid' m) => b -> Options b v -> QDiagram b v m -> Result b vSource
Render a diagram. This has a default implementation in terms
of adjustDia
, withStyle
, doRender
, and the render
operation from the Renderable
class (first adjustDia
is
used, then withStyle
and render
are used to render each
primitive, the resulting operations are combined with
mconcat
, and the final operation run with doRender
) but
backends may override it if desired.
HasLinearMap v => Backend NullBackend v |
class Backend b v => MultiBackend b v whereSource
A class for backends which support rendering multiple diagrams, e.g. to a multi-page pdf or something similar.
renderDias :: (InnerSpace v, OrderedField (Scalar v), Monoid' m) => b -> Options b v -> [QDiagram b v m] -> Result b vSource
Render multiple diagrams at once.
Null backend
data NullBackend Source
A null backend which does no actual rendering. It is provided
mainly for convenience in situations where you must give a
diagram a concrete, monomorphic type, but don't actually care
which one. See D
for more explanation and examples.
It is courteous, when defining a new primitive P
, to make an instance
instance Renderable P NullBackend where render _ _ = mempty
This ensures that the trick with D
annotations can be used for
diagrams containing your primitive.
HasLinearMap v => Backend NullBackend v | |
Monoid (Render NullBackend v) |
type D v = Diagram NullBackend vSource
The D
type is provided for convenience in situations where you
must give a diagram a concrete, monomorphic type, but don't care
which one. Such situations arise when you pass a diagram to a
function which is polymorphic in its input but monomorphic in its
output, such as width
, height
, phantom
, or names
. Such
functions compute some property of the diagram, or use it to
accomplish some other purpose, but do not result in the diagram
being rendered. If the diagram does not have a monomorphic type,
GHC complains that it cannot determine the diagram's type.
For example, here is the error we get if we try to compute the
width of an image (this example requires diagrams-lib
):
ghci> width (image "foo.png" 200 200) <interactive>:8:8: No instance for (Renderable Diagrams.TwoD.Image.Image b0) arising from a use of `image' Possible fix: add an instance declaration for (Renderable Diagrams.TwoD.Image.Image b0) In the first argument of `width', namely `(image "foo.png" 200 200)' In the expression: width (image "foo.png" 200 200) In an equation for `it': it = width (image "foo.png" 200 200)
GHC complains that there is no instance for Renderable Image
b0
; what is really going on is that it does not have enough
information to decide what backend to use (hence the
uninstantiated b0
). This is annoying because we know that the
choice of backend cannot possibly affect the width of the image
(it's 200! it's right there in the code!); but there is no way
for GHC to know that.
The solution is to annotate the call to image
with the type
, like so:
D
R2
ghci> width (image "foo.png" 200 200 :: D R2) 200.00000000000006
(It turns out the width wasn't 200 after all...)
As another example, here is the error we get if we try to compute the width of a radius-1 circle:
ghci> width (circle 1) <interactive>:4:1: Couldn't match type `V a0' with `R2' In the expression: width (circle 1) In an equation for `it': it = width (circle 1)
There's even more ambiguity here. Whereas image
always returns
a Diagram
, the circle
function can produce any PathLike
type, and the width
function can consume any Enveloped
type,
so GHC has no idea what type to pick to go in the middle.
However, the solution is the same:
ghci> width (circle 1 :: D R2) 1.9999999999999998
Renderable
class Transformable t => Renderable t b whereSource
The Renderable type class connects backends to primitives which they know how to render.
render :: b -> t -> Render b (V t)Source
Given a token representing the backend and a transformable object, render it in the appropriate rendering context.
HasLinearMap v => Renderable (Prim b v) b | The |