From beeb213192740317c9ad0ce736cf843ab1570c43 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Tue, 22 Jan 2013 20:45:32 -0500 Subject: [PATCH 1/7] add a Renderable instance for ScaleInv --- src/Diagrams/TwoD/Transform.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Diagrams/TwoD/Transform.hs b/src/Diagrams/TwoD/Transform.hs index b5a3b64c..67c6d601 100644 --- a/src/Diagrams/TwoD/Transform.hs +++ b/src/Diagrams/TwoD/Transform.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts , FlexibleInstances , TypeFamilies @@ -308,3 +309,6 @@ instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where rot = rotateAbout l angle l' = transform tr l trans = translate (l' .-. l) + +instance (Renderable t b, V t ~ R2) => Renderable (ScaleInv t) b where + render b = render b . unScaleInv \ No newline at end of file From 5c8ff14d74413d04965f4a4928c969be51d8657a Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Tue, 22 Jan 2013 20:58:42 -0500 Subject: [PATCH 2/7] new function scaleInvPrim for creating a diagram from a single scale-invariant primitive --- src/Diagrams/TwoD/Transform.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/Diagrams/TwoD/Transform.hs b/src/Diagrams/TwoD/Transform.hs index 67c6d601..21d77f63 100644 --- a/src/Diagrams/TwoD/Transform.hs +++ b/src/Diagrams/TwoD/Transform.hs @@ -47,7 +47,7 @@ module Diagrams.TwoD.Transform , shearingY, shearY -- * Scale invariance - , ScaleInv(..), scaleInv + , ScaleInv(..), scaleInv, scaleInvPrim ) where @@ -311,4 +311,13 @@ instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where trans = translate (l' .-. l) instance (Renderable t b, V t ~ R2) => Renderable (ScaleInv t) b where - render b = render b . unScaleInv \ No newline at end of file + render b = render b . unScaleInv + +-- | Create a diagram from a single scale-invariant primitive, which +-- will have an /empty/ envelope, trace, and query. The reason is +-- that the envelope, trace, and query cannot be cached---applying a +-- transformation would cause the cached envelope, etc. to get "out +-- of sync" with the scale-invariant object. +scaleInvPrim :: (Transformable t, Renderable t b, V t ~ R2, Monoid m) + => t -> R2 -> QDiagram b R2 m +scaleInvPrim t d = mkQD (Prim $ scaleInv t d) mempty mempty mempty mempty \ No newline at end of file From 8ac02defa8f054c28483067add107e6d392a5b41 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Thu, 24 Jan 2013 21:22:42 -0500 Subject: [PATCH 3/7] further clarify intention of scale-invariant primitives --- src/Diagrams/TwoD/Transform.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Diagrams/TwoD/Transform.hs b/src/Diagrams/TwoD/Transform.hs index 21d77f63..e905d12a 100644 --- a/src/Diagrams/TwoD/Transform.hs +++ b/src/Diagrams/TwoD/Transform.hs @@ -317,7 +317,10 @@ instance (Renderable t b, V t ~ R2) => Renderable (ScaleInv t) b where -- will have an /empty/ envelope, trace, and query. The reason is -- that the envelope, trace, and query cannot be cached---applying a -- transformation would cause the cached envelope, etc. to get "out --- of sync" with the scale-invariant object. +-- of sync" with the scale-invariant object. The intention, at any +-- rate, is that scale-invariant things will be used only as +-- "decorations" (/e.g./ arrowheads) which should not affect the +-- envelope, trace, and query. scaleInvPrim :: (Transformable t, Renderable t b, V t ~ R2, Monoid m) => t -> R2 -> QDiagram b R2 m scaleInvPrim t d = mkQD (Prim $ scaleInv t d) mempty mempty mempty mempty \ No newline at end of file From 195cbdc3f36cb095c7b23c946f2085e6df6f92d9 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Fri, 12 Apr 2013 17:56:08 -0400 Subject: [PATCH 4/7] add IsPrim instance for ScaleInv --- src/Diagrams/TwoD/Transform.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/Diagrams/TwoD/Transform.hs b/src/Diagrams/TwoD/Transform.hs index 6df5d205..813fbf6b 100644 --- a/src/Diagrams/TwoD/Transform.hs +++ b/src/Diagrams/TwoD/Transform.hs @@ -312,6 +312,18 @@ instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where l' = transform tr l trans = translate (l' .-. l) +instance (V t ~ R2, Transformable t) => IsPrim (ScaleInv t) where + transformWithFreeze t1 t2 s = ScaleInv t1'' d'' origin'' + where + -- first, apply t2 normally + s'@(ScaleInv t' _ _) = transform t2 s + + -- now apply t1 to get the new direction and origin + (ScaleInv _ d'' origin'') = transform t1 s' + + -- but apply t1 directly to the underlying thing, scales and all. + t'' = transform t1 t' + instance (Renderable t b, V t ~ R2) => Renderable (ScaleInv t) b where render b = render b . unScaleInv From 2dcede32424ae89b428e1e0096103b6309b51825 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Mon, 15 Apr 2013 22:27:11 -0400 Subject: [PATCH 5/7] add IsPrim instances for Path, Ellipsoid, Image, and Text --- src/Diagrams/Path.hs | 2 ++ src/Diagrams/ThreeD/Shapes.hs | 2 ++ src/Diagrams/TwoD/Image.hs | 2 ++ src/Diagrams/TwoD/Text.hs | 2 ++ 4 files changed, 8 insertions(+) diff --git a/src/Diagrams/Path.hs b/src/Diagrams/Path.hs index 94822fad..aa77b266 100644 --- a/src/Diagrams/Path.hs +++ b/src/Diagrams/Path.hs @@ -307,6 +307,8 @@ but that doesn't take into account the fact that some of the v's are inside Points and hence ought to be translated. -} +instance HasLinearMap v => IsPrim (Path v) + instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Path v) where getEnvelope = F.foldMap trailEnvelope . pathTrails -- this type signature is necessary to work around an apparent bug in ghc 6.12.1 diff --git a/src/Diagrams/ThreeD/Shapes.hs b/src/Diagrams/ThreeD/Shapes.hs index 8042f237..1a0d6a42 100644 --- a/src/Diagrams/ThreeD/Shapes.hs +++ b/src/Diagrams/ThreeD/Shapes.hs @@ -39,6 +39,8 @@ type instance V Ellipsoid = R3 instance Transformable Ellipsoid where transform t1 (Ellipsoid t2) = Ellipsoid (t1 <> t2) +instance IsPrim Ellipsoid + instance Renderable Ellipsoid NullBackend where render _ _ = mempty diff --git a/src/Diagrams/TwoD/Image.hs b/src/Diagrams/TwoD/Image.hs index 467fbf0e..85263677 100644 --- a/src/Diagrams/TwoD/Image.hs +++ b/src/Diagrams/TwoD/Image.hs @@ -43,6 +43,8 @@ type instance V Image = R2 instance Transformable Image where transform t1 (Image file sz t2) = Image file sz (t1 <> t2) +instance IsPrim Image + instance HasOrigin Image where moveOriginTo p = translate (origin .-. p) diff --git a/src/Diagrams/TwoD/Text.hs b/src/Diagrams/TwoD/Text.hs index 57f6ddda..9f9307b8 100644 --- a/src/Diagrams/TwoD/Text.hs +++ b/src/Diagrams/TwoD/Text.hs @@ -58,6 +58,8 @@ type instance V Text = R2 instance Transformable Text where transform t (Text tt a s) = Text (t <> tt) a s +instance IsPrim Text + instance HasOrigin Text where moveOriginTo p = translate (origin .-. p) From 80021bb5343505aa06d18bc90b7c0ce2e3ce3fe3 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Mon, 15 Apr 2013 22:27:24 -0400 Subject: [PATCH 6/7] typo fix in IsPrim instance for ScaleInv --- src/Diagrams/TwoD/Transform.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Diagrams/TwoD/Transform.hs b/src/Diagrams/TwoD/Transform.hs index 813fbf6b..cf8de917 100644 --- a/src/Diagrams/TwoD/Transform.hs +++ b/src/Diagrams/TwoD/Transform.hs @@ -313,7 +313,7 @@ instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where trans = translate (l' .-. l) instance (V t ~ R2, Transformable t) => IsPrim (ScaleInv t) where - transformWithFreeze t1 t2 s = ScaleInv t1'' d'' origin'' + transformWithFreeze t1 t2 s = ScaleInv t'' d'' origin'' where -- first, apply t2 normally s'@(ScaleInv t' _ _) = transform t2 s From 5c179aab2fac03a59b9589ecb14bec4e3800f71e Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Wed, 17 Apr 2013 19:06:59 -0400 Subject: [PATCH 7/7] add more comments re: ScaleInv in Diagrams.TwoD.Transform --- src/Diagrams/TwoD/Transform.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Diagrams/TwoD/Transform.hs b/src/Diagrams/TwoD/Transform.hs index cf8de917..6899481b 100644 --- a/src/Diagrams/TwoD/Transform.hs +++ b/src/Diagrams/TwoD/Transform.hs @@ -251,9 +251,6 @@ shearY = transform . shearingY -- Scale invariance ---------------------------------------- --- XXX what about freezing? Doesn't interact with ScaleInv the way it --- ought. - -- | The @ScaleInv@ wrapper creates two-dimensional /scale-invariant/ -- objects. Intuitively, a scale-invariant object is affected by -- transformations like translations and rotations, but not by scales. @@ -312,10 +309,16 @@ instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where l' = transform tr l trans = translate (l' .-. l) +-- This is how we handle freezing properly with ScaleInv wrappers. +-- Normal transformations are applied ignoring scaling; "frozen" +-- transformations (i.e. transformations applied after a freeze) are +-- applied directly to the underlying object, scales and all. We must +-- take care to transform the reference point and direction vector +-- appropriately. instance (V t ~ R2, Transformable t) => IsPrim (ScaleInv t) where transformWithFreeze t1 t2 s = ScaleInv t'' d'' origin'' where - -- first, apply t2 normally + -- first, apply t2 normally, i.e. ignoring scaling s'@(ScaleInv t' _ _) = transform t2 s -- now apply t1 to get the new direction and origin