{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
SizeSpec v n -> SizeSpec v n -> Bool
Eq,
  Typeable,
  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
<$ :: forall a b. a -> SizeSpec v b -> SizeSpec v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> SizeSpec v b -> SizeSpec v a
fmap :: forall a b. (a -> b) -> SizeSpec v a -> SizeSpec v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> SizeSpec v a -> SizeSpec v b
Functor,
  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
$cto :: forall (v :: * -> *) n x. Rep (SizeSpec v n) x -> SizeSpec v n
$cfrom :: forall (v :: * -> *) n x. SizeSpec v n -> Rep (SizeSpec v n) x
Generic,
  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
hash :: SizeSpec v n -> Int
$chash :: forall (v :: * -> *) n. Hashable (v n) => SizeSpec v n -> Int
hashWithSalt :: Int -> SizeSpec v n -> Int
$chashWithSalt :: forall (v :: * -> *) n.
Hashable (v n) =>
Int -> SizeSpec v n -> Int
Hashable,
  Int -> SizeSpec v n -> ShowS
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
showList :: [SizeSpec v n] -> ShowS
$cshowList :: forall (v :: * -> *) n. Show (v n) => [SizeSpec v n] -> ShowS
show :: SizeSpec v n -> String
$cshow :: forall (v :: * -> *) n. Show (v n) => SizeSpec v n -> String
showsPrec :: Int -> SizeSpec v n -> ShowS
$cshowsPrec :: forall (v :: * -> *) n. Show (v n) => Int -> 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) = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (forall a. Ord a => a -> a -> Bool
>n
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just 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 = forall (v :: * -> *) n. v n -> SizeSpec v n
dims forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 = 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 = forall (v :: * -> *) n. v n -> SizeSpec v n
SizeSpec 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 (forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec -> v (Maybe n)
spec) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe n
smallest) v (Maybe n)
spec
  where
    smallest :: n
smallest = forall a. a -> Maybe a -> a
fromMaybe n
n forall a b. (a -> b) -> a -> b
$ forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a 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 (forall (v :: * -> *) n.
(Functor v, Num n, Ord n) =>
SizeSpec v n -> v (Maybe n)
getSpec -> v (Maybe n)
spec) v n
sz
  | forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (forall a. Ord a => a -> a -> Bool
<= n
0) v (Maybe n)
usedSz = n
1
  | Bool
otherwise                            = forall a. a -> Maybe a -> a
fromMaybe n
1 Maybe n
mScale
  where
    usedSz :: v (Maybe n)
usedSz = forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) v n
sz v (Maybe n)
spec
    scales :: v (Maybe n)
scales = forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
(^/) v (Maybe n)
spec v n
sz
    mScale :: Maybe n
mScale = forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a 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 = forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall (v :: * -> *) n.
(Additive v, Foldable v, Fractional n, Ord n) =>
SizeSpec v n -> v n -> Transformation v n
requiredScaling SizeSpec v n
spec (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 = forall (v :: * -> *) n a.
(InSpace v n a, HasLinearMap v, Transformable a, Enveloped a) =>
SizeSpec v n -> a -> a
sized (forall (v :: * -> *) n. v n -> SizeSpec v n
dims forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (f :: * -> *) a. f a -> Point f a
P v n
sz') forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. (n
s forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> Maybe (Point v n)
boxCenter BoundingBox v n
bb))

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

    s :: n
s = 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 = forall (v :: * -> *) n. v n -> Transformation v n
translation Diff (Point v) n
v forall a. Semigroup a => a -> a -> a
<> forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling n
s