{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Layout.Grid
-- Copyright   :  (c) 2014 Pontus Granström
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  pnutus@gmail.com
--
-- Functions for effortlessly putting lists of diagrams in a grid layout.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Layout.Grid
    (
      gridCat
    , gridCat'
    , gridSnake
    , gridSnake'
    , gridWith

    , sameBoundingRect
    , sameBoundingSquare

    ) where

import           Data.List        (maximumBy)
import           Data.Ord         (comparing)

import           Data.List.Split  (chunksOf)

import           Diagrams.Prelude

-- * Grid Layout

-- | Puts a list of diagrams in a grid, left-to-right, top-to-bottom.
--   The grid is as close to square as possible.
--
-- > import Diagrams.TwoD.Layout.Grid
-- > gridCatExample = gridCat $ map (flip regPoly 1) [3..10]
--
-- <<diagrams/src_Diagrams_TwoD_Layout_Grid_gridCatExample.svg#diagram=gridCatExample&width=200>>

gridCat
  :: TypeableFloat n
  => [QDiagram b V2 n Any]
  -> QDiagram b V2 n Any
gridCat :: forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridCat [] = forall a. Monoid a => a
mempty
gridCat [QDiagram b V2 n Any]
diagrams = forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridCat' (Int -> Int
intSqrt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [QDiagram b V2 n Any]
diagrams) [QDiagram b V2 n Any]
diagrams

-- | Same as 'gridCat', but with a specified number of columns.
--
-- > import Diagrams.TwoD.Layout.Grid
-- > gridCatExample' = gridCat' 4 $ map (flip regPoly 1) [3..10]
--
-- <<diagrams/src_Diagrams_TwoD_Layout_Grid_gridCatExample'.svg#diagram=gridCatExample'&width=200>>

gridCat'
  :: TypeableFloat n
  => Int -> [QDiagram b V2 n Any]
  -> QDiagram b V2 n Any
gridCat' :: forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridCat' = forall n b.
TypeableFloat n =>
([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]])
-> Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridAnimal forall a. a -> a
id

-- | Puts a list of diagrams in a grid, alternating left-to-right
--   and right-to-left. Useful for comparing sequences of diagrams.
--   The grid is as close to square as possible.
--
-- > import Diagrams.TwoD.Layout.Grid
-- > gridSnakeExample = gridSnake $ map (flip regPoly 1) [3..10]
--
-- <<diagrams/src_Diagrams_TwoD_Layout_Grid_gridSnakeExample.svg#diagram=gridSnakeExample&width=200>>

gridSnake
  :: TypeableFloat n
  => [QDiagram b V2 n Any]
  -> QDiagram b V2 n Any
gridSnake :: forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridSnake [] = forall a. Monoid a => a
mempty
gridSnake [QDiagram b V2 n Any]
diagrams = forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridSnake' (Int -> Int
intSqrt forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [QDiagram b V2 n Any]
diagrams) [QDiagram b V2 n Any]
diagrams

-- | Same as 'gridSnake', but with a specified number of columns.
--
-- > import Diagrams.TwoD.Layout.Grid
-- > gridSnakeExample' = gridSnake' 4 $ map (flip regPoly 1) [3..10]
--
-- <<diagrams/src_Diagrams_TwoD_Layout_Grid_gridSnakeExample'.svg#diagram=gridSnakeExample'&width=200>>

gridSnake'
  :: TypeableFloat n
  => Int -> [QDiagram b V2 n Any]
  -> QDiagram b V2 n Any
gridSnake' :: forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridSnake' = forall n b.
TypeableFloat n =>
([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]])
-> Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridAnimal (forall a. (a -> a) -> [a] -> [a]
everyOther forall a. [a] -> [a]
reverse)

-- | Generalisation of gridCat and gridSnake to not repeat code.
gridAnimal
  :: TypeableFloat n
  => ([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]]) -> Int -> [QDiagram b V2 n Any]
  -> QDiagram b V2 n Any
gridAnimal :: forall n b.
TypeableFloat n =>
([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]])
-> Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridAnimal [[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]]
rowFunction Int
cols = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]]
rowFunction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Int -> [e] -> [[e]]
chunksOf Int
cols forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
sameBoundingRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a] -> [a]
padList Int
cols forall a. Monoid a => a
mempty

-- | `gridWith f (cols, rows)` uses `f`, a function of two
--   zero-indexed integer coordinates, to generate a grid of diagrams
--   with the specified dimensions.
gridWith
  :: TypeableFloat n
  => (Int -> Int -> QDiagram b V2 n Any) -> (Int, Int)
  -> QDiagram b V2 n Any
