Hopfully fix new sizespec bugs.

diagrams-lib.cabal

@@ -60,6 +60,7 @@ Library
                        Diagrams.ThreeD.Deform,
                        Diagrams.ThreeD.Light,
                        Diagrams.ThreeD.Shapes,
+                       Diagrams.ThreeD.Size,
                        Diagrams.ThreeD.Transform,
                        Diagrams.ThreeD.Types,
                        Diagrams.ThreeD.Vector,

src/Diagrams/BoundingBox.hs

@@ -33,7 +33,8 @@ module Diagrams.BoundingBox
          -- * Queries on bounding boxes
        , isEmptyBox
        , getCorners, getAllCorners
-       , boxExtents, boxTransform, boxFit
+       , boxExtents, boxCenter
+       , boxTransform, boxFit
        , contains, contains', boundingBoxQuery
        , inside, inside', outside, outside'
 
@@ -176,9 +177,14 @@ getAllCorners (BoundingBox (Option (Just (NonEmptyBoundingBox (l, u)))))
 -- | Get the size of the bounding box - the vector from the (component-wise)
 --   lesser point to the greater point.
 boxExtents :: (Additive v, Num n) => BoundingBox v n -> v n
-boxExtents = maybe zero (uncurry (.-.)) . getCorners
+boxExtents = maybe zero (\(l,u) -> u .-. l) . getCorners
 
--- | Create a transformation mapping points from one bounding box to the other.
+-- | Get the center point in a bounding box.
+boxCenter :: (Additive v, Fractional n) => BoundingBox v n -> Maybe (Point v n)
+boxCenter = fmap (uncurry (lerp 0.5)) . getCorners
+
+-- | Create a transformation mapping points from one bounding box to the 
+--   other. Returns 'Nothing' if either of the boxes are empty.
 boxTransform
   :: (Additive v, Fractional n)
   => BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)

src/Diagrams/Size.hs

@@ -21,45 +21,52 @@
 -- License     :  BSD-style (see LICENSE)
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
--- Utilities for working with sizes of two-dimensional objects.
+-- Utilities for working with sizes of objects.
 --
 -----------------------------------------------------------------------------
 module Diagrams.Size
