{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.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 objects.
--
-----------------------------------------------------------------------------
module Diagrams.Size
  ( -- * Size spec
    SizeSpec

    -- ** Making size spec
  , mkSizeSpec
  , dims
  , absolute

    -- ** Extracting size specs
  , getSpec
  , specToSize

    -- ** Functions on size specs
  , requiredScale
  , requiredScaling
  , sized
  , sizedAs
  , sizeAdjustment
  ) where

import           Control.Applicative
import           Control.Lens         hiding (transform)
import           Control.Monad
import           Data.Foldable        as F
import           Data.Hashable
import           Data.Maybe
import           Data.Semigroup
import           Data.Typeable
import           GHC.Generics         (Generic)
import           Prelude

import           Diagrams.BoundingBox
import           Diagrams.Core

import           Linear.Affine
import           Linear.Vector

------------------------------------------------------------
-- Computing diagram sizes
------------------------------------------------------------

-- | A 'SizeSpec' is a way of specifying a size without needed lengths for all
--   the dimensions.
newtype SizeSpec v n = SizeSpec (v n)
  deriving (
  SizeSpec v n -> SizeSpec v n -> Bool
(SizeSpec v n -> SizeSpec v n -> Bool)
-> (SizeSpec v n -> SizeSpec v n -> Bool) -> Eq (SizeSpec v n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) n.
Eq (v n) =>
SizeSpec v n -> SizeSpec v n -> Bool
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
SizeSpec v n -> SizeSpec v n -> Bool
== :: SizeSpec v n -> SizeSpec v n -> Bool
$c/= :: forall (v :: * -> *) n.
Eq (v n) =>
SizeSpec v n -> SizeSpec v n -> Bool
/= :: SizeSpec v n -> SizeSpec v n -> Bool
Eq,
  Typeable,
  (forall a b. (a -> b) -> SizeSpec v a -> SizeSpec v b)
-> (forall a b. a -> SizeSpec v b -> SizeSpec v a)
-> Functor (SizeSpec v)
forall a b. a -> SizeSpec v b -> SizeSpec v a
forall a b. (a -> b) -> SizeSpec v a -> SizeSpec v b
forall (v :: * -> *) a b.
Functor v =>
a -> SizeSpec v b -> SizeSpec v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> SizeSpec v a -> SizeSpec v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> SizeSpec v a -> SizeSpec v b
fmap :: forall a b. (a -> b) -> SizeSpec v a -> SizeSpec v b
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> SizeSpec v b -> SizeSpec v a
<$ :: forall a b. a -> SizeSpec v b -> SizeSpec v a
Functor,
  (forall x. SizeSpec v n -> Rep (SizeSpec v n) x)
-> (forall x. Rep (SizeSpec v n) x -> SizeSpec v n)
-> Generic (SizeSpec v n)
forall x. Rep (SizeSpec v n) x -> SizeSpec v n
forall x. SizeSpec v n -> Rep (SizeSpec v n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (v :: * -> *) n x. Rep (SizeSpec v n) x -> SizeSpec v n
forall (v :: * -> *) n x. SizeSpec v n -> Rep (SizeSpec v n) x
$cfrom :: forall (v :: * -> *) n x. SizeSpec v n -> Rep (SizeSpec v n) x
from :: forall x. SizeSpec v n -> Rep (SizeSpec v n) x
$cto :: forall (v :: * -> *) n x. Rep (SizeSpec v n) x -> SizeSpec v n
to :: forall x. Rep (SizeSpec v n) x -> SizeSpec v n
Generic,
  Eq (SizeSpec v n)
Eq (SizeSpec v n) =>
(Int -> SizeSpec v n -> Int)
-> (SizeSpec v n -> Int) -> Hashable (SizeSpec v n)
Int -> SizeSpec v n -> Int
SizeSpec v n -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (v :: * -> *) n. Hashable (v n) => Eq (SizeSpec v n)
forall (v :: * -> *) n.
Hashable (v n) =>
Int -> SizeSpec v n -> Int
forall (v :: * -> *) n. Hashable (v n) => SizeSpec v n -> Int
$chashWithSalt :: forall (v :: * -> *) n.
Hashable (v n) =>
Int -> SizeSpec v n -> Int
hashWithSalt :: Int -> SizeSpec v n -> Int
$chash :: forall (v :: * -> *) n. Hashable (v n) => SizeSpec v n -> Int
hash :: SizeSpec v n -> Int
Hashable,
  Int -> SizeSpec v n -> ShowS
[SizeSpec v n] -> ShowS
SizeSpec v n -> String
(Int -> SizeSpec v n -> ShowS)
-> (SizeSpec v n -> String)
-> ([SizeSpec v n] -> ShowS)
-> Show (SizeSpec v n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) n. Show (v n) => Int -> SizeSpec v n -> ShowS
forall (v :: * -> *) n. Show (v n) => [SizeSpec v n] -> ShowS
forall (v :: * -> *) n. Show (v n) => SizeSpec v n -> String
$cshowsPrec :: forall (v :: * -> *) n. Show (v n) => Int -> SizeSpec v n -> ShowS
showsPrec :: Int -> SizeSpec v n -> ShowS
$cshow :: forall (v :: * -> *) n. Show (v n) => SizeSpec v n -> String
show :: SizeSpec v n -> String
$cshowList :: forall (v :: * -> *) n. Show (v n) => [SizeSpec v n] -> ShowS
showList :: [SizeSpec v n] -> ShowS
Show)

type instance V (SizeSpec v n) = v
type instance N (SizeSpec v n) = n

-- | Retrieve a size spec as a vector of maybe values. Only positive sizes are
--   returned.
getSpec :: (Functor v, Num n, Ord n) => SizeSpec v n -> v (Maybe n)
getSpec :: forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec (SizeSpec v n
sp) = (n -> Bool) -> Maybe n -> Maybe n
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>n
0) (Maybe n -> Maybe n) -> (n -> Maybe n) -> n -> Maybe n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Maybe n
forall a. a -> Maybe a
Just (n -> Maybe n) -> v n -> v (Maybe n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v n
sp

-- | Make a 'SizeSpec' from a vector of maybe values. Any negative values will
--   be ignored. For 2D 'SizeSpec's see 'mkWidth' and 'mkHeight' from
--   "Diagrams.TwoD.Size".
mkSizeSpec :: (Functor v, Num n) => v (Maybe n) -> SizeSpec v n
mkSizeSpec :: forall (v :: * -> *) n.
(Functor v, Num n) =>
v (Maybe n) -> SizeSpec v n
mkSizeSpec = v n -> SizeSpec v n
forall (v :: * -> *) n. v n -> SizeSpec v n
dims (v n -> SizeSpec v n)
-> (v (Maybe n) -> v n) -> v (Maybe n) -> SizeSpec v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe n -> n) -> v (Maybe n) -> v n
forall a b. (a -> b) -> v a -> v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
0)