gridWith :: forall n b.
TypeableFloat n =>
(Int -> Int -> QDiagram b V2 n Any)
-> (Int, Int) -> QDiagram b V2 n Any
gridWith Int -> Int -> QDiagram b V2 n Any
f (Int
cols, Int
rows) = forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridCat' Int
cols [QDiagram b V2 n Any]
diagrams
  where
    diagrams :: [QDiagram b V2 n Any]
diagrams = [ Int -> Int -> QDiagram b V2 n Any
f Int
x Int
y | Int
y <- [Int
0..Int
rows forall a. Num a => a -> a -> a
- Int
1] , Int
x <- [Int
0..Int
cols forall a. Num a => a -> a -> a
- Int
1] ]

-- * Bounding boxes

-- | Make all diagrams have the same bounding square,
--   one that bounds them all.
sameBoundingSquare
  :: forall b n. TypeableFloat n
  => [QDiagram b V2 n Any]
  -> [QDiagram b V2 n Any]
sameBoundingSquare :: forall b n.
TypeableFloat n =>
[QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
sameBoundingSquare [QDiagram b V2 n Any]
diagrams = forall a b. (a -> b) -> [a] -> [b]
map QDiagram b V2 n Any -> QDiagram b V2 n Any
frameOne [QDiagram b V2 n Any]
diagrams
  where
    biggest :: QDiagram b V2 n Any
biggest        = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall {a}. (V a ~ V2, Enveloped a) => a -> N a
maxDim) [QDiagram b V2 n Any]
diagrams
    maxDim :: a -> N a
maxDim a
diagram = forall a. Ord a => a -> a -> a
max (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width a
diagram) (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height a
diagram)
    centerP :: Point V2 n
centerP        = forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Point v n
centerPoint QDiagram b V2 n Any
biggest
    padSquare :: QDiagram b V2 n Any
padSquare      = (forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square (forall {a}. (V a ~ V2, Enveloped a) => a -> N a
maxDim QDiagram b V2 n Any
biggest) :: D V2 n) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a m b.
(InSpace v n a, Monoid' m, Enveloped a, Traced a) =>
a -> QDiagram b v n m
phantom
    frameOne :: QDiagram b V2 n Any -> QDiagram b V2 n Any
frameOne       = forall n (v :: * -> *) m b.
(OrderedField n, Metric v, Semigroup m) =>
QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
atop QDiagram b V2 n Any
padSquare forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point V2 n
centerP


-- | Make all diagrams have the same bounding rect,
--   one that bounds them all.
sameBoundingRect
  :: forall n b. TypeableFloat n
  => [QDiagram b V2 n Any]
  -> [QDiagram b V2 n Any]
sameBoundingRect :: forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
sameBoundingRect [QDiagram b V2 n Any]
diagrams = forall a b. (a -> b) -> [a] -> [b]
map QDiagram b V2 n Any -> QDiagram b V2 n Any
frameOne [QDiagram b V2 n Any]
diagrams
  where
    widest :: QDiagram b V2 n Any
widest = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width) [QDiagram b V2 n Any]
diagrams
    tallest :: QDiagram b V2 n Any
tallest = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height) [QDiagram b V2 n Any]
diagrams
    (n
xCenter :& n
_) = forall c. Coordinates c => c -> Decomposition c
coords (forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Point v n
centerPoint QDiagram b V2 n Any
widest)
    (n
_ :& n
yCenter) = forall c. Coordinates c => c -> Decomposition c
coords (forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Point v n
centerPoint QDiagram b V2 n Any
tallest)
    padRect :: QDiagram b V2 n Any
padRect = (forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width QDiagram b V2 n Any
widest) (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height QDiagram b V2 n Any
tallest) :: D V2 n) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a m b.
(InSpace v n a, Monoid' m, Enveloped a, Traced a) =>
a -> QDiagram b v n m
phantom
    frameOne :: QDiagram b V2 n Any -> QDiagram b V2 n Any
frameOne = forall n (v :: * -> *) m b.
(OrderedField n, Metric v, Semigroup m) =>
QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
atop QDiagram b V2 n Any
padRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo (n
xCenter forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& n
yCenter)

-- * Helper functions.

intSqrt :: Int -> Int
intSqrt :: Int -> Int
intSqrt = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
sqrt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Float)

everyOther :: (a -> a) -> [a] -> [a]
everyOther :: forall a. (a -> a) -> [a] -> [a]
everyOther a -> a
f = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. (a -> b) -> a -> b
($) (forall a. [a] -> [a]
cycle [forall a. a -> a
id, a -> a
f])

padList :: Int -> a -> [a] -> [a]
padList :: forall a. Int -> a -> [a] -> [a]
padList Int
m a
padding [a]
xs = [a]
xs forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall a. Integral a => a -> a -> a
mod (- forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Int
m) a
padding