diagrams-core-0.5.0.1: Core libraries for diagrams EDSL

Maintainerdiagrams-discuss@googlegroups.com
Safe HaskellNone

Graphics.Rendering.Diagrams.Core

Contents

Description

The core library of primitives forming the basis of an embedded domain-specific language for describing and rendering diagrams.

Graphics.Rendering.Diagrams.Core defines types and classes for primitives, diagrams, and backends.

Synopsis

Diagrams

Annotations

type UpAnnots v m = Deletable (Envelope v) ::: (NameMap v ::: (Query v m ::: Nil))Source

Monoidal annotations which travel up the diagram tree, i.e. which are aggregated from component diagrams to the whole:

type DownAnnots v = (Split (Transformation v) :+: Style v) ::: (AM [] Name ::: Nil)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):

newtype QDiagram b v m Source

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.

Constructors

QD 

Fields

unQD :: UDTree (UpAnnots v m) (DownAnnots v) (Prim b v)
 

Instances

Typeable3 QDiagram 
Functor (QDiagram b v) 
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' 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, no named points, 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), Monoid' m) => Semigroup (QDiagram b v m) 
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' 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, Monoid' m) => Transformable (QDiagram b v m)

Diagrams can be transformed by transforming each of their components appropriately.

(HasLinearMap v, InnerSpace v, OrderedField (Scalar v)) => Enveloped (QDiagram b v m) 
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m) => Juxtaposable (QDiagram b v m) 
(HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid 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), Monoid m) => HasStyle (QDiagram b v m) 
Newtype (QDiagram b v m) (UDTree (UpAnnots v m) (DownAnnots v) (Prim b v)) 

mkQD :: Prim b v -> Envelope v -> NameMap v -> Query v m -> QDiagram b v mSource

Create a diagram from a single primitive, along with an envelope, name map, and query function.

type Diagram b v = QDiagram b v AnySource

The default sort of diagram is one where querying at a point simply tells you whether that point is occupied or not. Transforming a default diagram into one with a more interesting query can be done via the Functor instance of QDiagram b.

Operations on diagrams

Extracting information

prims :: (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m) => 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.

envelope :: (OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => QDiagram b v m -> Envelope vSource

Get the envelope of a diagram.

names :: (AdditiveGroup (Scalar v), Floating (Scalar v), InnerSpace v, HasLinearMap v) => QDiagram b v m -> NameMap vSource

Get the name map of a diagram.

query :: (HasLinearMap v, Monoid m) => QDiagram b v m -> Query v mSource

Get the query function associated with a diagram.

sample :: (HasLinearMap v, Monoid m) => QDiagram b v m -> Point v -> mSource

Sample a diagram's query function at a given point.

value :: Monoid m => m -> QDiagram b v Any -> QDiagram b v mSource

Set the query value for True points in a diagram (i.e. points inside the diagram); False points will be set to mempty.

resetValue :: (Eq m, Monoid m) => QDiagram b v m -> QDiagram b v AnySource

Reset the query values of a diagram to True/False: any values equal to mempty are set to False; any other values are set to True.

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, Monoid' 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 :: forall v b n m. (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m) => n -> QDiagram b v m -> QDiagram b v mSource

Attach an atomic name to (the local origin of) a diagram.

namePoint :: forall v b n m. (IsName n, HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m) => (QDiagram b v m -> LocatedEnvelope v) -> n -> QDiagram b v m -> QDiagram b v mSource

Attach an atomic name to a certain point and envelope, computed from the given diagram.

withName :: (IsName n, AdditiveGroup (Scalar v), Floating (Scalar v), InnerSpace v, HasLinearMap v) => n -> (LocatedEnvelope v -> 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 located envelope, perform the transformation using the most recent located envelope associated with (some qualification of) the name, or perform the identity transformation if the name does not exist.

withNameAll :: (IsName n, AdditiveGroup (Scalar v), Floating (Scalar v), InnerSpace v, HasLinearMap v) => n -> ([LocatedEnvelope v] -> 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 located envelopes, perform the transformation using the collection of all such located envelopes associated with (some qualification of) the given name.

withNames :: (IsName n, AdditiveGroup (Scalar v), Floating (Scalar v), InnerSpace v, HasLinearMap v) => [n] -> ([LocatedEnvelope v] -> 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 located envelopes, perform the transformation using the list of most recent envelopes 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), Monoid 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.

Primtives

Ultimately, every diagram is essentially a collection 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.

data Prim b v whereSource

A value of type Prim b v is an opaque (existentially quantified) primitive which backend b knows how to render in vector space v.

Constructors

Prim :: Renderable t b => t -> Prim b (V t) 

Instances

HasLinearMap v => Transformable (Prim b v)

The Transformable instance for Prim just pushes calls to transform down through the Prim constructor.

HasLinearMap v => Renderable (Prim b v) b

The Renderable instance for Prim just pushes calls to render down through the Prim constructor.

Newtype (QDiagram b v m) (UDTree (UpAnnots v m) (DownAnnots v) (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.

Associated Types

data Render b v :: *Source

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 = (>>).

type Result b v :: *Source

The result of running/interpreting a rendering operation.

data Options b v :: *Source

Backend-specific rendering options.

Methods

withStyleSource

Arguments

:: 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.

doRenderSource

Arguments

:: 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.

Instances

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.

Methods

renderDias :: 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.

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 a radius-1 circle (this example requires diagrams-lib):

 ghci> width (circle 1)

 <interactive>:1:8:
     No instances for (Backend b0 R2,
                       Renderable Diagrams.TwoD.Ellipse.Ellipse b0)
       arising from a use of `circle'
     Possible fix:
       add instance declarations for
       (Backend b0 R2, Renderable Diagrams.TwoD.Ellipse.Ellipse b0)
     In the first argument of `width', namely `(circle 1)'
     In the expression: width (circle 1)
     In an equation for `it': it = width (circle 1)

GHC complains that it cannot find an instance for "Backend b0 R2"; what is really going on is that it does not have enough information to decide which backend to use for the circle (hence the type variable b0). This is annoying because we know that the choice of backend cannot possibly affect the width of the circle; but there is no way for GHC to know that.

The solution is to annotate circle 1 with the type D R2, like so:

 ghci> width (circle 1 :: D R2)
 2.0

Renderable

class Transformable t => Renderable t b whereSource

The Renderable type class connects backends to primitives which they know how to render.

Methods

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.

Instances

(HasLinearMap v, Monoid (Render b v)) => Renderable (NullPrim v) b 
HasLinearMap v => Renderable (Prim b v) b

The Renderable instance for Prim just pushes calls to render down through the Prim constructor.