{-# LANGUAGE TupleSections #-}
module Graphics.Layout.Inline where

import Data.Text.ParagraphLayout (Paragraph(..), ParagraphOptions(..),
                                    SpanLayout(..), Fragment(..),
                                    ParagraphLayout(..), layoutPlain, Span(..))
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.Internal (Font', hbScale)

hbScale' font = (/hbScale font) . fromIntegral
c font = fromDouble . hbScale' font

inlineMinWidth :: Font' -> Paragraph -> Double
inlineMinWidth font self = hbScale' font $ width $ layoutPlain' self 0
inlineNatWidth :: Font' -> Paragraph -> Double
inlineNatWidth font self = hbScale' font $ width $ layoutPlain' self maxBound
inlineHeight :: Font' -> Double -> Paragraph -> Double
inlineHeight font width self =
    hbScale' font $ height $ layoutPlain' self $ round (hbScale font * width)

inlineSize :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y
inlineSize _ self | Txt.all isSpace txt || Txt.null txt = Size (fromDouble 0) (fromDouble 0)
  where txt = paragraph2text self
inlineSize font self = Size (c font $ width r) (c font $ height r)
  where r = paragraphRect $ layoutPlain self
inlineChildren :: [x] -> Paragraph -> [(x, Fragment)]
inlineChildren _ self | Txt.all isSpace txt || Txt.null txt = []
  where txt = paragraph2text self
inlineChildren vals self = concat $ map inner $ zip vals $ spanLayouts $ layoutPlain self
  where inner (x, SpanLayout y) = map (x,) y

layoutPlain' :: Paragraph -> Int32 -> Rect Int32
layoutPlain' paragraph _ | Txt.all isSpace txt || Txt.null txt = Rect 0 0 0 0
  where txt = paragraph2text paragraph
layoutPlain' (Paragraph a b c d) width =
    paragraphRect $ layoutPlain $ Paragraph a b c d { paragraphMaxWidth = width }

fragmentSize :: (CastDouble x, CastDouble y) => Font' -> Fragment -> Size x y
fragmentSize font self = Size (c font $ width r) (c font $ height r)
    where r = fragmentRect self
fragmentSize' :: CastDouble x => Font' -> Fragment -> Size x x
fragmentSize' = fragmentSize -- Work around for typesystem.
fragmentPos :: Font' -> (Double, Double) -> Fragment -> (Double, Double)
fragmentPos font (x, y) self =
        (x + hbScale' font (x_min r), y + hbScale' font (y_min r))
    where r = fragmentRect self

paragraph2text (Paragraph array off spans _) = Text array off $ sum $ map spanLength spans