-- | Make a 'SizeSpec' from a vector. Any negative values will be ignored.
dims :: v n -> SizeSpec v n
dims :: forall (v :: * -> *) n. v n -> SizeSpec v n
dims = v n -> SizeSpec v n
forall (v :: * -> *) n. v n -> SizeSpec v n
SizeSpec

-- | A size spec with no hints to the size.
absolute :: (Additive v, Num n) => SizeSpec v n
absolute :: forall (v :: * -> *) n. (Additive v, Num n) => SizeSpec v n
absolute = v n -> SizeSpec v n
forall (v :: * -> *) n. v n -> SizeSpec v n
SizeSpec v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero

-- | @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 :: forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize n
n (SizeSpec v n -> v (Maybe n)
forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec -> v (Maybe n)
spec) = (Maybe n -> n) -> v (Maybe n) -> v n
forall a b. (a -> b) -> v a -> v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
smallest) v (Maybe n)
spec
  where
    smallest :: n
smallest = n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
n (Maybe n -> n) -> Maybe n -> n
forall a b. (a -> b) -> a -> b
$ Getting (Endo (Endo (Maybe n))) (v (Maybe n)) n
-> v (Maybe n) -> Maybe n
forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf ((Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n))
-> v (Maybe n) -> Const (Endo (Endo (Maybe n))) (v (Maybe n))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (v (Maybe n)) (Maybe n)
folded ((Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n))
 -> v (Maybe n) -> Const (Endo (Endo (Maybe n))) (v (Maybe n)))
