{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Graphics.Layout(LayoutItem(..),
        layoutGetBox, layoutGetChilds, layoutGetInner,
        boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,
        boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
        boxSplit, boxPaginate, boxPosition, boxLayout, glyphsPerFont) where

import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..), Fragment(..),
        ParagraphLayout(..), PageOptions(..), PageContinuity(..), paginate, layoutPlain)
import Stylist (PropertyParser(..))

import Graphics.Layout.Box as B
import Graphics.Layout.Grid as G
import Graphics.Layout.Flow as F
import Graphics.Layout.Inline as I
import Graphics.Layout.CSS.Font (Font'(..))

import Data.Maybe (fromMaybe)

-- To gather glyphs for atlases.
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Text.Glyphize as Hb
import Graphics.Text.Font.Choose (Pattern)

data LayoutItem m n x =
    LayoutFlow x (PaddedBox m n) [LayoutItem m n x]
    | LayoutGrid x (Grid m n) [(GridItem m n, LayoutItem m n x)]
    | LayoutInline x Font' Paragraph PageOptions [x] -- Balkon holds children.
    | LayoutInline' x Font' ParagraphLayout PageOptions [x]
    | LayoutSpan x Font' Fragment
-- More to come...
nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x
nullLayout = LayoutFlow temp zero []

layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>
        LayoutItem m n x -> PaddedBox m n
layoutGetBox (LayoutFlow _ ret _) = ret
layoutGetBox (LayoutGrid _ self _) = zero {
    B.min = containerMin self,
    B.size = containerSize self,
    B.max = containerMax self
}
layoutGetBox (LayoutInline _ f self _ _) = zero {
    B.min = inlineMin f self, B.size = inlineSize f self, B.max = inlineSize f self
}
layoutGetBox (LayoutInline' _ f self _ _) = zero {
    B.min = layoutSize f self, B.size = layoutSize f self, B.max = layoutSize f self
}
layoutGetBox (LayoutSpan _ f self) = zero {
    B.min = fragmentSize f self, B.size = fragmentSize f self, B.max = fragmentSize f self
}
layoutGetChilds (LayoutFlow _ _ ret) = ret
layoutGetChilds (LayoutGrid _ _ ret) = map snd ret
layoutGetChilds (LayoutSpan _ _ _) = []
layoutGetChilds (LayoutInline _ font self _ vals) = map inner $ inlineChildren vals self
  where inner (val, fragment) = LayoutSpan val font fragment
layoutGetChilds (LayoutInline' _ font self _ vals) = map inner $ layoutChildren vals self
  where inner (val, fragment) = LayoutSpan val font fragment
layoutGetInner (LayoutFlow ret _ _) = ret
layoutGetInner (LayoutGrid ret _ _) = ret
layoutGetInner (LayoutInline ret _ _ _ _) = ret
layoutGetInner (LayoutInline' ret _ _ _ _) = ret
layoutGetInner (LayoutSpan ret _ _) = ret

setCellBox' (child, cell) = cell { gridItemBox = layoutGetBox child }

boxMinWidth :: (Zero y, CastDouble y) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMinWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    self' = self { B.min = mapSizeX (B.mapAuto min') (B.min self) }
    min' = flowMinWidth parent' self childs''
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs' = map (boxMinWidth $ Just selfWidth) childs
    selfWidth = width $ mapX' (lowerLength parent') self
    parent' = fromMaybe 0 parent
boxMinWidth parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cells' childs'
  where
    self' = self {
        containerMin = Size (Pixels min') (block $ containerMin self),
        colBounds = zip cells (map snd (colBounds self) ++ repeat 0)
      }
    (min', cells) = gridMinWidths parent' self cells''
    cells'' = [ setCellBox (mapX' (lowerLength selfWidth) $ gridItemBox cell) cell
                | cell <- cells']
    cells' = map setCellBox' $ zip childs' $ map fst childs
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs' = map (boxMinWidth $ Just selfWidth) $ map snd childs
    selfWidth = lowerLength parent' $ inline $ containerSize self
    parent' = fromMaybe (gridEstWidth self [
        GridItem startRow endRow startCol endCol alignment zeroBox |
        (GridItem {..}, _) <- childs]) parent
    zeroBox :: PaddedBox Double Double
    zeroBox = zero
boxMinWidth _ self@(LayoutInline _ _ _ _ _) = self
boxMinWidth _ self@(LayoutInline' _ _ _ _ _) = self
boxMinWidth _ self@(LayoutSpan _ _ _) = self
boxNatWidth :: (Zero y, CastDouble y) =>
        Maybe Double -> LayoutItem y Length x -> LayoutItem y Length x
boxNatWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    self' = self { size = mapSizeX (B.mapAuto size') (size self) }
    size' = flowNatWidth parent' self childs''
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs' = map (boxNatWidth $ Just selfWidth) childs
    selfWidth = width $ mapX' (lowerLength parent') self
    parent' = fromMaybe 0 parent
