Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Port to linear #212

Closed
wants to merge 26 commits into from
Closed

Port to linear #212

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
26 commits
Select commit Hold shift + click to select a range
2a40713
Some progress.
cchalmers Aug 18, 2014
4b8469a
More progress.
cchalmers Aug 18, 2014
48cbd1d
Bounding box.
cchalmers Aug 18, 2014
fe4892a
Bounding box.
cchalmers Aug 18, 2014
a70c9cf
Merge branch 'generalize-double' of https://github.com/cchalmers/diag…
cchalmers Aug 18, 2014
552c822
Starting on 2D and 3D modules.
cchalmers Aug 21, 2014
a267069
Change VN to Vn.
cchalmers Aug 21, 2014
71d5ada
Almost done.
cchalmers Aug 22, 2014
9961036
Some Bergey sugestions. (and combinators)
cchalmers Aug 23, 2014
3a5ff43
Builds without vector-space.
cchalmers Aug 23, 2014
e1894c6
Update for new lenses.
cchalmers Aug 23, 2014
f237e03
Coordinate instances for linear types.
cchalmers Aug 23, 2014
79c9a2e
Remove unused types.
cchalmers Aug 23, 2014
cf195d0
Use linear's classes for _x, _y, _z.
cchalmers Aug 23, 2014
c989031
Uncomment default pragma.
cchalmers Aug 23, 2014
26582ff
Bring back prelude.
cchalmers Aug 24, 2014
15751d7
lerp has arguments reversed in linear.
cchalmers Aug 24, 2014
507309a
Added (poor) Traced instances for Bounding box.
cchalmers Aug 25, 2014
46a5a9e
General cleanup.
cchalmers Aug 29, 2014
317c7ec
Merge Prelude.ThreeD with Prelude.
cchalmers Aug 29, 2014
d4a5fbd
Added Prelude back.
cchalmers Aug 31, 2014
5d68ad7
Added Polar, Cylindrical and Spherical coordinates.
cchalmers Aug 31, 2014
7e5ca2b
Use stylish-haskell config.
cchalmers Aug 31, 2014
e24baef
Fixed scaling measures.
cchalmers Sep 2, 2014
a11a0f3
Fix bug with showOrigin.
cchalmers Sep 3, 2014
8457055
Postpone new polar coordinate and general cleanup.
cchalmers Sep 7, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
68 changes: 32 additions & 36 deletions diagrams-lib.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,60 +26,57 @@ Source-repository head