-> ((n -> Const (Endo (Endo (Maybe n))) n)
    -> Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n))
-> Getting (Endo (Endo (Maybe n))) (v (Maybe n)) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Const (Endo (Endo (Maybe n))) n)
-> Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) v (Maybe n)
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 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 :: forall (v :: * -> *) n.
(Additive v, Foldable v, Fractional n, Ord n) =>
SizeSpec v n -> v n -> n
requiredScale (SizeSpec v n -> v (Maybe n)
forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec -> v (Maybe n)
spec) v n
sz
  | Getting All (v (Maybe n)) n -> (n -> Bool) -> v (Maybe n) -> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf ((Maybe n -> Const All (Maybe n))
-> v (Maybe n) -> Const All (v (Maybe n))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (v (Maybe n)) (Maybe n)
folded ((Maybe n -> Const All (Maybe n))
 -> v (Maybe n) -> Const All (v (Maybe n)))
-> ((n -> Const All n) -> Maybe n -> Const All (Maybe n))
-> Getting All (v (Maybe n)) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Const All n) -> Maybe n -> Const All (Maybe n)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
0) v (Maybe n)
usedSz = n
1
  | Bool
otherwise                            = n -> Maybe n -> n
forall a. a -> Maybe a -> a
fromMaybe n
1 Maybe n
mScale
  where
    usedSz :: v (Maybe n)
usedSz = (n -> Maybe n -> Maybe n) -> v n -> v (Maybe n) -> v (Maybe n)
forall a b c. (a -> b -> c) -> v a -> v b -> v c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> Maybe n -> Maybe n
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) v n
sz v (Maybe n)
spec
    scales :: v (Maybe n)
scales = (Maybe n -> n -> Maybe n) -> v (Maybe n) -> v n -> v (Maybe n)
forall a b c. (a -> b -> c) -> v a -> v b -> v c
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 Maybe n -> n -> Maybe n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
(^/) v (Maybe n)
spec v n
sz
    mScale :: Maybe n
mScale = Getting (Endo (Endo (Maybe n))) (v (Maybe n)) n
-> v (Maybe n) -> Maybe n
forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf ((Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n))
-> v (Maybe n) -> Const (Endo (Endo (Maybe n))) (v (Maybe n))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (v (Maybe n)) (Maybe n)
folded ((Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n))
 -> v (Maybe n) -> Const (Endo (Endo (Maybe n))) (v (Maybe n)))
-> ((n -> Const (Endo (Endo (Maybe n))) n)
    -> Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n))
-> Getting (Endo (Endo (Maybe n))) (v (Maybe n)) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Const (Endo (Endo (Maybe n))) n)
-> Maybe n -> Const (Endo (Endo (Maybe n))) (Maybe n)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) v (Maybe n)
scales

-- | Return the 'Transformation' calcuated from 'requiredScale'.
requiredScaling :: (Additive v, Foldable v, Fractional n, Ord n)
  => SizeSpec v n -> v n -> Transformation v n
requiredScaling :: forall (v :: * -> *) n.
(Additive v, Foldable v, Fractional n, Ord n) =>
SizeSpec v n -> v n -> Transformation v n
requiredScaling SizeSpec v n
spec = n -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling (n -> Transformation v n)
-> (v n -> n) -> v n -> Transformation v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeSpec v n -> v n -> n
forall (v :: * -> *) n.
(Additive v, Foldable v, Fractional n, Ord n) =>
SizeSpec v n -> v n -> n
requiredScale SizeSpec v n
spec