boxNatWidth parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cells' childs'
  where
    self' = self {
        containerSize = Size (Pixels size') (block $ containerSize self),
        colBounds = zip (map fst (colBounds self) ++ repeat 0) cells
      }
    (size', cells) = gridNatWidths parent' self cells''
    cells'' = [
        cell { gridItemBox = mapX' (lowerLength selfWidth) $ gridItemBox cell }
        | cell <- cells']
    cells' = map setCellBox $ zip childs' $ map fst childs
    setCellBox (child, cell) = cell { gridItemBox = layoutGetBox child }
    childs'' = map (mapX' $ lowerLength selfWidth) $ map layoutGetBox childs'
    childs' = map (boxNatWidth $ Just selfWidth) $ map snd childs
    selfWidth = lowerLength parent' $ inline $ containerSize self
    parent' = fromMaybe (gridEstWidth self [
        GridItem startRow endRow startCol endCol alignment zeroBox |
        (GridItem {..}, _) <- childs]) parent
    zeroBox :: PaddedBox Double Double
    zeroBox = zero
boxNatWidth _ self@(LayoutInline _ _ _ _ _) = self
boxNatWidth _ self@(LayoutInline' _ _ _ _ _) = self
boxNatWidth _ self@(LayoutSpan _ _ _) = self
boxMaxWidth :: PaddedBox a Double -> LayoutItem y Length x -> LayoutItem y Length x
boxMaxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    childs' = map (boxMaxWidth self'') childs
    self'' = mapX' (lowerLength $ inline $ B.size parent) self'
    self' = self { B.max = Size (Pixels max') (block $ B.max self) }
    max' = flowMaxWidth parent self
boxMaxWidth parent (LayoutGrid val self childs) = LayoutGrid val self' childs
  where
    self' = self { containerMax = Size (Pixels max') (block $ containerMax self) }
    (max', _) = gridMaxWidths parent self $ colBounds self
boxMaxWidth parent self@(LayoutInline _ _ _ _ _) = self
boxMaxWidth parent self@(LayoutInline' _ _ _ _ _) = self
boxMaxWidth parent self@(LayoutSpan _ f self') = self
boxWidth :: (Zero y, CastDouble y) => PaddedBox b Double -> LayoutItem y Length x ->
        LayoutItem y Double x
boxWidth parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    childs' = map (boxWidth self') childs
    self' = (mapX' (lowerLength $ inline $ size parent) self) {
        size = Size size' $ block $ B.max self
      }
    size' = flowWidth parent self
boxWidth parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
  where
    childs' = map recurse childs
    recurse (cell, child) = (cell', child')
      where
        cell' = cell { gridItemBox = layoutGetBox child' }
        child' = boxWidth parent' child
        parent' = zero {
            B.min = containerMin self',
            B.size = containerSize self',
            B.max = containerMax self'
          }
    self' = Grid {
        containerSize = Size size' $ block $ containerSize self,
        containerMin = mapSizeX (lowerLength outerwidth) $ containerMin self,
        containerMax = mapSizeX (lowerLength outerwidth) $ containerMax self,
        gap = mapSizeX (lowerLength outerwidth) $ gap self,
        columns = map Left widths,

        rows = rows self,
        rowBounds = rowBounds self,
        colBounds = colBounds self,
        subgridRows = subgridRows self, subgridColumns = subgridColumns self
      }
    outerwidth = inline $ size parent
    (size', widths) = gridWidths parent self $ colBounds self
boxWidth parent (LayoutInline val font (Paragraph a b c d) paging vals) =
    LayoutInline val font (Paragraph a b c d { paragraphMaxWidth = round width }) paging vals
  where width = B.inline $ B.size parent
boxWidth _ (LayoutInline' a b c d e) = LayoutInline' a b c d e
boxWidth parent (LayoutSpan val font self') = LayoutSpan val font self'

boxNatHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxNatHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    self' = self { size = mapSizeY (mapAuto size') (size self) }
    size' = flowNatHeight parent self childs''
    childs'' = map (mapY' (lowerLength parent)) $ map layoutGetBox childs'
    childs' = map (boxNatHeight $ inline $ size self) childs
boxNatHeight parent (LayoutGrid val self childs) = LayoutGrid val self' $ zip cells childs'
  where
    self' = self {
        containerSize = Size width $ Pixels size'
    }
    lowerGridUnit (Left length) = Left $ lowerLength width length
    lowerGridUnit (Right x) = Right x
    (size', heights) = gridNatHeights parent self cells'
    cells' = [setCellBox (mapY' (lowerLength width) $ gridItemBox cell) cell | cell <- cells]
    cells = map setCellBox' $ zip childs' $ map fst childs
    childs' = map (boxNatHeight width) $ map snd childs
    width = inline $ containerSize self
