{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : FULE.Container.Grid
-- Description : The @Grid@ Container.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- A two-dimensional grid of items, evenly spaced.
--
-- You may also wish to consider the 'FULE.Container.Arrayed' Container.
module FULE.Container.Grid
 ( GridM
 , Grid
 , grid
 ) where

import Data.Functor.Identity

import FULE.Component
import FULE.Container
import FULE.Container.Item
import FULE.Internal.Util
import FULE.Layout
import FULE.LayoutOp


-- | A two-dimensional grid of visual 'FULE.Container.Item.ItemM's, evenly spaced.
data GridM m k
  = Grid
    { forall (m :: * -> *) k. GridM m k -> Int
rowCountOf :: Int
    , forall (m :: * -> *) k. GridM m k -> Int
columnCountOf :: Int
    , forall (m :: * -> *) k. GridM m k -> [ItemM m k]
itemsOf :: [ItemM m k]
    }

-- | Like 'GridM' but run in the 'Data.Functor.Identity.Identity' monad.
type Grid = GridM Identity

instance (Monad m) => Container (GridM m k) k m where
  minWidth :: GridM m k -> Proxy k -> m (Maybe Int)
minWidth (Grid Int
_ Int
c [ItemM m k]
is) Proxy k
p = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c) (Maybe Int -> Maybe Int)
-> ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> Maybe Int
getMaxSize ([Maybe Int] -> Maybe Int) -> m [Maybe Int] -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemM m k -> m (Maybe Int)) -> [ItemM m k] -> m [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
`minWidth` Proxy k
p) [ItemM m k]
is
  minHeight :: GridM m k -> Proxy k -> m (Maybe Int)
minHeight (Grid Int
r Int
_ [ItemM m k]
is) Proxy k
p = (Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
r) (Maybe Int -> Maybe Int)
-> ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> Maybe Int
getMaxSize ([Maybe Int] -> Maybe Int) -> m [Maybe Int] -> m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ItemM m k -> m (Maybe Int)) -> [ItemM m k] -> m [Maybe Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ItemM m k -> Proxy k -> m (Maybe Int)
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> m (Maybe Int)
`minHeight` Proxy k
p) [ItemM m k]
is
  addToLayout :: GridM m k -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout (Grid Int
r Int
c [ItemM m k]
is) Proxy k
proxy Bounds
bounds Maybe Int
renderGroup = do
    let addBetween :: (Bounds -> GuideID)
-> (Bounds -> GuideID) -> Double -> LayoutOp k m GuideID
addBetween Bounds -> GuideID
f1 Bounds -> GuideID
f2 Double
p =
          GuideSpecification -> LayoutOp k m GuideID
forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout (GuideSpecification -> LayoutOp k m GuideID)
-> GuideSpecification -> LayoutOp k m GuideID
forall a b. (a -> b) -> a -> b
$ (GuideID, Double) -> (GuideID, Double) -> GuideSpecification
Between (Bounds -> GuideID
f1 Bounds
bounds, Double
p) (Bounds -> GuideID
f2 Bounds
bounds, Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
p)
    [GuideID]
elasHorizs <- (Double
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
-> [Double]
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) [GuideID]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Bounds -> GuideID)
-> (Bounds -> GuideID)
-> Double
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall {m :: * -> *} {k}.
Monad m =>
(Bounds -> GuideID)
-> (Bounds -> GuideID) -> Double -> LayoutOp k m GuideID
addBetween Bounds -> GuideID
topOf Bounds -> GuideID
bottomOf) (Int -> [Double]
percents Int
r)
    [GuideID]
elasVerts <- (Double
 -> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID)
-> [Double]
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) [GuideID]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Bounds -> GuideID)
-> (Bounds -> GuideID)
-> Double
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) GuideID
forall {m :: * -> *} {k}.
Monad m =>
(Bounds -> GuideID)
-> (Bounds -> GuideID) -> Double -> LayoutOp k m GuideID
addBetween Bounds -> GuideID
leftOf Bounds -> GuideID
rightOf) (Int -> [Double]
percents Int
c)
    let tops :: [GuideID]
tops = Bounds -> GuideID
topOf Bounds
bounds GuideID -> [GuideID] -> [GuideID]
forall a. a -> [a] -> [a]
: [GuideID]
elasHorizs
    let lefts :: [GuideID]
lefts = Bounds -> GuideID
leftOf Bounds
bounds GuideID -> [GuideID] -> [GuideID]
forall a. a -> [a] -> [a]
: [GuideID]
elasVerts
    let rights :: [GuideID]
rights = [GuideID]
elasVerts [GuideID] -> [GuideID] -> [GuideID]
forall a. [a] -> [a] -> [a]
++ [Bounds -> GuideID
rightOf Bounds
bounds]
    let bottoms :: [GuideID]
bottoms = [GuideID]
elasHorizs [GuideID] -> [GuideID] -> [GuideID]
forall a. [a] -> [a] -> [a]
++ [Bounds -> GuideID
bottomOf Bounds
bounds]
    let boundsForItems :: [Bounds]
boundsForItems =
          [GuideID -> GuideID -> GuideID -> GuideID -> Maybe Bounds -> Bounds
Bounds GuideID
t GuideID
l GuideID
r GuideID
b (Bounds -> Maybe Bounds
clippingOf Bounds
bounds)
          | (GuideID
t, GuideID
b) <- [GuideID] -> [GuideID] -> [(GuideID, GuideID)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GuideID]
tops [GuideID]
bottoms
          , (GuideID
l, GuideID
r) <- [GuideID] -> [GuideID] -> [(GuideID, GuideID)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GuideID]
lefts [GuideID]
rights
          ]
    ((ItemM m k, Bounds) -> LayoutOp k m ())
-> [(ItemM m k, Bounds)] -> LayoutOp k m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(ItemM m k
i, Bounds
b) -> ItemM m k -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
forall c k (m :: * -> *).
Container c k m =>
c -> Proxy k -> Bounds -> Maybe Int -> LayoutOp k m ()
addToLayout ItemM m k
i Proxy k
proxy Bounds
b Maybe Int
renderGroup) ([ItemM m k] -> [Bounds] -> [(ItemM m k, Bounds)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ItemM m k]
is [Bounds]
boundsForItems)

percents :: Int -> [Double]
percents :: Int -> [Double]
percents Int
n = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
i -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) [Int
1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

-- | Create a 'GridM' of 'FULE.Container.Item.ItemM's.
grid
  :: (Int, Int) -- ^ The number of rows and columns the 'GridM' should have.
  -> [ItemM m k]
  -- ^ The 'FULE.Container.Item.ItemM's to put in the 'GridM'.
  --
  --   Placement of the 'FULE.Container.Item.ItemM's will start with the
  --   top-left position of the grid and proceed to the right, wrapping
  --   around to the next row when the end of the previous row has been reached.
  --
  --   If the number of elements in this list does not meet or exceeds the number
  --   of grid locations available, then up-to the number of grid locations will
  --   be filled, but no more than that.
  -> GridM m k
grid :: forall (m :: * -> *) k. (Int, Int) -> [ItemM m k] -> GridM m k
grid (Int
rows, Int
cols) = Int -> Int -> [ItemM m k] -> GridM m k
forall (m :: * -> *) k. Int -> Int -> [ItemM m k] -> GridM m k
Grid (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
rows) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
cols)