{-# LANGUAGE TupleSections #-}
-- | Sizes inline text & extracts positioned children,
-- wraps Balkón for the actual logic.
module Graphics.Layout.Inline(inlineMinWidth, inlineMin, inlineNatWidth, inlineHeight,
    inlineSize, inlineChildren, layoutSize, layoutChildren, positionChildren,
    fragmentSize, fragmentSize', fragmentPos, FragmentTree(..),
    positionSubtree, subtreeInner) where

import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                Fragment(..), ParagraphLayout(..), AncestorBox(..),
                                layoutRich)
import Data.Text.ParagraphLayout.Rect (Rect(..), width, height, x_min, y_min)
import Data.Text.Internal (Text(..))
import qualified Data.Text as Txt
import Data.Char (isSpace)
import Data.Int (Int32)

import Graphics.Layout.Box (Size(..), CastDouble(..), fromDouble)
import Graphics.Layout.CSS.Font (Font', hbUnit)

-- | Convert from Harfbuzz units to device pixels as a Double
hbScale = (/hbUnit) . fromIntegral
-- | Convert from Harfbuzz units to device pixels as a Double or Length.
c :: CastDouble a => Int32 -> a
c = fromDouble . hbScale

-- | Compute minimum width for some richtext.
inlineMinWidth :: Paragraph a -> Double
inlineMinWidth self = hbScale $ width $ layoutRich' self 0
-- | Compute minimum width & height for some richtext.
inlineMin :: (CastDouble x, CastDouble y) => Paragraph a -> Size x y
inlineMin self = Size (c $ width rect) (c $ height rect)
    where rect = layoutRich' self 0
-- | Compute natural (single-line) width for some richtext.
inlineNatWidth :: Paragraph a -> Double
inlineNatWidth self = hbScale $ width $ layoutRich' self maxBound
-- | Compute height for rich text at given width.
inlineHeight :: Double -> Paragraph a -> Double
inlineHeight width self =
    hbScale $ height $ layoutRich' self $ round (hbUnit * width)

-- | Compute width & height of some richtext at configured width.
inlineSize :: (CastDouble x, CastDouble y) => Paragraph a -> Size x y
inlineSize self = layoutSize $ layoutRich self
-- | Retrieve children out of some richtext,
-- associating given userdata with them.
inlineChildren :: Eq a => Paragraph a -> [FragmentTree a]
inlineChildren self = layoutChildren $ layoutRich self

-- | Retrieve a laid-out paragraph's rect & convert to CatTrap types.
layoutSize :: (CastDouble x, CastDouble y) => ParagraphLayout a -> Size x y
layoutSize self = Size (c $ width r) (c $ height r)
  where r = paragraphRect self
-- | Retrieve a laid-out paragraph's children & associate with given userdata.
layoutChildren :: Eq a => ParagraphLayout a -> [FragmentTree a]
layoutChildren self = reconstructTree self

-- | Layout a paragraph at given width & retrieve resulting rect.
layoutRich' :: Paragraph a -> Int32 -> Rect Int32
layoutRich' (Paragraph a b c d) width =
    paragraphRect $ layoutRich $ Paragraph a b c d { paragraphMaxWidth = width }

-- | Retrieve the rect for a fragment & convert to CatTrap types.
fragmentSize :: (CastDouble x, CastDouble y) => FragmentTree a -> Size x y
fragmentSize (Branch _ _) = Size (c 0) (c 0) -- FIXME
fragmentSize (Leaf self) = Size (c $ width r) (c $ height r)
    where r = fragmentRect self
-- | Variant of `fragmentSize` asserting to the typesystem that both fields
-- of the resulting `Size` are of the same type.
fragmentSize' :: CastDouble x => FragmentTree a -> Size x x
fragmentSize' = fragmentSize -- Work around for typesystem.
-- | Retrieve the position of a fragment.
fragmentPos :: (Double, Double) -> Fragment a -> (Double, Double)
fragmentPos (x, y) self =
        (x + hbScale (x_min r), y + hbScale (y_min r))
    where r = fragmentRect self

-- | Alter userdata to hold positions.
positionChildren :: (Double, Double) -> ParagraphLayout (a, b, c) ->
                    ParagraphLayout (a, b, ((Double, Double), c))
positionChildren pos self = self {
    paragraphFragments = [Fragment (a, b, (fragmentPos pos frag, c)) d [] f g h
            | frag@(Fragment (a, b, c) d _ f g h) <- paragraphFragments self]
  }

data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]
    | Leaf (Fragment x)

reconstructTree :: Eq x => ParagraphLayout x -> [FragmentTree x]
reconstructTree ParagraphLayout { paragraphFragments = frags } =
    reconstructTree' [frag {
            fragmentAncestorBoxes = reverse $ fragmentAncestorBoxes frag
        } | frag <- frags]
reconstructTree' :: Eq x => [Fragment x] -> [FragmentTree x]
reconstructTree' (self@Fragment { fragmentAncestorBoxes = [] }:frags) =
    Leaf self:reconstructTree' frags
reconstructTree' frags@(Fragment { fragmentAncestorBoxes = branch:_ }:_) =
    Branch branch (reconstructTree' [ child { fragmentAncestorBoxes = ancestors }
            | child@Fragment { fragmentAncestorBoxes = _:ancestors } <- childs])
        :reconstructTree' sibs
  where
    (childs, sibs) = span sameBranch frags
    sameBranch Fragment { fragmentAncestorBoxes = branch':_ } = branch == branch'
    sameBranch Fragment { fragmentAncestorBoxes = [] } = False
reconstructTree' [] = []

positionSubtree :: (Double, Double) -> FragmentTree (a, b, c) ->
        FragmentTree (a, b, ((Double, Double), c))
positionSubtree pos (Branch (AncestorBox (a, b, c) d e f g) childs) =
    Branch (AncestorBox (a, b, (pos, c)) d e f g) $
        map (positionSubtree pos) childs
positionSubtree pos (Leaf (Fragment (a, b, c) d _ f g h)) =
    Leaf (Fragment (a, b, (pos, c)) d [] f g h)
subtreeInner :: FragmentTree (a, b, c) -> c
subtreeInner (Branch AncestorBox { boxUserData = (_, _, ret) } _) = ret
subtreeInner (Leaf Fragment { fragmentUserData = (_, _, ret) }) = ret