-- | Uniformly scale any enveloped object so that it fits within the
--   given size. For non-uniform scaling see 'boxFit'.
sized :: (InSpace v n a, HasLinearMap v, Transformable a, Enveloped a)
      => SizeSpec v n -> a -> a
sized :: forall (v :: * -> *) n a.
(InSpace v n a, HasLinearMap v, Transformable a, Enveloped a) =>
SizeSpec v n -> a -> a
sized SizeSpec v n
spec a
a = Transformation (V a) (N a) -> a -> a
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (SizeSpec v n -> v n -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Foldable v, Fractional n, Ord n) =>
SizeSpec v n -> v n -> Transformation v n
requiredScaling SizeSpec v n
spec (a -> v n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a, HasBasis v) =>
a -> v n
size a
a)) a
a

-- | Uniformly scale an enveloped object so that it \"has the same
--   size as\" (fits within the width and height of) some other
--   object.
sizedAs :: (InSpace v n a, SameSpace a b, HasLinearMap v, Transformable a,
            Enveloped a, Enveloped b)
        => b -> a -> a
sizedAs :: forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, HasLinearMap v, Transformable a,
 Enveloped a, Enveloped b) =>
b -> a -> a
sizedAs b
other = SizeSpec v n -> a -> a
forall (v :: * -> *) n a.
(InSpace v n a, HasLinearMap v, Transformable a, Enveloped a) =>
SizeSpec v n -> a -> a
sized (v n -> SizeSpec v n
forall (v :: * -> *) n. v n -> SizeSpec v n
dims (v n -> SizeSpec v n) -> v n -> SizeSpec v n
forall a b. (a -> b) -> a -> b
$ b -> v n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a, HasBasis v) =>
a -> v n
size b
other)

-- | 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 :: forall (v :: * -> *) n.
(Additive v, Foldable v, OrderedField n) =>
SizeSpec v n -> BoundingBox v n -> (v n, Transformation v n)
sizeAdjustment SizeSpec v n
spec BoundingBox v n
bb = (v n
sz', Transformation v n
t)
  where
    v :: Diff (Point v) n
v = (n
0.5 n -> Point v n -> Point v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n -> Point v n
forall (f :: * -> *) a. f a -> Point f a
P v n
sz') Point v n -> Point v n -> Diff (Point v) n
forall a. Num a => Point v a -> Point v a -> Diff (Point v) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. (n
s n -> Point v n -> Point v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Point v n -> Maybe (Point v n) -> Point v n
forall a. a -> Maybe a -> a
fromMaybe Point v n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (BoundingBox v n -> Maybe (Point v n)
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> Maybe (Point v n)
boxCenter BoundingBox v n
bb))

    sz :: v n
sz  = BoundingBox v n -> v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
BoundingBox v n -> v n
boxExtents BoundingBox v n
bb
    sz' :: v n
sz' = if Getting All (v (Maybe n)) (Maybe n)
-> (Maybe n -> Bool) -> v (Maybe n) -> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf Getting All (v (Maybe n)) (Maybe n)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (v (Maybe n)) (Maybe n)
folded Maybe n -> Bool
forall a. Maybe a -> Bool
isJust (SizeSpec v n -> v (Maybe n)
forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec SizeSpec v n
spec)
            then n -> SizeSpec v n -> v n
forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize n
0 SizeSpec v n
spec
            else n
s n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
sz

    s :: n
s = SizeSpec v n -> v n -> n
forall (v :: * -> *) n.
(Additive v, Foldable v, Fractional n, Ord n) =>
SizeSpec v n -> v n -> n
requiredScale SizeSpec v n
spec v n
sz

    t :: Transformation v n
t = v n -> Transformation v n
forall (v :: * -> *) n. v n -> Transformation v n
translation v n
Diff (Point v) n
v Transformation v n -> Transformation v n -> Transformation v n
forall a. Semigroup a => a -> a -> a
<> n -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling n
s