boxNatHeight parent self@(LayoutInline _ _ _ _ _) = self
boxNatHeight parent self@(LayoutInline' _ _ _ _ _) = self
boxNatHeight parent self@(LayoutSpan _ _ _) = self
boxMinHeight :: Double -> LayoutItem Length Double x -> LayoutItem Length Double x
boxMinHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    childs' = map (boxMinHeight $ inline $ size self) childs
    self' = self { B.min = Size (inline $ B.min self) (Pixels min') }
    min' = flowMinHeight parent self
boxMinHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
  where
    childs' = map recurse childs
    recurse (cell, child) = (cell', child')
      where
        cell' = setCellBox (layoutGetBox child') cell
        child' = boxMinHeight width child
    self' = self {
        containerMin = Size width $ Pixels min',
        rowBounds = zip heights (map snd (rowBounds self) ++ repeat 0)
      }
    (min', heights) = gridMinHeights width self childs0
    childs0 = [ GridItem {
        gridItemBox = mapY' (lowerLength width) $ gridItemBox cell,
        startRow = startRow cell, endRow = endRow cell,
        startCol = startCol cell, endCol = endCol cell, alignment = alignment cell
      } | (cell, _) <- childs]
    width = inline $ containerSize self
boxMinHeight parent self@(LayoutInline _ _ _ _ _) = self
boxMinHeight _ self@(LayoutInline' _ _ _ _ _) = self
boxMinHeight parent self@(LayoutSpan _ font self') = self
boxMaxHeight :: PaddedBox Double Double -> LayoutItem Length Double x ->
        LayoutItem Length Double x
boxMaxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    childs' = map (boxMaxHeight $ mapY' (lowerLength width) self') childs
    self' = self { B.max = Size (inline $ B.max self) (Pixels max') }
    max' = flowMaxHeight (inline $ size parent) self
    width = inline $ size self
boxMaxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
  where
    childs' = map recurse childs
    recurse (cell, child) = (cell', child')
      where
        cell' = setCellBox (layoutGetBox child') cell
        child' = boxMaxHeight parent' child
        parent' :: PaddedBox Double Double
        parent' = zero {
            B.min = mapSizeY (lowerLength width) $ containerMin self,
            B.size = mapSizeY (lowerLength width) $ containerSize self,
            B.max = Size (inline $ containerMax self') max'
        }
    self' = self {
        containerMax = Size (inline $ containerSize self) (Pixels max')
      }
    (max', heights) = gridMaxHeights parent self $ rowBounds self
    width = inline $ size parent
boxMaxHeight parent (LayoutInline val font self' paging vals) =
    LayoutInline val font self' paging vals
boxMaxHeight parent (LayoutInline' val font self' paging vals) =
    LayoutInline' val font self' paging vals
boxMaxHeight parent (LayoutSpan val font self') = LayoutSpan val font self'
boxHeight :: PaddedBox Double Double -> LayoutItem Length Double x -> LayoutItem Double Double x
boxHeight parent (LayoutFlow val self childs) = LayoutFlow val self' childs'
  where
    childs' = map (boxHeight self') childs
    self' = (mapY' (lowerLength $ inline $ size parent) self) {
        size = Size (inline $ size self) size'
      }
    size' = flowHeight parent self
    width = inline $ size self
boxHeight parent (LayoutGrid val self childs) = LayoutGrid val self' childs'
  where
    childs' = map recurse childs
    recurse (cell, child) = (cell', child')
      where
        cell' = setCellBox (layoutGetBox child') cell
        child' = boxHeight (layoutGetBox $ LayoutGrid val self' []) child
    self' = Grid {
        containerSize = Size (inline $ containerSize self) size',
        containerMin = mapSizeY (lowerLength width) $ containerMin self,
        containerMax = mapSizeY (lowerLength width) $ containerMax self,
        gap = mapSizeY (lowerLength width) $ gap self,

        rows = map lowerSize $ rows self, rowBounds = rowBounds self,
        columns = columns self, colBounds = colBounds self,
        subgridRows = subgridRows self, subgridColumns = subgridColumns self
      }
    (size', heights) = gridHeights parent self $ rowBounds self
    lowerSize (Left x) = Left $ lowerLength width x
    lowerSize (Right x) = Right x
    width = inline $ size parent
boxHeight parent (LayoutInline val font self' paging vals) =
    LayoutInline val font self' paging vals
boxHeight _ (LayoutInline' val font self' paging vals) =
    LayoutInline' val font self' paging vals
boxHeight _ (LayoutSpan val font self') = LayoutSpan val font self'

boxSplit :: PropertyParser x => Double -> Double -> LayoutItem Double Double x ->
    (LayoutItem Double Double x, Maybe (LayoutItem Double Double x))
boxSplit maxheight _ node | height (layoutGetBox node) <= maxheight = (node, Nothing)
boxSplit maxheight pageheight (LayoutFlow val self childs)
    | (next:_) <- childs1, ((y,_):_) <- childs0',
        (tail,Just nextpage) <- boxSplit (maxheight - y) pageheight next =
            (LayoutFlow val self {
                size = (size self) { B.block = y }
            } (childs0 ++ [tail]),
             Just $ LayoutFlow val self {
                size = (size self) { B.block = B.block (size self) - y }
             } (nextpage:childs1))
    | otherwise =
        (LayoutFlow val self { size = (size self) { B.block = maxheight } } childs0,
         Just $ LayoutFlow val self childs1) -- TODO recompute height
  where
    childs0 = map snd childs0'
    childs1 = map snd childs1'
    (childs0', childs1') = break overflowed $ inner 0 childs
    overflowed (y, _) = y >= maxheight
    inner start (child:childs) = (start', child):inner start' childs -- TODO margin collapse?
        where start' = start + height (layoutGetBox child)
    inner _ [] = []
boxSplit _ _ self@(LayoutGrid _ _ _) = (self, Nothing) -- TODO
boxSplit maxheight pageheight (LayoutInline a b self c d) =
    boxSplit maxheight pageheight $ LayoutInline' a b (layoutPlain self) c d
boxSplit maxheight pageheight (LayoutInline' a b self paging c) =
    case paginate paging {
            pageCurrentHeight = toEnum $ fromEnum maxheight,
            pageNextHeight = toEnum $ fromEnum pageheight
      } self of
        (Continue, self', next) -> (wrap self', wrap <$> next)
        (Break, _, _) -> (nullLayout, Just $ wrap self)
  where
    wrap self' = LayoutInline' a b self' paging c
boxSplit _ _ self@(LayoutSpan _ _ _) = (self, Nothing) -- Can't split!
boxPaginate maxheight pageheight node
    | (page, Just overflow) <- boxSplit maxheight pageheight node =
        page:boxPaginate maxheight pageheight overflow
    | otherwise = [node]

boxPosition :: PropertyParser x => (Double, Double) -> LayoutItem Double Double x ->
    LayoutItem Double Double ((Double, Double), x)
boxPosition pos@(x, y) (LayoutFlow val self childs) = LayoutFlow (pos, val) self childs'
  where
    childs' = map recurse $ zip pos' childs
    recurse ((Size x' y'), child) = boxPosition (x + x', y + y') child
    pos' = positionFlow $ map layoutGetBox childs
boxPosition pos@(x, y) (LayoutGrid val self childs) = LayoutGrid (pos, val) self childs'
  where
    childs' = map recurse $ zip pos' childs
    recurse ((Size x' y'), (cell, child)) = (cell, boxPosition (x + x', y + y') child)
    pos' = gridPosition self $ map fst childs
boxPosition pos@(x, y) (LayoutInline val font self paging vals) =
    LayoutInline (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
            inlineChildren vals self
boxPosition pos@(x, y) (LayoutInline' val font self paging vals) =
    LayoutInline' (pos, val) font self paging $ map (\(x, y) -> (fragmentPos font pos y, x)) $
            layoutChildren vals self
boxPosition pos (LayoutSpan val f self) = LayoutSpan (pos, val) f self -- No children...
boxLayout :: PropertyParser x => PaddedBox Double Double -> LayoutItem Length Length x ->
        Bool -> LayoutItem Double Double ((Double, Double), x)
boxLayout parent self paginate = self8
  where
    self0 = boxMinWidth Nothing self
    self1 = boxNatWidth Nothing self0
    self2 = boxMaxWidth parent self1
    self3 = boxWidth parent self2
    self4 = boxNatHeight (inline $ size parent) self3
    self5 = boxMinHeight (inline $ size parent) self4
    self6 = boxMaxHeight parent self5
    self7 = boxHeight parent self6
    self8 = boxPosition (0, 0) self7

-- Useful for assembling glyph atlases.
glyphsPerFont :: LayoutItem x y z -> M.Map (Pattern, Double) IS.IntSet
glyphsPerFont (LayoutSpan _ font self) =
    (pattern font, fontSize font) `M.singleton` IS.fromList glyphs
  where glyphs = map fromEnum $ map Hb.codepoint $ map fst $ fragmentGlyphs self
glyphsPerFont node = M.unionsWith IS.union $ map glyphsPerFont $ layoutGetChilds node