diff --git a/CHANGES.markdown b/CHANGES.markdown
--- a/CHANGES.markdown
+++ b/CHANGES.markdown
@@ -1,3 +1,47 @@
+1.2 (27 May 2014)
+-----------------
+
+* **New features**
+
+ - New function `matrixHomRep` to convert a transformation to a
+ homogeneous matrix representation.
+
+ - New function `dropTransl` to drop the translation component
+ from a transformation.
+
+ - A mini-DSL for Measures.
+
+ - New `extent` function, used in `diameter`.
+
+ - New `dimension` function to return the dimension of a vector space.
+
+ - New `_relative` iso between points and vectors.
+
+ - `avgScale` function (for computing the average scaling factor of
+ a transformation) has been moved from `diagrams-lib` to
+ `diagrams-core` and generalized to work over any vector space.
+
+* **Dependency/version changes**
+
+ - Allow `semigroups-0.15`
+ - Allow `lens-4.2`
+
+* **API changes**
+
+ - Major refactoring which removes `freeze` (and hence `Split` transforms,
+ etc.) and adds units of `Measure`.
+
+ - Refactoring and simplification of the `Backend` class.
+
+ - Remove `Multibackend`.
+
+ - Remove `nullPrim`, `IsPrim` and simplify `RPrim` so that it does not
+ carry a transformation.
+
+ - Update `adjustDia` to return a transformation, not just a scale factor.
+ Add `renderDiaT` which returns a transformation (for use by end
+ users, e.g. to convert output coordinates back into local coordinates).
+
1.1.0.3 (15 May 2014)
----------------------
diff --git a/diagrams-core.cabal b/diagrams-core.cabal
--- a/diagrams-core.cabal
+++ b/diagrams-core.cabal
@@ -1,5 +1,5 @@
Name: diagrams-core
-Version: 1.1.0.3
+Version: 1.2
Synopsis: Core libraries for diagrams EDSL
Description: The core modules underlying diagrams,
an embedded domain-specific language
@@ -37,15 +37,14 @@
Build-depends: base >= 4.2 && < 4.8,
containers >= 0.4.2 && < 0.6,
- semigroups >= 0.8.4 && < 0.15,
+ semigroups >= 0.8.4 && < 0.16,
vector-space >= 0.8.4 && < 0.9,
vector-space-points >= 0.1 && < 0.3,
MemoTrie >= 0.4.7 && < 0.7,
newtype >= 0.2 && < 0.3,
monoid-extras >= 0.3 && < 0.4,
dual-tree >= 0.2 && < 0.3,
- lens >= 4.0 && < 4.2
-
+ lens >= 4.0 && < 4.3
hs-source-dirs: src
Other-extensions: DeriveDataTypeable
diff --git a/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg b/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg b/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg b/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg b/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg b/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg b/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_traceEx.svg b/diagrams/src_Diagrams_Core_Trace_traceEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_traceEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_traceEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_tracePEx.svg b/diagrams/src_Diagrams_Core_Trace_tracePEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_tracePEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_tracePEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/diagrams/src_Diagrams_Core_Trace_traceVEx.svg b/diagrams/src_Diagrams_Core_Trace_traceVEx.svg
--- a/diagrams/src_Diagrams_Core_Trace_traceVEx.svg
+++ b/diagrams/src_Diagrams_Core_Trace_traceVEx.svg
@@ -1,4 +1,4 @@
-
+
diff --git a/src/Diagrams/Core.hs b/src/Diagrams/Core.hs
--- a/src/Diagrams/Core.hs
+++ b/src/Diagrams/Core.hs
@@ -29,11 +29,13 @@
-- * Points
, Point, origin, (*.)
+ , _relative
-- * Transformations
-- ** Utilities
, basis
+ , dimension
, determinant
-- ** Invertible linear transformations
@@ -42,6 +44,7 @@
-- ** General transformations
, Transformation
, inv, transp, transl
+ , dropTransl
, apply
, papply
, fromLinear
@@ -49,6 +52,7 @@
-- ** Some specific transformations
, translation, translate, moveTo, place
, scaling, scale
+ , avgScale
-- ** The Transformable class
@@ -75,11 +79,11 @@
-- * Attributes and styles
, AttributeClass
- , Attribute, mkAttr, mkTAttr, unwrapAttr
+ , Attribute, mkAttr, mkTAttr, mkGTAttr, unwrapAttr
, Style, HasStyle(..)
, getAttr, combineAttr
- , applyAttr, applyTAttr
+ , applyAttr, applyTAttr, applyGTAttr
-- * Envelopes
@@ -114,12 +118,11 @@
-- * Primtives
- , Prim(..), IsPrim(..), nullPrim
+ , Prim(..)
-- * Diagrams
, QDiagram, Diagram, mkQD, pointDiagram
- , prims
, envelope, trace, subMap, names, query, sample
, value, resetValue, clearValue
@@ -131,7 +134,7 @@
, href
- , freeze, setEnvelope, setTrace
+ , setEnvelope, setTrace
, atop
@@ -142,12 +145,21 @@
, location
, subPoint
+ -- * Measurements
+ , Measure(..)
+ , fromOutput
+ , toOutput
+ , atMost
+ , atLeast
+
-- * Backends
, Backend(..)
- , MultiBackend(..)
, Renderable(..)
+ , renderDia
+ , renderDiaT
+
-- ** The null backend
, NullBackend, D
@@ -160,6 +172,7 @@
) where
+import Diagrams.Core.Compile
import Diagrams.Core.Envelope
import Diagrams.Core.HasOrigin
import Diagrams.Core.Juxtapose
diff --git a/src/Diagrams/Core/Compile.hs b/src/Diagrams/Core/Compile.hs
--- a/src/Diagrams/Core/Compile.hs
+++ b/src/Diagrams/Core/Compile.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
@@ -17,30 +21,45 @@
, RTree
, toRTree
- -- * Internals
+ -- * Backend API
+ , renderDia
+ , renderDiaT
+
+ -- * Internals
+
, toDTree
, fromDTree
+ , styleToOutput
+ , toOutput
)
where
-import qualified Data.List.NonEmpty as NEL
-import Data.Maybe (fromMaybe)
+import Data.Data
+import qualified Data.List.NonEmpty as NEL
+import Data.Maybe (fromMaybe)
import Data.Monoid.Coproduct
import Data.Monoid.MList
-import Data.Monoid.Split
+import Data.Monoid.WithSemigroup (Monoid')
import Data.Semigroup
import Data.Tree
import Data.Tree.DUAL
+import Data.VectorSpace
+import Diagrams.Core.Envelope (OrderedField, diameter)
+import Diagrams.Core.Style
import Diagrams.Core.Transform
import Diagrams.Core.Types
emptyDTree :: Tree (DNode b v a)
emptyDTree = Node DEmpty []
+uncurry3 :: (a -> b -> c -> r) -> (a, b, c) -> r
+uncurry3 f (x, y, z) = f x y z
+
-- | Convert a @QDiagram@ into a raw tree.
-toDTree :: HasLinearMap v => QDiagram b v m -> Maybe (DTree b v Annotation)
-toDTree (QD qd)
+toDTree :: HasLinearMap v => Scalar v -> Scalar v -> QDiagram b v m
+ -> Maybe (DTree b v Annotation)
+toDTree g n (QD qd)
= foldDUAL
-- Prims at the leaves. We ignore the accumulated d-annotations
@@ -56,7 +75,8 @@
-- the continuation, convert the result to a DTree, and
-- splice it in, adding a DDelay node to mark the point
-- of the splice.
- (Node DDelay . (:[]) . fromMaybe emptyDTree . toDTree . ($d))
+ (Node DDelay . (:[]) . fromMaybe emptyDTree . toDTree g n
+ . ($ (d, g, n)) . uncurry3)
)
-- u-only leaves --> empty DTree. We don't care about the
@@ -86,39 +106,32 @@
qd
-- | Convert a @DTree@ to an @RTree@ which can be used dirctly by backends.
--- A @DTree@ includes nodes of type @DTransform (Split (Transformation v))@;
--- in the @RTree@ the frozen part of the transform is put in a node of type
--- @RFrozenTr (Transformation v)@ and the unfrozen part is pushed down until
--- it is either frozen or reaches a primitive node.
+-- A @DTree@ includes nodes of type @DTransform (Transformation v)@;
+-- in the @RTree@ transform is pushed down until it reaches a primitive node.
fromDTree :: HasLinearMap v => DTree b v Annotation -> RTree b v Annotation
fromDTree = fromDTree' mempty
where
fromDTree' :: HasLinearMap v => Transformation v -> DTree b v Annotation -> RTree b v Annotation
- -- We put the accumulated unfrozen transformation (accTr) and the prim
+ -- We put the accumulated transformation (accTr) and the prim
-- into an RPrim node.
fromDTree' accTr (Node (DPrim p) _)
- = Node (RPrim accTr p) []
+ = Node (RPrim (transform accTr p)) []
-- Styles are transformed then stored in their own node
-- and accTr is push down the tree.
fromDTree' accTr (Node (DStyle s) ts)
= Node (RStyle (transform accTr s)) (fmap (fromDTree' accTr) ts)
- -- Unfrozen transformations are accumulated and pushed down as well.
- fromDTree' accTr (Node (DTransform (M tr)) ts)
+ -- Transformations are accumulated and pushed down as well.
+ fromDTree' accTr (Node (DTransform tr) ts)
= Node REmpty (fmap (fromDTree' (accTr <> tr)) ts)
- -- Frozen transformations are stored in the RFrozenTr node
- -- and accTr is reset to the unfrozen part of the transform.
- fromDTree' accTr (Node (DTransform (tr1 :| tr2)) ts)
- = Node (RFrozenTr (accTr <> tr1)) (fmap (fromDTree' tr2) ts)
-
fromDTree' accTr (Node (DAnnot a) ts)
= Node (RAnnot a) (fmap (fromDTree' accTr) ts)
-- Drop accumulated transformations upon encountering a DDelay
-- node --- the tree unfolded beneath it already took into account
- -- any non-frozen transformation at this point.
+ -- any transformation at this point.
fromDTree' _ (Node DDelay ts)
= Node REmpty (fmap (fromDTree' mempty) ts)
@@ -126,7 +139,94 @@
fromDTree' accTr (Node _ ts)
= Node REmpty (fmap (fromDTree' accTr) ts)
--- | Compile a @QDiagram@ into an 'RTree'. Suitable for use by
--- backends when implementing 'renderData'.
-toRTree :: HasLinearMap v => QDiagram b v m -> RTree b v Annotation
-toRTree = fromDTree . fromMaybe (Node DEmpty []) . toDTree
+-- | Compile a @QDiagram@ into an 'RTree', rewriting styles with the
+-- given function along the way. Suitable for use by backends when
+-- implementing 'renderData'. The first argument is the
+-- transformation used to convert the diagram from local to output
+-- units.
+toRTree
+ :: (HasLinearMap v, InnerSpace v, Data v, Data (Scalar v), OrderedField (Scalar v), Monoid m, Semigroup m)
+ => Transformation v -> QDiagram b v m -> RTree b v Annotation
+toRTree globalToOutput d
+ = (fmap . onRStyle) (styleToOutput gToO nToO)
+ . fromDTree
+ . fromMaybe (Node DEmpty [])
+ . toDTree gToO nToO
+ $ d
+ where
+ gToO = avgScale globalToOutput
+
+ -- Scaling factor from normalized units to output units: nth root
+ -- of product of diameters along each basis direction. Note at
+ -- this point the diagram has already had the globalToOutput
+ -- transformation applied, so output = global = local units.
+ nToO = product (map (\v -> diameter v d) basis) ** (1 / fromIntegral (dimension d))
+
+-- | Apply a style transformation on 'RStyle' nodes; the identity for
+-- other 'RNode's.
+onRStyle :: (Style v -> Style v) -> (RNode b v a -> RNode b v a)
+onRStyle f (RStyle s) = RStyle (f s)
+onRStyle _ n = n
+
+-- | Convert all 'Measure' values to 'Output' units. The arguments
+-- are, respectively, the scaling factor from global units to output
+-- units, and from normalized units to output units. It is assumed
+-- that local units are identical to output units (which will be the
+-- case if all transformations have been fully pushed down and
+-- applied). Normalized units are based on a logical diagram size of
+-- 1 x 1.
+styleToOutput
+ :: forall v. (Data v, Data (Scalar v), Num (Scalar v), Ord (Scalar v), Fractional (Scalar v))
+ => Scalar v -> Scalar v -> Style v -> Style v
+styleToOutput globalToOutput normToOutput =
+ gmapAttrs (toOutput globalToOutput normToOutput :: Measure v -> Measure v)
+
+-- | Convert an aribrary 'Measure' to 'Output' units.
+toOutput :: forall v. (Data v, Data (Scalar v), Num (Scalar v), Ord (Scalar v), Fractional (Scalar v))
+ => Scalar v -> Scalar v -> Measure v -> Measure v
+toOutput g n m =
+ case m of
+ m'@(Output _) -> m'
+ Local s -> Output s
+ Global s -> Output (g * s)
+ Normalized s -> Output (n * s)
+
+ MinM m1 m2 -> outBin min (toOutput g n m1) (toOutput g n m2)
+ MaxM m1 m2 -> outBin max (toOutput g n m1) (toOutput g n m2)
+ ZeroM -> Output 0
+ NegateM m' -> outUn negate (toOutput g n m')
+ PlusM m1 m2 -> outBin (+) (toOutput g n m1) (toOutput g n m2)
+ ScaleM s m' -> outUn (s*) (toOutput g n m')
+ where
+ outUn op (Output o1) = Output (op o1)
+ outUn _ _ = error "outUn: The sky is falling!"
+ outBin op (Output o1) (Output o2) = Output (o1 `op` o2)
+ outBin _ _ _ = error "outBin: Both skies are falling!"
+
+
+--------------------------------------------------
+
+-- | Render a diagram, returning also the transformation which was
+-- used to convert the diagram from its (\"global\") coordinate
+-- system into the output coordinate system. The inverse of this
+-- transformation can be used, for example, to convert output/screen
+-- coordinates back into diagram coordinates. See also 'adjustDia'.
+renderDiaT
+ :: ( Backend b v
+ , HasLinearMap v, InnerSpace v, Data v
+ , OrderedField (Scalar v), Data (Scalar v)
+ , Monoid' m
+ )
+ => b -> Options b v -> QDiagram b v m -> (Transformation v, Result b v)
+renderDiaT b opts d = (g2o, renderRTree b opts' . toRTree g2o $ d')
+ where (opts', g2o, d') = adjustDia b opts d
+
+-- | Render a diagram.
+renderDia
+ :: ( Backend b v
+ , InnerSpace v, Data v
+ , OrderedField (Scalar v), Data (Scalar v)
+ , Monoid' m
+ )
+ => b -> Options b v -> QDiagram b v m -> Result b v
+renderDia b opts d = snd (renderDiaT b opts d)
diff --git a/src/Diagrams/Core/Envelope.hs b/src/Diagrams/Core/Envelope.hs
--- a/src/Diagrams/Core/Envelope.hs
+++ b/src/Diagrams/Core/Envelope.hs
@@ -3,9 +3,9 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Diagrams.Envelope
@@ -36,6 +36,7 @@
-- * Utility functions
, diameter
, radius
+ , extent
, envelopeVMay, envelopeV, envelopePMay, envelopeP, envelopeSMay, envelopeS
-- * Miscellaneous
@@ -43,8 +44,8 @@
) where
import Control.Applicative ((<$>))
-import Control.Lens (Wrapped(..), Rewrapped, iso, over, mapped
- , _Wrapping', op)
+import Control.Lens (Rewrapped, Wrapped (..), iso, mapped,
+ op, over, _Wrapping')
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Semigroup
@@ -255,11 +256,16 @@
-- | Compute the diameter of a enveloped object along a particular
-- vector. Returns zero for the empty envelope.
diameter :: Enveloped a => V a -> a -> Scalar (V a)
-diameter v a = case appEnvelope $ getEnvelope a of
- (Just env) -> (env v + env (negateV v)) * magnitude v
- Nothing -> 0
+diameter v a = maybe 0 (\(lo,hi) -> (hi - lo) * magnitude v) (extent v a)
-- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object
-- along a particular vector.
radius :: Enveloped a => V a -> a -> Scalar (V a)
radius v = (0.5*) . diameter v
+
+-- | Compute the range of an enveloped object along a certain
+-- direction. Returns a pair of scalars @(lo,hi)@ such that the
+-- object extends from @(lo *^ v)@ to @(hi *^ v)@. Returns @Nothing@
+-- for objects with an empty envelope.
+extent :: Enveloped a => V a -> a -> Maybe (Scalar (V a), Scalar (V a))
+extent v a = (\f -> (-f (negateV v), f v)) <$> (appEnvelope . getEnvelope $ a)
diff --git a/src/Diagrams/Core/Points.hs b/src/Diagrams/Core/Points.hs
--- a/src/Diagrams/Core/Points.hs
+++ b/src/Diagrams/Core/Points.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE TypeFamilies
- #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Diagrams.Core.Points
@@ -15,14 +17,24 @@
( -- * Points
Point(..), origin, (*.)
+ , _relative
) where
--- We just import from Data.AffineSpace.Point (defined in the
+-- We import from Data.AffineSpace.Point (defined in the
-- vector-space-points package) and re-export. We also define an
-- instance of V for Point here.
+
+import Control.Lens (Iso', iso)
+
import Data.AffineSpace.Point
+import Data.AffineSpace
import Diagrams.Core.V
type instance V (Point v) = v
+
+-- | An isomorphism between points and vectors, given a reference
+-- point. This is provided for defining new lenses on points.
+_relative :: AffineSpace (Point v) => Point v -> Iso' (Point v) v
+_relative p0 = iso (.-. p0) (p0 .+^)
diff --git a/src/Diagrams/Core/Style.hs b/src/Diagrams/Core/Style.hs
--- a/src/Diagrams/Core/Style.hs
+++ b/src/Diagrams/Core/Style.hs
@@ -1,12 +1,13 @@
-{-# LANGUAGE ScopedTypeVariables
- , GADTs
- , KindSignatures
- , FlexibleInstances
- , MultiParamTypeClasses
- , TemplateHaskell
- , TypeFamilies
- , UndecidableInstances
- #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
-- The UndecidableInstances flag is needed under 6.12.3 for the
-- HasStyle (a,b) instance.
@@ -29,28 +30,31 @@
AttributeClass
, Attribute(..)
- , mkAttr, mkTAttr, unwrapAttr
- , applyAttr, applyTAttr
+ , mkAttr, mkTAttr, mkGTAttr, unwrapAttr
+ , applyAttr, applyTAttr, applyGTAttr
-- * Styles
-- $style
, Style(..)
- , attrToStyle, tAttrToStyle
+ , attrToStyle, tAttrToStyle, gtAttrToStyle
, getAttr, setAttr, addAttr, combineAttr
+ , gmapAttrs
, HasStyle(..)
) where
-import Control.Arrow ((***))
-import Control.Lens (Wrapped(..), Rewrapped, iso)
-import qualified Data.Map as M
+import Control.Arrow ((***))
+import Control.Lens (Rewrapped, Wrapped (..), iso, (%~),
+ (&))
+import Data.Data
+import Data.Data.Lens (template)
+import qualified Data.Map as M
import Data.Semigroup
-import qualified Data.Set as S
-import Data.Typeable
+import qualified Data.Set as S
-import Data.Monoid.Action
+import Data.Monoid.Action
import Diagrams.Core.Transform
import Diagrams.Core.V
@@ -82,11 +86,21 @@
class (Typeable a, Semigroup a) => AttributeClass a where
-- | An existential wrapper type to hold attributes. Some attributes
--- are affected by transformations and some are not.
+-- are simply inert/static; some are affected by transformations;
+-- and some are affected by transformations and can be modified
+-- generically.
data Attribute v :: * where
- Attribute :: AttributeClass a => a -> Attribute v
- TAttribute :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v
+ Attribute :: AttributeClass a => a -> Attribute v
+ TAttribute :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v
+ GTAttribute :: (AttributeClass a, Data a, Transformable a, V a ~ v) => a -> Attribute v
+ -- Note: one could imagine requiring all attributes to be generic,
+ -- but adding Data instances for everything would be a big pain in
+ -- the butt, especially for things in other packages which don't
+ -- export their constructors (e.g. FingerTree). Having three
+ -- different attribute wrappers is not ideal but it's far less work
+ -- than the alternative.
+
type instance V (Attribute v) = v
-- | Wrap up an attribute.
@@ -97,14 +111,19 @@
mkTAttr :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v
mkTAttr = TAttribute
+-- | Wrap up a transformable and generic attribute.
+mkGTAttr :: (AttributeClass a, Data a, Transformable a, V a ~ v) => a -> Attribute v
+mkGTAttr = GTAttribute
+
-- | Unwrap an unknown 'Attribute' type, performing a dynamic (but
-- safe) check on the type of the result. If the required type
-- matches the type of the attribute, the attribute value is
-- returned wrapped in @Just@; if the types do not match, @Nothing@
-- is returned.
unwrapAttr :: AttributeClass a => Attribute v -> Maybe a
-unwrapAttr (Attribute a) = cast a
-unwrapAttr (TAttribute a) = cast a
+unwrapAttr (Attribute a) = cast a
+unwrapAttr (TAttribute a) = cast a
+unwrapAttr (GTAttribute a) = cast a
-- | Attributes form a semigroup, where the semigroup operation simply
-- returns the right-hand attribute when the types do not match, and
@@ -119,10 +138,15 @@
case unwrapAttr a2 of
Nothing -> a2
Just a2' -> TAttribute (a1 <> a2')
+ (GTAttribute a1) <> a2 =
+ case unwrapAttr a2 of
+ Nothing -> a2
+ Just a2' -> GTAttribute (a1 <> a2')
instance HasLinearMap v => Transformable (Attribute v) where
- transform _ (Attribute a) = Attribute a
- transform t (TAttribute a) = TAttribute (transform t a)
+ transform _ (Attribute a) = Attribute a
+ transform t (TAttribute a) = TAttribute (transform t a)
+ transform t (GTAttribute a) = GTAttribute (transform t a)
------------------------------------------------------------
-- Styles ------------------------------------------------
@@ -170,6 +194,10 @@
tAttrToStyle :: forall a v. (AttributeClass a, Transformable a, V a ~ v) => a -> Style v
tAttrToStyle a = Style (M.singleton (show . typeOf $ (undefined :: a)) (mkTAttr a))
+-- | Create a style from a single transformable, generic attribute.
+gtAttrToStyle :: forall a v. (AttributeClass a, Data a, Transformable a, V a ~ v) => a -> Style v
+gtAttrToStyle a = Style (M.singleton (show . typeOf $ (undefined :: a)) (mkGTAttr a))
+
-- | Add a new attribute to a style, or replace the old attribute of
-- the same type if one exists.
setAttr :: forall a v. AttributeClass a => a -> Style v -> Style v
@@ -189,6 +217,17 @@
Nothing -> setAttr a s
Just a' -> setAttr (a <> a') s
+-- | Map generically over all generic attributes in a style, applying
+-- the given function to any values with the given type, even deeply
+-- nested ones. Note that only attributes wrapped in 'GTAttribute'
+-- are affected.
+gmapAttrs :: forall v a. Typeable a => (a -> a) -> Style v -> Style v
+gmapAttrs f = (inStyle . M.map) gmapAttr
+ where
+ gmapAttr :: Attribute v -> Attribute v
+ gmapAttr (GTAttribute a) = GTAttribute (a & template %~ f)
+ gmapAttr a = a
+
instance Semigroup (Style v) where
Style s1 <> Style s2 = Style $ M.unionWith (<>) s1 s2
@@ -245,3 +284,6 @@
-- structure.
applyTAttr :: (AttributeClass a, Transformable a, V a ~ V d, HasStyle d) => a -> d -> d
applyTAttr = applyStyle . tAttrToStyle
+
+applyGTAttr :: (AttributeClass a, Data a, Transformable a, V a ~ V d, HasStyle d) => a -> d -> d
+applyGTAttr = applyStyle . gtAttrToStyle
diff --git a/src/Diagrams/Core/Trace.hs b/src/Diagrams/Core/Trace.hs
--- a/src/Diagrams/Core/Trace.hs
+++ b/src/Diagrams/Core/Trace.hs
@@ -383,13 +383,13 @@
-- > pointB = 1 ^& 1.2
-- > pointC = 2.5 ^& 3.5
-- >
--- > dot = circle 0.05 # lw 0
+-- > dot = circle 0.05 # lw none
-- >
-- > mkTraceDia :: TraceDiaOpts -> Diagram B R2
-- > mkTraceDia tdo = mconcat
-- > [ mconcat $ map (place (dot # fc red)) pts
-- > , if drawV tdo then resultArrow else mempty
--- > , arrowAt (basePt tdo) (dirV tdo) # lw 0.02 # lc blue
+-- > , arrowAt (basePt tdo) (dirV tdo) # lc blue
-- > , dot # fc blue # moveTo (basePt tdo)
-- > , traceLine (basePt tdo) maxPosPt
-- > , traceLine (basePt tdo) minNegPt
@@ -405,7 +405,7 @@
-- > minNegPt = (mkPt <$>) . safeHead $ filter (<0) ss
-- > minPt = (mkPt <$>) . safeHead $ ss
-- > resultArrow = fromMaybe mempty (arrowBetween (basePt tdo) <$> minPt)
--- > # lw 0.03 # lc green
+-- > # lc green
-- >
-- > safeLast [] = Nothing
-- > safeLast xs = Just $ last xs
@@ -415,7 +415,7 @@
-- > dropAllBut1 xs = [last xs]
-- >
-- > traceLine _ Nothing = mempty
--- > traceLine p (Just q) = (p ~~ q) # dashing [0.1,0.1] 0
+-- > traceLine p (Just q) = (p ~~ q) # dashingG [0.1,0.1] 0
-- >
-- > mkTraceDias :: [TraceDiaOpts] -> Diagram B R2
-- > mkTraceDias = hcat' (with & sep .~ 1) . map mkTraceDia
diff --git a/src/Diagrams/Core/Transform.hs b/src/Diagrams/Core/Transform.hs
--- a/src/Diagrams/Core/Transform.hs
+++ b/src/Diagrams/Core/Transform.hs
@@ -37,13 +37,18 @@
-- ** General transformations
, Transformation(..)
, inv, transp, transl
+ , dropTransl
, apply
, papply
, fromLinear
, basis
+ , dimension
, onBasis
+ , listRep
, matrixRep
+ , matrixHomRep
, determinant
+ , avgScale
-- * The Transformable class
@@ -159,6 +164,11 @@
transl :: Transformation v -> v
transl (Transformation _ _ v) = v
+-- | Drop the translational component of a transformation, leaving only
+-- the linear part.
+dropTransl :: AdditiveGroup v => Transformation v -> Transformation v
+dropTransl (Transformation a a' _) = Transformation a a' zeroV
+
-- | Transformations are closed under composition; @t1 <> t2@ is the
-- transformation which performs first @t2@, then @t1@.
instance HasLinearMap v => Semigroup (Transformation v) where
@@ -195,6 +205,12 @@
basis :: forall v. HasLinearMap v => [v]
basis = map basisValue b
where b = map fst (decompose (zeroV :: v))
+
+-- | Get the dimension of an object whose vector space is an instance of
+-- @HasLinearMap@, e.g. transformations, paths, diagrams, etc.
+dimension :: forall a. HasLinearMap (V a) => a -> Int
+dimension _ = length (decompose (zeroV :: V a))
+
-- | Get the matrix equivalent of the linear transform,
-- (as a list of columns) and the translation vector. This
-- is mostly useful for implementing backends.
@@ -223,15 +239,56 @@
c1 = head m
n = length m
+-- | Convert a vector v to a list of scalars.
+listRep :: HasLinearMap v => v -> [Scalar v]
+listRep v = map snd (decompose v)
+
-- | Convert a `Transformation v` to a matrix representation as a list of
-- column vectors which are also lists.
matrixRep :: HasLinearMap v => Transformation v -> [[Scalar v]]
matrixRep t = map listRep (fst . onBasis $ t)
- where listRep v = map snd (decompose v)
+-- | Convert a `Transformation v` to a homogeneous matrix representation.
+-- The final list is the translation.
+-- The representation leaves off the last row of the matrix as it is
+-- always [0,0, ... 1] and this representation is the defacto standard
+-- for backends.
+matrixHomRep :: HasLinearMap v => Transformation v -> [[Scalar v]]
+matrixHomRep t = mr ++ [listRep tl]
+ where
+ mr = matrixRep t
+ tl = transl t
+
-- | The determinant of a `Transformation`.
determinant :: (HasLinearMap v, Num (Scalar v)) => Transformation v -> Scalar v
determinant t = det . matrixRep $ t
+
+-- | Compute the \"average\" amount of scaling performed by a
+-- transformation. Satisfies the properties
+--
+-- @
+-- avgScale (scaling k) == k
+-- avgScale (t1 <> t2) == avgScale t1 * avgScale t2
+-- @
+--
+avgScale :: (HasLinearMap v, Floating (Scalar v)) => Transformation v -> Scalar v
+avgScale t = (abs . determinant $ t) ** (1 / fromIntegral (dimension t))
+
+{-
+
+avgScale is computed as the nth root of the positive determinant.
+This works because the determinant is the factor by which a transformation
+scales area/volume. See http://en.wikipedia.org/wiki/Determinant.
+
+Proofs for the specified properties:
+
+1. |det (scaling k)|^(1/n) = (k^n)^(1/n) = k
+2. |det t1|^(1/n) * |det t2|^(1/n)
+ = (|det t1| * |det t2|)^(1/n)
+ = |det t1 * det t2|^(1/n)
+ = |det (t1 <> t2)|^(1/n)
+
+-}
------------------------------------------------------------
-- The Transformable class -------------------------------
diff --git a/src/Diagrams/Core/Types.hs b/src/Diagrams/Core/Types.hs
--- a/src/Diagrams/Core/Types.hs
+++ b/src/Diagrams/Core/Types.hs
@@ -8,6 +8,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@@ -62,7 +63,6 @@
, mkQD, mkQD', pointDiagram
-- ** Extracting information
- , prims
, envelope, trace, subMap, names, query, sample
, value, resetValue, clearValue
@@ -83,10 +83,14 @@
, localize
-- *** Other
- , freeze
, setEnvelope
, setTrace
+ -- * Measurements
+ , Measure(..)
+ , fromOutput
+ , atMost, atLeast
+
-- * Subdiagrams
, Subdiagram(..), mkSubdiagram
@@ -103,12 +107,11 @@
-- * Primtives
-- $prim
- , Prim(..), IsPrim(..), nullPrim
+ , Prim(..)
-- * Backends
, Backend(..)
- , MultiBackend(..)
, DNode(..)
, DTree
, RNode(..)
@@ -130,20 +133,19 @@
_Wrapping)
import Control.Monad (mplus)
import Data.AffineSpace ((.-.))
+import Data.Data
import Data.List (isSuffixOf)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Semigroup
import qualified Data.Traversable as T
import Data.Tree
-import Data.Typeable
import Data.VectorSpace
import Data.Monoid.Action
import Data.Monoid.Coproduct
import Data.Monoid.Deletable
import Data.Monoid.MList
-import Data.Monoid.Split
import Data.Monoid.WithSemigroup
import qualified Data.Tree.DUAL as D
@@ -162,6 +164,93 @@
-- documentation! Haddock supports \<\\>.
------------------------------------------------------------
+-- Measurement Units -------------------------------------
+------------------------------------------------------------
+-- | Type of measurement units for attributes.
+data Measure v = Output (Scalar v)
+ | Normalized (Scalar v)
+ | Local (Scalar v)
+ | Global (Scalar v)
+
+ | MinM (Measure v) (Measure v)
+ | MaxM (Measure v) (Measure v)
+ | ZeroM
+ | NegateM (Measure v)
+ | PlusM (Measure v) (Measure v)
+ | ScaleM (Scalar v) (Measure v)
+ deriving (Typeable)
+
+deriving instance (Eq (Scalar v)) => Eq (Measure v)
+deriving instance (Ord (Scalar v)) => Ord (Measure v)
+deriving instance (Show (Scalar v)) => Show (Measure v)
+deriving instance (Typeable v, Data v, Data (Scalar v)) => Data (Measure v)
+
+-- | Compute the larger of two 'Measure's. Useful for setting lower
+-- bounds.
+atLeast :: Measure v -> Measure v -> Measure v
+atLeast = MaxM
+
+-- | Compute the smaller of two 'Measure's. Useful for setting upper
+-- bounds.
+atMost :: Measure v -> Measure v -> Measure v
+atMost = MinM
+
+instance AdditiveGroup (Measure v) where
+ zeroV = ZeroM
+ negateV (NegateM m) = m
+ negateV m = NegateM m
+ ZeroM ^+^ m = m
+ m ^+^ ZeroM = m
+ m1 ^+^ m2 = PlusM m1 m2
+
+instance VectorSpace (Measure v) where
+ type Scalar (Measure v) = Scalar v
+ s *^ m = ScaleM s m
+
+type instance V (Measure v) = v
+
+instance (HasLinearMap v, Floating (Scalar v)) => Transformable (Measure v) where
+ transform tr (Local x) = Local (avgScale tr * x)
+ transform _ y = y
+
+-- | Retrieve the 'Output' value of a 'Measure v' or throw an exception.
+-- Only 'Ouput' measures should be left in the 'RTree' passed to the backend.
+fromOutput :: Measure v -> Scalar v
+fromOutput (Output w) = w
+fromOutput (Normalized _) = fromOutputErr "Normalized"
+fromOutput (Local _) = fromOutputErr "Local"
+fromOutput (Global _) = fromOutputErr "Global"
+fromOutput (MinM _ _) = fromOutputErr "MinM"
+fromOutput (MaxM _ _) = fromOutputErr "MaxM"
+fromOutput (ZeroM) = fromOutputErr "ZeroM"
+fromOutput (NegateM _) = fromOutputErr "NegateM"
+fromOutput (PlusM _ _) = fromOutputErr "PlusM"
+fromOutput (ScaleM _ _) = fromOutputErr "ScaleM"
+
+fromOutputErr :: String -> a
+fromOutputErr s = error $ "fromOutput: Cannot pass " ++ s ++ " to backends, must be Output."
+
+-- Eventually we may use a GADT like:
+--
+-- data Measure o v where
+-- Output :: Scalar v -> Measure O v
+-- Normalized :: Scalar v -> Measure A v
+-- Global :: Scalar v -> Measure A v
+-- Local :: Scale v -> Measure A v
+--
+-- to check this at compile time. But for now we throw a runtime error.
+--
+-- [BAY 4 April 2014] I tried switching to such a GADT. One tricky
+-- bit is that you have to use Output :: Scalar v -> Measure o v,
+-- not Measure O v: the reason is that operations like addition have
+-- to take two values of the same type, so in order to be able to
+-- add Output to something else, Output must be able to have an A
+-- annotation. That all works fine. The problem is with gmapAttrs,
+-- which has to preserve type: so we can't generically convert from
+-- Measure A to Measure O.
+
+
+------------------------------------------------------------
-- Diagrams ----------------------------------------------
------------------------------------------------------------
@@ -190,13 +279,10 @@
-- /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")
-type DownAnnots v = (Split (Transformation v) :+: Style v)
+type DownAnnots v = (Transformation v :+: Style v)
::: Name
::: ()
@@ -209,13 +295,12 @@
transfToAnnot :: Transformation v -> DownAnnots v
transfToAnnot
= inj
- . (inL :: Split (Transformation v) -> Split (Transformation v) :+: Style v)
- . M
+ . (inL :: Transformation v -> Transformation v :+: Style v)
-- | Extract the (total) transformation from a downwards annotation
-- value.
transfFromAnnot :: HasLinearMap v => DownAnnots v -> Transformation v
-transfFromAnnot = option mempty (unsplit . killR) . fst
+transfFromAnnot = option mempty killR . fst
-- | A leaf in a 'QDiagram' tree is either a 'Prim', or a \"delayed\"
-- @QDiagram@ which expands to a real @QDiagram@ once it learns the
@@ -225,18 +310,18 @@
-- scale-invariant).
data QDiaLeaf b v m
= PrimLeaf (Prim b v)
- | DelayedLeaf (DownAnnots v -> QDiagram b v m)
+ | DelayedLeaf (DownAnnots v -> Scalar v -> Scalar v -> QDiagram b v m)
-- ^ The @QDiagram@ produced by a @DelayedLeaf@ function /must/
- -- already apply any non-frozen transformation in the given
- -- @DownAnnots@ (that is, the non-frozen transformation will not
- -- be applied by the context). On the other hand, it must assume
- -- that any frozen transformation or attributes will be applied
- -- by the context.
+ -- already apply any transformation in the given
+ -- @DownAnnots@ (that is, the transformation will not
+ -- be applied by the context).
deriving (Functor)
-withQDiaLeaf :: (Prim b v -> r) -> ((DownAnnots v -> QDiagram b v m) -> r) -> (QDiaLeaf b v m -> r)
+withQDiaLeaf :: (Prim b v -> r)
+ -> ((DownAnnots v -> Scalar v -> Scalar v -> QDiagram b v m) -> r)
+ -> (QDiaLeaf b v m -> r)
withQDiaLeaf f _ (PrimLeaf p) = f p
-withQDiaLeaf _ g (DelayedLeaf d) = g d
+withQDiaLeaf _ g (DelayedLeaf dgn) = g dgn
-- | Static annotations which can be placed at a particular node of a
-- diagram tree.
@@ -286,17 +371,6 @@
=> Point v -> QDiagram b v m
pointDiagram p = QD $ D.leafU (inj . toDeletable $ pointEnvelope p)
--- | Extract a list of primitives from a diagram, together with their
--- associated transformations and styles.
-prims :: HasLinearMap v
- => QDiagram b v m -> [(Prim b v, (Split (Transformation v), Style v))]
-prims = concatMap processLeaf
- . D.flatten
- . view _Wrapped'
- where
- processLeaf (PrimLeaf p, (trSty,_)) = [(p, untangle . option mempty id $ trSty)]
- processLeaf (DelayedLeaf k, d) = prims (k d)
-
-- | A useful variant of 'getU' which projects out a certain
-- component.
getU' :: (Monoid u', u :>: u') => D.DUALTree d u a l -> u'
@@ -520,30 +594,7 @@
instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)
=> HasStyle (QDiagram b v m) where
applyStyle = over _Wrapped' . D.applyD . inj
- . (inR :: Style v -> Split (Transformation v) :+: Style v)
-
--- | 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.
-freeze :: forall v b m. (HasLinearMap v, InnerSpace v
- , OrderedField (Scalar v), Semigroup m)
- => QDiagram b v m -> QDiagram b v m
-freeze = over _Wrapped' . D.applyD . inj
- . (inL :: Split (Transformation v) -> Split (Transformation v) :+: Style v)
- $ split
+ . (inR :: Style v -> Transformation v :+: Style v)
---- Juxtaposable
@@ -754,31 +805,19 @@
------------------------------------------------------------
-- $prim
--- Ultimately, every diagram is essentially a list of /primitives/,
+-- Ultimately, every diagram is essentially a tree whose leaves are /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 type class for primitive things which know how to handle being
--- transformed by both a normal transformation and a \"frozen\"
--- transformation. The default implementation simply applies both.
--- At the moment, 'ScaleInv' is the only type with a non-default
--- instance of 'IsPrim'.
-class Transformable p => IsPrim p where
- transformWithFreeze :: Transformation (V p) -> Transformation (V p) -> p -> p
- transformWithFreeze t1 t2 = transform (t1 <> t2)
-
-- | A value of type @Prim b v@ is an opaque (existentially quantified)
-- primitive which backend @b@ knows how to render in vector space @v@.
data Prim b v where
- Prim :: (IsPrim p, Typeable p, Renderable p b) => p -> Prim b (V p)
+ Prim :: (Transformable p, Typeable p, Renderable p b) => p -> Prim b (V p)
type instance V (Prim b v) = v
-instance HasLinearMap v => IsPrim (Prim b v) where
- transformWithFreeze t1 t2 (Prim p) = Prim $ transformWithFreeze t1 t2 p
-
-- | The 'Transformable' instance for 'Prim' just pushes calls to
-- 'transform' down through the 'Prim' constructor.
instance HasLinearMap v => Transformable (Prim b v) where
@@ -789,31 +828,12 @@
instance HasLinearMap v => Renderable (Prim b v) b where
render b (Prim p) = render b p
--- | The null primitive.
-data NullPrim v = NullPrim
- deriving Typeable
-
-type instance (V (NullPrim v)) = v
-
-instance HasLinearMap v => IsPrim (NullPrim v)
-
-instance HasLinearMap v => Transformable (NullPrim v) where
- transform _ _ = NullPrim
-
-instance (HasLinearMap v, Monoid (Render b v)) => Renderable (NullPrim v) b where
- render _ _ = mempty
-
--- | The null primitive, which every backend can render by doing
--- nothing.
-nullPrim :: (HasLinearMap v, Typeable v, Monoid (Render b v)) => Prim b v
-nullPrim = Prim NullPrim
-
------------------------------------------------------------
-- Backends -----------------------------------------------
------------------------------------------------------------
data DNode b v a = DStyle (Style v)
- | DTransform (Split (Transformation v))
+ | DTransform (Transformation v)
| DAnnot a
| DDelay
-- ^ @DDelay@ marks a point where a delayed subtree
@@ -834,47 +854,36 @@
data RNode b v a = RStyle (Style v)
-- ^ A style node.
- | RFrozenTr (Transformation v)
- -- ^ A \"frozen\" transformation, /i.e./ one which
- -- was applied after a call to 'freeze'. It
- -- applies to everything below it in the tree.
- -- Note that line width and other similar
- -- \"scale invariant\" attributes should be
- -- affected by this transformation. In the case
- -- of 2D, some backends may not support stroking
- -- in the context of an arbitrary
- -- transformation; such backends can instead use
- -- the 'avgScale' function from
- -- @Diagrams.TwoD.Transform@ (from the
- -- @diagrams-lib@ package).
| RAnnot a
- | RPrim (Transformation v) (Prim b v)
- -- ^ A primitive, along with the (non-frozen)
- -- transformation which applies to it.
+ | RPrim (Prim b v)
+ -- ^ A primitive.
| REmpty
-- | An 'RTree' is a compiled and optimized representation of a
--- 'QDiagram', which can be used by backends. They have several
--- invariants which backends may rely upon:
---
--- * All non-frozen transformations have been pushed all the way to
--- the leaves.
+-- 'QDiagram', which can be used by backends. They have the
+-- following invariant which backends may rely upon:
--
-- * @RPrim@ nodes never have any children.
type RTree b v a = Tree (RNode b v a )
-- | 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, an implementation for
--- 'doRender', and /one of/ either 'withStyle' or 'renderData'.
-class (HasLinearMap v, Monoid (Render b v)) => Backend b v where
+-- instance of the 'Backend' class.
+--
+-- A minimal complete definition consists of 'Render', 'Result',
+-- 'Options', and 'renderRTree'. However, most backends will want to
+-- implement 'adjustDia' as well; the default definition does
+-- nothing. Some useful standard definitions are provided in the
+-- @Diagrams.TwoD.Adjust@ module from the @diagrams-lib@ package.
+class HasLinearMap v => Backend b v where
- -- | 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 = (>>)@.
- data Render b v :: *
+ -- | An intermediate representation used for rendering primitives.
+ -- (Typically, this will be some sort of monad, but it need not
+ -- be.) The 'Renderable' class guarantees that a backend will be
+ -- able to convert primitives into this type; how these rendered
+ -- primitives are combined into an ultimate 'Result' is completely
+ -- up to the backend.
+ data Render b v :: *
-- | The result of running/interpreting a rendering operation.
type Result b v :: *
@@ -882,62 +891,25 @@
-- | Backend-specific rendering options.
data Options b v :: *
- -- | Perform a rendering operation with a local style. The default
- -- implementation does nothing, and must be overridden by backends
- -- that do not override 'renderData'.
- withStyle :: b -- ^ Backend token (needed only for type inference)
- -> Style v -- ^ Style to use
- -> Transformation v
- -- ^ \"Frozen\" transformation; line width and
- -- other similar \"scale invariant\" attributes
- -- should be affected by this transformation.
- -- In the case of 2D, some backends may not
- -- support stroking in the context of an
- -- arbitrary transformation; such backends can
- -- instead use the 'avgScale' function from
- -- @Diagrams.TwoD.Transform@ (from the
- -- @diagrams-lib@ package).
- -> Render b v -- ^ Rendering operation to run
- -> Render b v -- ^ Rendering operation using the style locally
- withStyle _ _ _ r = r
-
- -- | 'doRender' is used to interpret rendering operations.
- doRender :: 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
-
-- | '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.
- adjustDia :: Monoid' m => b -> Options b v
- -> QDiagram b v m -> (Options b v, QDiagram b v m)
- adjustDia _ o d = (o,d)
-
- renderDia :: (InnerSpace v, OrderedField (Scalar v), Monoid' m)
- => b -> Options b v -> QDiagram b v m -> Result b v
- renderDia b opts d = doRender b opts' . renderData b $ d'
- where (opts', d') = adjustDia b opts d
-
- -- | Backends may override 'renderData' to gain more control over
- -- the way that rendering happens. A typical implementation might be something like
- --
- -- > renderData = renderRTree . toRTree
+ -- rendering it. It returns a modified options record, the
+ -- transformation applied to the diagram (which can be used to
+ -- convert attributes whose value is @Measure@, or transform
+ -- /e.g./ screen coordinates back into local diagram coordinates),
+ -- and the adjusted diagram itself.
--
- -- where @renderRTree :: RTree b v () -> Render b v@ is
- -- implemented by the backend (with appropriate types filled in
- -- for @b@ and @v@), and 'toRTree' is from "Diagrams.Core.Compile".
- renderData :: Monoid' m => b -> QDiagram b v m -> Render b v
- renderData b = mconcat . map renderOne . prims
- where
- renderOne :: (Prim b v, (Split (Transformation v), Style v)) -> Render b v
- renderOne (p, (M t, s)) = withStyle b s mempty (render b (transform t p))
- renderOne (p, (t1 :| t2, s)) = withStyle b s t1 (render b (transformWithFreeze t1 t2 p))
+ -- See the diagrams-lib package (particularly the
+ -- @Diagrams.TwoD.Adjust@ module) for some useful implementations.
+ adjustDia :: (Monoid' m, Num (Scalar v)) => b -> Options b v
+ -> QDiagram b v m -> (Options b v, Transformation v, QDiagram b v m)
+ adjustDia _ o d = (o,mempty,d)
+ -- | Given some options, take a representation of a diagram as a
+ -- tree and render it. The 'RTree' has already been simplified
+ -- and has all measurements converted to @Output@ units.
+ renderRTree :: b -> Options b v -> RTree b v Annotation -> Result b v
+
-- See Note [backend token]
-- | The @D@ type is provided for convenience in situations where you
@@ -1040,19 +1012,7 @@
type Result NullBackend v = ()
data Options NullBackend v
- withStyle _ _ _ _ = NullBackendRender
- doRender _ _ _ = ()
-
--- | A class for backends which support rendering multiple diagrams,
--- e.g. to a multi-page pdf or something similar.
-class Backend b v => MultiBackend b v where
-
- -- | Render multiple diagrams at once.
- renderDias :: (InnerSpace v, OrderedField (Scalar v), Monoid' m)
- => b -> Options b v -> [QDiagram b v m] -> Result b v
-
- -- See Note [backend token]
-
+ renderRTree _ _ _ = ()
-- | The Renderable type class connects backends to primitives which
-- they know how to render.