{-# 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 [] = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
gridCat [QDiagram b V2 n Any]
diagrams = Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridCat' (Int -> Int
intSqrt (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [QDiagram b V2 n Any] -> Int
forall a. [a] -> Int
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' = ([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]])
-> Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
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]]
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 [] = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
gridSnake [QDiagram b V2 n Any]
diagrams = Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall n b.
TypeableFloat n =>
Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
gridSnake' (Int -> Int
intSqrt (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [QDiagram b V2 n Any] -> Int
forall a. [a] -> Int
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' = ([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]])
-> Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
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])
-> [[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]]
forall a. (a -> a) -> [a] -> [a]
everyOther [QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
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 = [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
vcat ([QDiagram b V2 n Any] -> QDiagram b V2 n Any)
-> ([QDiagram b V2 n Any] -> [QDiagram b V2 n Any])
-> [QDiagram b V2 n Any]
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QDiagram b V2 n Any] -> QDiagram b V2 n Any)
-> [[QDiagram b V2 n Any]] -> [QDiagram b V2 n Any]
forall a b. (a -> b) -> [a] -> [b]
map [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
hcat ([[QDiagram b V2 n Any]] -> [QDiagram b V2 n Any])
-> ([QDiagram b V2 n Any] -> [[QDiagram b V2 n Any]])
-> [QDiagram b V2 n Any]
-> [QDiagram b V2 n Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]]
rowFunction
    ([[QDiagram b V2 n Any]] -> [[QDiagram b V2 n Any]])
-> ([QDiagram b V2 n Any] -> [[QDiagram b V2 n Any]])
-> [QDiagram b V2 n Any]
-> [[QDiagram b V2 n Any]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [QDiagram b V2 n Any] -> [[QDiagram b V2 n Any]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
cols ([QDiagram b V2 n Any] -> [[QDiagram b V2 n Any]])
-> ([QDiagram b V2 n Any] -> [QDiagram b V2 n Any])
-> [QDiagram b V2 n Any]
-> [[QDiagram b V2 n Any]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
sameBoundingRect ([QDiagram b V2 n Any] -> [QDiagram b V2 n Any])
-> ([QDiagram b V2 n Any] -> [QDiagram b V2 n Any])
-> [QDiagram b V2 n Any]
-> [QDiagram b V2 n Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> QDiagram b V2 n Any
-> [QDiagram b V2 n Any]
-> [QDiagram b V2 n Any]
forall a. Int -> a -> [a] -> [a]
padList Int
cols QDiagram b V2 n Any
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) = Int -> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] , Int
x <- [Int
0..Int
cols Int -> Int -> Int
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 = (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> [QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
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        = (QDiagram b V2 n Any -> QDiagram b V2 n Any -> Ordering)
-> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((QDiagram b V2 n Any -> n)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing QDiagram b V2 n Any -> n
QDiagram b V2 n Any -> N (QDiagram b V2 n Any)
forall {a}. (V a ~ V2, Enveloped a) => a -> N a
maxDim) [QDiagram b V2 n Any]
diagrams
    maxDim :: a -> N a
maxDim a
diagram = N a -> N a -> N a
forall a. Ord a => a -> a -> a
max (a -> N a
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width a
diagram) (a -> N a
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height a
diagram)
    centerP :: Point V2 n
centerP        = QDiagram b V2 n Any -> Point V2 n
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      = (n -> D V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square (QDiagram b V2 n Any -> N (QDiagram b V2 n Any)
forall {a}. (V a ~ V2, Enveloped a) => a -> N a
maxDim QDiagram b V2 n Any
biggest) :: D V2 n) D V2 n -> (D V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# D V2 n -> QDiagram b V2 n Any
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       = QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any))
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any))
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 = (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> [QDiagram b V2 n Any] -> [QDiagram b V2 n Any]
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 = (QDiagram b V2 n Any -> QDiagram b V2 n Any -> Ordering)
-> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((QDiagram b V2 n Any -> n)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing QDiagram b V2 n Any -> n
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 = (QDiagram b V2 n Any -> QDiagram b V2 n Any -> Ordering)
-> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((QDiagram b V2 n Any -> n)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing QDiagram b V2 n Any -> n
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height) [QDiagram b V2 n Any]
diagrams
    (n
xCenter :& n
_) = Point V2 n -> Decomposition (Point V2 n)
forall c. Coordinates c => c -> Decomposition c
coords (QDiagram b V2 n Any -> Point V2 n
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) = Point V2 n -> Decomposition (Point V2 n)
forall c. Coordinates c => c -> Decomposition c
coords (QDiagram b V2 n Any -> Point V2 n
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 = (n -> n -> D V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect (QDiagram b V2 n Any -> n
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width QDiagram b V2 n Any
widest) (QDiagram b V2 n Any -> n
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height QDiagram b V2 n Any
tallest) :: D V2 n) D V2 n -> (D V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# D V2 n -> QDiagram b V2 n Any
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 = QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any))
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo (n
PrevDim (Point V2 n)
xCenter PrevDim (Point V2 n) -> FinalCoord (Point V2 n) -> Point V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& n
FinalCoord (Point V2 n)
yCenter)

-- * Helper functions.

intSqrt :: Int -> Int
intSqrt :: Int -> Int
intSqrt = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> (Int -> Float) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Floating a => a -> a
sqrt (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Float
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 = ((a -> a) -> a -> a) -> [a -> a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) ([a -> a] -> [a -> a]
forall a. HasCallStack => [a] -> [a]
cycle [a -> a
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 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Int
m) a
padding