Library
Exposed-modules: Diagrams.Prelude,
Diagrams.Prelude.ThreeD,
Diagrams.Align,
Diagrams.Angle,
Diagrams.Combinators,
Diagrams.Coordinates,
Diagrams.Attributes,
Diagrams.Attributes.Compile,
Diagrams.Points,
Diagrams.BoundingBox,
Diagrams.Combinators,
Diagrams.Coordinates,
Diagrams.CubicSpline,
Diagrams.CubicSpline.Internal,
Diagrams.Deform
Diagrams.Direction,
Diagrams.Envelope,
Diagrams.Located,
Diagrams.Names,
Diagrams.Parametric,
Diagrams.Parametric.Adjust,
Diagrams.Segment,
Diagrams.Trail,
Diagrams.TrailLike,
Diagrams.Path,
Diagrams.CubicSpline,
Diagrams.CubicSpline.Internal,
Diagrams.Direction,
Diagrams.Points,
Diagrams.Query,
Diagrams.Segment,
Diagrams.Solve,
Diagrams.Tangent,
Diagrams.Transform,
Diagrams.Deform
Diagrams.BoundingBox,
Diagrams.Names,
Diagrams.Envelope,
Diagrams.Trace,
Diagrams.Query,
Diagrams.Trail,
Diagrams.TrailLike,
Diagrams.Transform,
Diagrams.TwoD,
Diagrams.TwoD.Types,
Diagrams.TwoD.Types.Double,
Diagrams.TwoD.Types.Float,
Diagrams.TwoD.Types.Generic,
Diagrams.TwoD.Adjust,
Diagrams.TwoD.Align,
Diagrams.TwoD.Arc,
Diagrams.TwoD.Arrow,
Diagrams.TwoD.Arrowheads,
Diagrams.TwoD.Attributes,
Diagrams.TwoD.Combinators,
Diagrams.TwoD.Curvature,
Diagrams.TwoD.Deform,
Diagrams.TwoD.Transform,
Diagrams.TwoD.Transform.ScaleInv,
Diagrams.TwoD.Ellipse,
Diagrams.TwoD.Arc,
Diagrams.TwoD.Segment,
Diagrams.TwoD.Curvature,
Diagrams.TwoD.Image,
Diagrams.TwoD.Model,
Diagrams.TwoD.Offset,
Diagrams.TwoD.Path,
Diagrams.TwoD.Polygons,
Diagrams.TwoD.Segment,
Diagrams.TwoD.Shapes,
Diagrams.TwoD.Vector,
Diagrams.TwoD.Size,
Diagrams.TwoD.Model,
Diagrams.TwoD.Text,
Diagrams.TwoD.Image,
Diagrams.TwoD.Adjust,
Diagrams.TwoD.Transform,
Diagrams.TwoD.Transform.ScaleInv,
Diagrams.TwoD.Types,
Diagrams.TwoD.Vector,
Diagrams.ThreeD,
Diagrams.ThreeD.Align,
Diagrams.ThreeD.Attributes,
Diagrams.ThreeD.Camera,
Expand All @@ -88,9 +85,7 @@ Library
Diagrams.ThreeD.Shapes,
Diagrams.ThreeD.Transform,
Diagrams.ThreeD.Types,
Diagrams.ThreeD.Types.Double,
Diagrams.ThreeD.Vector,
Diagrams.ThreeD,
Diagrams.Animation,
Diagrams.Animation.Active,
Diagrams.Util,
Expand All @@ -103,20 +98,21 @@ Library
dual-tree >= 0.2 && < 0.3,
diagrams-core >= 1.2 && < 1.3,
active >= 0.1 && < 0.2,
vector-space >= 0.7.7 && < 0.9,
vector-space-points >= 0.1.2 && < 0.3,
MemoTrie >= 0.6 && < 0.7,
colour >= 2.3.2 && < 2.4,
data-default-class < 0.1,
fingertree >= 0.1 && < 0.2,
intervals >= 0.7 && < 0.8,
lens >= 4.0 && < 4.4,
lens >= 4.0 && < 4.5,
tagged >= 0.7,
optparse-applicative >= 0.7 && < 0.10,
filepath,
safe >= 0.2 && < 0.4,
JuicyPixels >= 3.1.5 && < 3.2,
hashable >= 1.1 && < 1.3
hashable >= 1.1 && < 1.3,
linear >= 1.10 && < 2.0,
adjunctions >= 4.0 && < 5.0,
distributive >=0.2.2 && < 1.0

if impl(ghc < 7.6)
Build-depends: ghc-prim
Hs-source-dirs: src
Expand Down
112 changes: 56 additions & 56 deletions src/Diagrams/Align.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,16 +36,18 @@ module Diagrams.Align
) where

import Diagrams.Core
import Diagrams.Util (applyAll)
import Diagrams.Util (applyAll)

import Data.AffineSpace (alerp, (.-.))
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.VectorSpace
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)

import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Set as S

import Linear.Affine
import Linear.Metric
import Linear.Vector

-- | Class of things which can be aligned.
class Alignable a where
Expand All @@ -56,113 +58,111 @@ class Alignable a where
-- edge of the boundary in the direction of the negation of @v@.
-- Other values of @d@ interpolate linearly (so for example, @d =
-- 0@ centers the origin along the direction of @v@).
alignBy' :: ( HasOrigin a, AdditiveGroup (V a), Num (Scalar (V a))
, Fractional (Scalar (V a)))
=> (V a -> a -> Point (V a)) -> V a -> Scalar (V a) -> a -> a
alignBy' :: (Vn a ~ v n, HasOrigin a, Additive v, Fractional n)
=> (v n -> a -> Point v n) -> v n -> n -> a -> a
alignBy' = alignBy'Default

