{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Graphics.Layout.Grid where

import Data.Either (fromRight)
import Data.Text (Text)
import Data.List (intersperse)
import Graphics.Layout.Box as B

import Debug.Trace (trace)

data Grid m n = Grid {
    rows :: [(Name, Either m Double)],
    rowBounds :: [(Double, Double)],
    columns :: [(Name, Either n Double)],
    colBounds :: [(Double, Double)],
    gap :: Size m n,
    containerSize :: Size m n -- wrap in a Flow box to get padding, etc.
}
data GridItem m n = GridItem {
    startRow :: Int, endRow :: Int, startCol :: Int, endCol :: Int,
    alignment :: Size Alignment Alignment,
    gridItemBox :: PaddedBox m n
}
data Alignment = Start | Mid | End

type Name = Text

buildGrid rows columns = Grid {
    rows = zip (repeat "") rows,
    rowBounds = [],
    columns = zip (repeat "") columns,
    colBounds = [],
    gap = Size (Pixels 0) (Pixels 0),
    containerSize = Size Auto Auto
}

cellsForCol :: [GridItem y x] -> Int -> [GridItem y x]
cellsForCol cells ix =
    [cell | cell <- cells, startCol cell == ix, startCol cell == pred (endCol cell)]
cellsForRow :: [GridItem y x] -> Int -> [GridItem y x]
cellsForRow cells ix =
    [cell | cell <- cells, startRow cell == ix, startRow cell == pred (endRow cell)]
verifyGrid self childs = and [
    startRow < width && startRow >= 0 && endRow < width && endRow >= 0 &&
    endCol > startCol && endRow > startRow &&
    startCol < height && startCol >= 0 && endCol < height && endCol >= 0 |
    GridItem {..} <- childs]
  where
    width = length $ columns self
    height = length $ rows self

gridEstWidth :: Grid b Length -> [GridItem y Double] -> Double
gridEstWidth self childs = fst $ gridMaxWidths zeroBox self $ zip mins nats
  where
    mins = snd $ gridMinWidths 0 self childs
    nats = snd $ gridNatWidths 0 self childs
gridMinWidths :: Double -> Grid b Length -> [GridItem y Double] -> (Double, [Double])
gridMinWidths parent self childs =
    (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
  where
    ret = map colMinWidth $ enumerate $ map snd $ columns self
    colMinWidth (_, Left (Pixels x)) = x
    colMinWidth (_, Left (Percent x)) = x * parent
    colMinWidth arg@(ix, Left Preferred) =
        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
    colMinWidth (ix, _) =
        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
gridNatWidths :: Double -> Grid b Length -> [GridItem y Double] -> (Double, [Double])
gridNatWidths parent self childs =
    (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
  where
    ret = map colNatWidth $ enumerate $ map snd $ columns self
    colNatWidth (_, Left (Pixels x)) = x
    colNatWidth (_, Left (Percent x)) = x * parent
    colNatWidth arg@(ix, Left Min) =
        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
    colNatWidth (ix, _) =
        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
gridMaxWidths :: PaddedBox b Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
gridMaxWidths parent self subwidths =
    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
  where
    ret = map (colMaxWidth fr) $ zip subwidths $ map snd $ columns self
    fr = Prelude.max 0 fr'
    fr' = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
    outerwidth = inline $ size parent
    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
        map (colMaxWidth 0) $ zip subwidths $ map snd $ columns self
    colMaxWidth _ (_, Left (Pixels x)) = x
    colMaxWidth _ (_, Left (Percent x)) = x*(inline $ size parent)
    colMaxWidth _ ((_, nat), Left Preferred) = nat
    colMaxWidth _ ((min, _), Left Min) = min
    colMaxWidth fr (_, Left Auto) = fr
    colMaxWidth fr (_, Right x) = x*fr
gridWidths :: PaddedBox b Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
gridWidths parent self subwidths =
    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
  where
    ret = map (colWidth fr) $ zip subwidths $ map snd $ columns self
    fr = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
    outerwidth = inline $ size parent
    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
        map (colWidth 0) $ zip subwidths $ map snd $ columns self
    colWidth fr ((min, nat), size) = Prelude.max min $ colWidth' fr ((min, nat), size)
    colWidth' _ (_, Left (Pixels x)) = x
    colWidth' _ (_, Left (Percent x)) = x*(inline $ size parent)
    colWidth' _ ((_, nat), Left Preferred) = nat
    colWidth' _ ((min, _), Left Min) = min
    colWidth' fr ((_, nat), Left Auto) = Prelude.min nat fr
    colWidth' fr (_, Right x) = x*fr

gridEstHeight :: Grid Length Double -> [GridItem Double Double] -> Double
gridEstHeight self childs = fst $ gridMaxHeights zeroBox self $ zip mins nats
  where
    mins = snd $ gridMinHeights 0 self childs
    nats = snd $ gridNatHeights 0 self childs
gridNatHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
gridNatHeights parent self childs =
    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
  where
    ret = map rowNatHeight $ enumerate $ map snd $ rows self
    rowNatHeight (_, Left (Pixels x)) = x
    rowNatHeight (_, Left (Percent x)) = x * parent
    rowNatHeight arg@(ix, Left Min) =
        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
    rowNatHeight (ix, _) =
        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
gridMinHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
gridMinHeights parent self childs =
    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
  where
    ret = map rowMinHeight $ enumerate $ map snd $ rows self
    rowMinHeight (_, Left (Pixels x)) = x
    rowMinHeight (_, Left (Percent x)) = x * parent
    rowMinHeight arg@(ix, Left Preferred) =
        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
    rowMinHeight (ix, _) =
        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
gridMaxHeights :: PaddedBox Double Double -> Grid Length Double ->
    [(Double, Double)] -> (Double, [Double])
gridMaxHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
  where
    ret = map (colMaxHeight fr) $ zip subheights $ map snd $ rows self
    fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
    outerwidth = inline $ size parent
    outerheight = block $ size parent
    estimate = sum $ intersperse (inline $ gap self) $
        map (colMaxHeight 0) $ zip subheights $ map snd $ rows self
    colMaxHeight _ (_, Left (Pixels x)) = x
    colMaxHeight _ (_, Left (Percent x)) = x*outerwidth
    colMaxHeight _ ((_, nat), Left Preferred) = nat
    colMaxHeight _ ((min, _), Left Min) = min
    colMaxHeight fr (_, Left Auto) = fr
    colMaxHeight fr (_, Right x) = x*fr
gridHeights :: PaddedBox Double Double -> Grid Length Double ->
    [(Double, Double)] -> (Double, [Double])
gridHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
  where
    ret = map (colHeight fr) $ zip subheights $ map snd $ rows self
    fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
    outerwidth = inline $ size parent
    outerheight = block $ size parent
    estimate = sum $ intersperse (inline $ gap self) $
        map (colHeight 0) $ zip subheights $ map snd $ rows self
    colHeight fr ((min, nat), size) = Prelude.max min $ colHeight' fr ((min, nat), size)
    colHeight' _ (_, Left (Pixels x)) = x
    colHeight' _ (_, Left (Percent x)) = x*outerwidth
    colHeight' _ ((_, nat), Left Preferred) = nat
    colHeight' _ ((min, _), Left Min) = min
    colHeight' fr ((min, nat), Left Auto) = Prelude.min fr nat
    colHeight' fr (_, Right x) = x*fr

gridPosition :: Grid Double Double -> [GridItem Double Double] -> [Size Double Double]
gridPosition self childs = map gridCellPosition childs
  where
    gridCellPosition child =
        Size (x + align extraWidth alignX) (y + align extraHeight alignY)
      where
        Size x y = gridCellPosition' child
        Size alignX alignY = alignment child
        width = track (endCol child) (columns self) - track (startCol child) (columns self)
        height = track (endRow child) (rows self) - track (startRow child) (columns self)
        extraWidth = width - inline (size $ gridItemBox child)
        extraHeight = height - block (size $ gridItemBox child)
    gridCellPosition' child =
        Size (startCol child `track` columns self) (startRow child `track` rows self)
    track ix (size:sizes) = fromRight 0 (snd size) + track (pred ix) sizes
    track 0 _ = 0
    track ix [] = trace "WARNING! Malformed input table!" 0
    align _ Start = 0
    align excess Mid = excess/2
    align excess End = excess
gridLayout :: PaddedBox Double Double -> Grid Length Length ->
        [GridItem Double Double] -> Bool ->
        (Grid Double Double, [(Size Double Double, GridItem Double Double)])
gridLayout parent self childs paginate = (self', zip positions childs)
  where
    positions = gridPosition self' childs
    self' = self {
        rows = zip (map fst $ rows self) $ map Left rows',
        rowBounds = rowBounds',
        columns = zip (map fst $ rows self) $ map Left cols',
        colBounds = colBounds',
        gap = Size (lowerLength width' gapX) (lowerLength width' gapY),
        containerSize = Size width' height'
      }
    Size gapX gapY = gap self

    (height', rows') = gridHeights parent self0 rowBounds'
    rowBounds' = zip rowMins rowNats
    (_, rowMins) = gridMinHeights estHeight self0 childs
    (_, rowNats) = gridNatHeights estHeight self0 childs
    estHeight = gridEstHeight self0 childs

    self0 = self {
        columns = zip (map fst $ columns self) $ map Left cols',
        colBounds = colBounds',
        gap = Size (lowerLength width' gapX) gapY,
        containerSize = let Size _ y = containerSize self in Size width' y
      }
    (width', cols') = gridWidths parent self colBounds'
    colBounds' = zip colMins colNats
    (_, colMins) = gridMinWidths estWidth self childs
    (_, colNats) = gridNatWidths estWidth self childs
    estWidth = gridEstWidth self childs

enumerate = zip [0..]

countFRs (Left Auto:rest) = succ $ countFRs rest
countFRs (Right x:rest) = x + countFRs rest
countFRs (_:rest) = countFRs rest
countFRs [] = 0