-  ( SizeSpec
-  , mkSpec
+  ( -- * Size spec
+    SizeSpec
+
+    -- ** Making size spec
+  , mkSizeSpec
 	, dims
 	, absolute
+
+    -- ** Extracting size specs
 	, getSpec
+  , specToSize
+
+    -- ** Functions on size specs
 	, requiredScale
   , requiredScaling
 	, sized
 	, sizedAs
-	, getSize
-  , specSize
+  , sizeAdjustment
   ) where
 
 import           Control.Applicative
 import           Control.Lens        hiding (transform)
 import           Control.Monad
 import           Data.Foldable       as F
 import           Data.Hashable
+import           Data.Semigroup
 import           Data.Maybe
 import           Data.Typeable
 import           GHC.Generics        (Generic)
 
 import           Diagrams.Core
+import           Diagrams.BoundingBox
 
+import           Linear.Affine
 import           Linear.Vector
 
 ------------------------------------------------------------
 -- Computing diagram sizes
 ------------------------------------------------------------
 
--- | Compute the point in the center of the bounding box of the enveloped object.
--- centerPoint :: (InSpace v n a, Enveloped a, HasLinearMap v, HasBasis v) => a -> Maybe (Point v n)
--- centerPoint = fmap (uncurry $ lerp 0.5) . getCorners . boundingBox
-
--- | SizeSpec for a
+-- | A 'SizeSpec' is a way of specifying a size without needed lengths for all
+--   the dimensions.
 newtype SizeSpec v n = SizeSpec (v n)
   deriving (
 #if __GLASGOW_HASKELL__ >= 707
@@ -84,40 +91,46 @@ type instance N (SizeSpec v n) = n
 getSpec :: (Functor v, Num n, Ord n) => SizeSpec v n -> v (Maybe n)
 getSpec (SizeSpec sp) = mfilter (>0) . Just <$> sp
 
--- | Make a 'SizeSpec' from a vector of maybe values.
-mkSpec :: (Functor v, Num n) => v (Maybe n) -> SizeSpec v n
-mkSpec = dims . fmap (fromMaybe 0)
+-- | Make a 'SizeSpec' from a vector of maybe values. Any negative values will
+--   be ignored.
+mkSizeSpec :: (Functor v, Num n) => v (Maybe n) -> SizeSpec v n
+mkSizeSpec = dims . fmap (fromMaybe 0)
 
--- | Make a 'SizeSpec' from a vector.
+-- | Make a 'SizeSpec' from a vector. Any negative values will be ignored.
 dims :: Functor v => v n -> SizeSpec v n
 dims = SizeSpec
 
 -- | A size spec with no hints to the size.
 absolute :: (Additive v, Num n) => SizeSpec v n
 absolute = SizeSpec zero
 
-specSize :: (Foldable v, Functor v, Num n, Ord n) => n -> SizeSpec v n -> v n
-specSize x (getSpec -> spec) = fmap (fromMaybe smallest) spec
+-- | @specToSize n spec@ extracts a size from a 'SizeSpec' @sz@. Any values not
+--   specified in the spec are replaced by the smallest of the values that are
+--   specified. If there are no specified values (i.e. 'absolute') then @n@ is
+--   used.
+specToSize :: (Foldable v, Functor v, Num n, Ord n) => n -> SizeSpec v n -> v n
+specToSize x (getSpec -> spec) = fmap (fromMaybe smallest) spec
   where
     smallest = fromMaybe x $ minimumOf (folded . _Just) spec
 
 -- | @requiredScale spec sz@ returns the largest scaling factor to make
---   something of size @sz@ fit the requested size @spec@, without changing the
---   aspect ratio. @sz@ should be a strictly positive vector (otherwise a scale
---   of 1 is returned). For non-uniform scaling see 'boxFit'.
+--   something of size @sz@ fit the requested size @spec@ without changing the
+--   aspect ratio. @sz@ should be non-zero (otherwise a scale of 1 is
+--   returned). For non-uniform scaling see 'boxFit'.
 requiredScale :: (Additive v, Foldable v, Fractional n, Ord n)
               => SizeSpec v n -> v n -> n
 requiredScale (getSpec -> spec) sz
-  | F.any (<= 0) sz = 1
+  | F.all (<= 0) sz = 1
   | otherwise       = fromMaybe 1 . minimumOf (folded . _Just)
                     $ liftI2 (^/) spec sz
 
+-- | Return the 'Transformation' calcuated from 'requiredScale'.
 requiredScaling :: (Additive v, Foldable v, Fractional n, Ord n)
   => SizeSpec v n -> v n -> Transformation v n
 requiredScaling spec = scaling . requiredScale spec
 
 -- | Uniformly scale any enveloped object so that it fits within the
---   given size, for non-uniform scaling see 'boxFit'.
+--   given size. For non-uniform scaling see 'boxFit'.
 sized :: (InSpace v n a, HasLinearMap v, HasBasis v, Transformable a, Enveloped a, Fractional n, Ord n)
       => SizeSpec v n -> a -> a
 sized spec a = transform (requiredScaling spec (size a)) a
@@ -130,9 +143,21 @@ sizedAs :: (InSpace v n a, SameSpace a b, HasLinearMap v, HasBasis v, Transforma
         => b -> a -> a
 sizedAs other = sized (dims $ size other)
 
-getSize :: (Functor v, Foldable v, Num n, Ord n) => n -> SizeSpec v n -> v n
-getSize n (getSpec -> spec) = fmap (fromMaybe lower) spec
+-- | Get the adjustment to fit a 'BoundingBox' in the given 'SizeSpec'. The 
+--   vector is the new size and the transformation  to position the lower 
+--   corner at the origin and scale to the size spec.
+sizeAdjustment :: (Additive v, Foldable v, OrderedField n)
+  => SizeSpec v n -> BoundingBox v n -> (v n, Transformation v n)
+sizeAdjustment spec bb = (sz', t)
   where
-    lower = fromMaybe n $ minimumOf (folded . _Just) spec
+    -- v   = maybe zero ((origin .-.) . fst) (getCorners bb)
+    v = (0.5 *^ P sz') .-. (s *^ fromMaybe origin (boxCenter bb))
+
+    sz  = boxExtents bb
+    sz' = if allOf folded isJust (getSpec spec) then specToSize 0 spec else s *^ sz
+
+    s = requiredScale spec sz
 
+    -- transform by moving lower corner to origin and scaling
+    t = translation v <> scaling s
 

src/Diagrams/ThreeD/Size.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE ConstraintKinds  #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies     #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Diagrams.ThreeD.Size
+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  diagrams-discuss@googlegroups.com
+--
+-- Utilities for working with sizes of three-dimensional objects.
+--
+-----------------------------------------------------------------------------
+module Diagrams.ThreeD.Size
+       (
+         -- ** Computing sizes
+         extentX, extentY, extentZ
+
+         -- ** Specifying sizes
+       , mkSizeSpec3D
+       , dims3D
+
+       ) where
+
+import           Diagrams.Core
+import           Diagrams.Core.Envelope
+import           Diagrams.Size
+import           Diagrams.TwoD.Size
+import           Diagrams.ThreeD.Types
+import           Diagrams.ThreeD.Vector
+
+------------------------------------------------------------
+-- Computing diagram sizes
+------------------------------------------------------------
+
+-- | Compute the absolute z-coordinate range of an enveloped object in
+--   the form @(lo,hi)@. Return @Nothing@ for objects with an empty 
+--   envelope.
+extentZ :: (InSpace v n a, R3 v, Enveloped a) => a -> Maybe (n, n)
+extentZ = extent unitZ
+
+-- | Make a 'SizeSpec' from possibly-specified width and height.
+mkSizeSpec3D :: Num n => Maybe n -> Maybe n -> Maybe n -> SizeSpec V3 n
+mkSizeSpec3D x y z = mkSizeSpec (V3 x y z)
+
+-- | Make a 'SizeSpec' from a width and height.
+dims3D :: n -> n -> n -> SizeSpec V3 n
+dims3D x y z = dims (V3 x y z)
+

src/Diagrams/TwoD/Adjust.hs

@@ -17,24 +17,22 @@
 
 module Diagrams.TwoD.Adjust
     ( setDefault2DAttributes
-    , adjustSize
+    , adjustSize2D
     , adjustDia2D
     ) where
 
 import           Diagrams.Attributes
 import           Diagrams.Core
-import           Diagrams.Core.Envelope
 import           Diagrams.TwoD.Attributes (lineTextureA)
 import           Diagrams.TwoD.Types
 import           Diagrams.Util            (( # ))
 import           Diagrams.Size
+import           Diagrams.BoundingBox
 
-import           Control.Lens             (Lens', (^.),  set, allOf, folded)
+import           Control.Lens             (Lens', (^.),  set)
 import           Data.Default.Class
 import           Data.Semigroup
-import           Data.Maybe
 
-import           Linear.Vector
 
 -- | Set default attributes of a 2D diagram (in case they have not
 --   been set):
@@ -43,8 +41,6 @@ import           Linear.Vector
 --
 --       * Line color black
 --
---       * Font size 1
---
 --       * Line cap LineCapButt
 --
 --       * line join miter
@@ -55,7 +51,6 @@ setDefault2DAttributes :: (TypeableFloat n, Semigroup m)
 setDefault2DAttributes d
   = d # lineWidthM def
       # lineTextureA def
-      -- # fontSizeM def
       # lineCap def
       # lineJoin def
       # lineMiterLimitA def
@@ -68,25 +63,14 @@ setDefault2DAttributes d
 --   inverse of which can be used, say, to translate output/device
 --   coordinates back into local diagram coordinates), and the
 --   modified diagram itself.
-adjustSize :: (TypeableFloat n, Monoid' m)
+adjustSize2D :: (TypeableFloat n, Monoid' m)
                 => Lens' (Options b V2 n) (SizeSpec V2 n)
                 -> b -> Options b V2 n -> QDiagram b V2 n m
                 -> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)
-adjustSize szL _ opts d = (set szL sz' opts, t, d # transform t)
+adjustSize2D szL _ opts d = (set szL spec opts, t, d # transform t)
   where
-    spec = opts ^. szL
-
-    s   = requiredScale spec sz
-    sz  = size d
-    sz' = if allOf folded isJust (getSpec spec)
-            then spec
-            else dims $ s *^ sz
-
-    -- vector from the origin to lower corner of envelope
-    v  = fmap (flip envelopeS d . negated) eye
-
-    -- transform by moving lower corner to origin and scale
-    t  = scaling s <> translation v
+    spec    = dims sz
+    (sz, t) = sizeAdjustment (opts ^. szL) (boundingBox d)
 
 -- | @adjustDia2D@ provides a useful default implementation of
 --   the 'adjustDia' method from the 'Backend' type class.
@@ -110,5 +94,5 @@ adjustDia2D :: (TypeableFloat n, Monoid' m)
             -> b -> Options b V2 n -> QDiagram b V2 n m
             -> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)
 adjustDia2D szL b opts d
-  = adjustSize szL b opts (d # setDefault2DAttributes)
+  = adjustSize2D szL b opts (d # setDefault2DAttributes)
 

src/Diagrams/TwoD/Intersections.hs

@@ -402,6 +402,7 @@ closest cb (P (V2 px py)) = bezierFindRoot poly 0 1
 bezierToBernstein :: Fractional n => FixedSegment V2 n -> (BernsteinPoly n, BernsteinPoly n)
 bezierToBernstein (FCubic a b c d) = (listToBernstein $ map (view _x) coeffs, listToBernstein $ map (view _y) coeffs)
   where coeffs = [a, b, c, d]
+bezierToBernstein _ = error "bezierToBernstein only works on cubics"
 
 ------------------------------------------------------------------------
 -- Bernstein polynomials
@@ -569,6 +570,7 @@ segmentIntersectingBox (FLinear p1 p2) (FLinear p3 p4)
     mins1  = liftU2 min p1 p2
     maxes2 = liftU2 max p3 p4
     mins2  = liftU2 min p3 p4
+segmentIntersectingBox _ _ = error "intersectingBox is only for linear segments"
 -- other cases for completeness
 -- segmentIntersectingBox a b = intersection (boundingBox a) (boundingBox b)
 

src/Diagrams/TwoD/Size.hs

@@ -14,7 +14,6 @@
 -----------------------------------------------------------------------------
 module Diagrams.TwoD.Size
        (
-         -- * Size and extent of diagrams in R2
          -- ** Computing sizes
          width, height
        , extentX, extentY
@@ -38,35 +37,44 @@ import           Diagrams.TwoD.Vector
 ------------------------------------------------------------
 
 -- | Compute the width of an enveloped object.
+--
+--   Note this is just @diameter unitX@.
 width :: (InSpace V2 n a, Enveloped a) => a -> n
 width = diameter unitX
 
 -- | Compute the height of an enveloped object.
 height :: (InSpace V2 n a, Enveloped a) => a -> n
 height = diameter unitY
 
--- | Compute the absolute  x-coordinate range of an enveloped object in
---   R2, in  the form (lo,hi).   Return @Nothing@ for objects  with an
---   empty envelope.
+-- | Compute the absolute x-coordinate range of an enveloped object in
+--   the form @(lo,hi)@. Return @Nothing@ for objects with an empty
+--   envelope.
+--
+--   Note this is just @extent unitX@.
 extentX :: (InSpace v n a, R1 v, Enveloped a) => a -> Maybe (n, n)
 extentX = extent unitX
 
 -- | Compute the absolute y-coordinate range of an enveloped object in
---   R2, in the form (lo,hi).
+--   the form @(lo,hi)@. Return @Nothing@ for objects with an empty
+--   envelope.
 extentY :: (InSpace v n a, R2 v, Enveloped a) => a -> Maybe (n, n)
 extentY = extent unitY
 
--- | Create a size specification from a possibly-specified width and
---   height.
+-- | Make a 'SizeSpec' from possibly-specified width and height.
 mkSizeSpec2D :: Num n => Maybe n -> Maybe n -> SizeSpec V2 n
-mkSizeSpec2D x y = mkSpec (V2 x y)
+mkSizeSpec2D x y = mkSizeSpec (V2 x y)
+
+-- | Make a 'SizeSpec' from a width and height.
+dims2D :: n -> n -> SizeSpec V2 n
+dims2D x y = dims (V2 x y)
 
+-- | Make a 'SizeSpec' with only width defined.
 mkWidth :: Num n => n -> SizeSpec V2 n
 mkWidth w = dims (V2 w 0)
 
+-- | Make a 'SizeSpec' with only height defined.
 mkHeight :: Num n => n -> SizeSpec V2 n
 mkHeight h = dims (V2 0 h)
 
-dims2D :: n -> n -> SizeSpec V2 n
-dims2D x y = dims (V2 x y)
+