defaultBoundary :: V a -> a -> Point (V a)
defaultBoundary :: Vn a ~ v n => v n -> a -> Point v n

alignBy :: (HasOrigin a, Num (Scalar (V a)), Fractional (Scalar (V a)))
=> V a -> Scalar (V a) -> a -> a
alignBy :: (Vn a ~ v n, Additive v, HasOrigin a, Fractional n)
=> v n -> n -> a -> a
alignBy = alignBy' defaultBoundary

-- | Default implementation of 'alignBy' for types with 'HasOrigin'
-- and 'AdditiveGroup' instances.
alignBy'Default :: ( HasOrigin a, AdditiveGroup (V a), Num (Scalar (V a))
, Fractional (Scalar (V a)))
=> (V a -> a -> Point (V a)) -> V a -> Scalar (V a) -> a -> a
alignBy'Default boundary v d a = moveOriginTo (alerp (boundary (negateV v) a)
(boundary v a)
((d + 1) / 2)) a
alignBy'Default :: (Vn a ~ v n, HasOrigin a, Additive v, Fractional n)
=> (v n -> a -> Point v n) -> v n -> n -> a -> a
alignBy'Default boundary v d a = moveOriginTo (lerp ((d + 1) / 2)
(boundary v a)
(boundary (negated v) a)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

These two arguments seem switched ---does lerp work dually to alerp?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes: alerp a b t = lerp t b a. This should be mentioned in the notes. Spent a while debugging to find this was the culprit (it's not even mentioned in linear).

) a


-- | Some standard functions which can be used as the `boundary` argument to
-- `alignBy'`.
envelopeBoundary :: Enveloped a => V a -> a -> Point (V a)
envelopeBoundary :: (Vn a ~ v n, Enveloped a) => v n -> a -> Point v n
envelopeBoundary = envelopeP

traceBoundary :: Traced a => V a -> a -> Point (V a)
traceBoundary :: (Vn a ~ v n, Num n, Traced a) => v n -> a -> Point v n
traceBoundary v a = fromMaybe origin (maxTraceP origin v a)

combineBoundaries
:: (F.Foldable f, InnerSpace (V a), Ord (Scalar (V a)))
=> (V a -> a -> Point (V a)) -> (V a -> f a -> Point (V a))
:: (Vn a ~ v n, F.Foldable f, Metric v, Ord n, Num n)
=> (v n -> a -> Point v n) -> v n -> f a -> Point v n
combineBoundaries b v fa
= b v $ F.maximumBy (comparing (magnitudeSq . (.-. origin) . b v)) fa
= b v $ F.maximumBy (comparing (quadrance . (.-. origin) . b v)) fa

instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Envelope v) where
instance (Metric v, OrderedField n) => Alignable (Envelope v n) where
defaultBoundary = envelopeBoundary

instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Trace v) where
instance (Metric v, OrderedField n) => Alignable (Trace v n) where
defaultBoundary = traceBoundary

instance (InnerSpace (V b), Ord (Scalar (V b)), Alignable b)
=> Alignable [b] where
instance (Vn b ~ v n, Metric v, OrderedField n, Alignable b) => Alignable [b] where
defaultBoundary = combineBoundaries defaultBoundary

instance (InnerSpace (V b), Ord (Scalar (V b)), Alignable b)
=> Alignable (S.Set b) where
instance (Vn b ~ v n, Metric v, OrderedField n, Alignable b)
=> Alignable (S.Set b) where
defaultBoundary = combineBoundaries defaultBoundary

instance (InnerSpace (V b), Ord (Scalar (V b)), Alignable b)
=> Alignable (M.Map k b) where
instance (Vn b ~ v n, Metric v, OrderedField n, Alignable b)
=> Alignable (M.Map k b) where
defaultBoundary = combineBoundaries defaultBoundary

instance ( HasLinearMap v, InnerSpace v, OrderedField (Scalar v)
, Monoid' m
) => Alignable (QDiagram b v m) where
instance (HasLinearMap v, Metric v, OrderedField n, Monoid' m)
=> Alignable (QDiagram b v n m) where
defaultBoundary = envelopeBoundary

-- | Although the 'alignBy' method for the @(b -> a)@ instance is
-- sensible, there is no good implementation for
-- 'defaultBoundary'. Instead, we provide a total method, but one that
-- is not sensible. This should not present a serious problem as long
-- as your use of 'Alignable' happens through 'alignBy'.
instance (HasOrigin a, Alignable a) => Alignable (b -> a) where
alignBy v d f b = alignBy v d (f b)
instance (Vn a ~ v n, Additive v, Num n, HasOrigin a, Alignable a) => Alignable (b -> a) where
alignBy v d f b = alignBy v d (f b)
defaultBoundary _ _ = origin

-- | @align v@ aligns an enveloped object along the edge in the
-- direction of @v@. That is, it moves the local origin in the
-- direction of @v@ until it is on the edge of the envelope. (Note
-- that if the local origin is outside the envelope to begin with,
-- it may have to move \"backwards\".)
align :: ( Alignable a, HasOrigin a, Num (Scalar (V a))
, Fractional (Scalar (V a))) => V a -> a -> a
align :: (Vn a ~ v n, Additive v, Alignable a, HasOrigin a, Fractional n) => v n -> a -> a
align v = alignBy v 1

-- | Version of @alignBy@ specialized to use @traceBoundary@
snugBy :: (Alignable a, Traced a, HasOrigin a, Num (Scalar (V a)), Fractional (Scalar (V a)))
=> V a -> Scalar (V a) -> a -> a
snugBy :: (Vn a ~ v n, Alignable a, Traced a, HasOrigin a, Fractional n)
=> v n -> n -> a -> a
snugBy = alignBy' traceBoundary

-- | Like align but uses trace.
snug :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a)
=> V a -> a -> a
snug v = snugBy v 1
snug :: (Vn a ~ v n, Fractional n, Alignable a, Traced a, HasOrigin a)
=> v n -> a -> a
snug v = snugBy v 1

-- | @centerV v@ centers an enveloped object along the direction of
-- @v@.
centerV :: ( Alignable a, HasOrigin a, Num (Scalar (V a))
, Fractional (Scalar (V a))) => V a -> a -> a
centerV :: (Vn a ~ v n, Additive v, Alignable a, HasOrigin a, Fractional n) => v n -> a -> a
centerV v = alignBy v 0

-- | @center@ centers an enveloped object along all of its basis vectors.
center :: ( HasLinearMap (V a), Alignable a, HasOrigin a, Num (Scalar (V a)),
Fractional (Scalar (V a))) => a -> a
center d = applyAll fs d
center :: (Vn a ~ v n, HasLinearMap v, Alignable a, HasOrigin a, Fractional n) => a -> a
center = applyAll fs
where
fs = map centerV basis

-- | Like @centerV@ using trace.
snugCenterV
:: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a)
=> V a -> a -> a
snugCenterV v = (alignBy' traceBoundary) v 0
:: (Vn a ~ v n, Fractional n, Alignable a, Traced a, HasOrigin a)
=> v n -> a -> a
snugCenterV v = alignBy' traceBoundary v 0

-- | Like @center@ using trace.
snugCenter :: ( HasLinearMap (V a), Alignable a, HasOrigin a, Num (Scalar (V a)),
Fractional (Scalar (V a)), Traced a) => a -> a
snugCenter d = applyAll fs d
snugCenter :: (Vn a ~ v n, HasLinearMap v, Alignable a, HasOrigin a, Fractional n, Traced a)
=> a -> a
snugCenter = applyAll fs
where
fs = map snugCenterV basis

{-# ANN module ("HLint: ignore Use camelCase" :: String) #-}
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What's this for?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

To stop HLint complaining about alignBy'Default.


Loading