{-# 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, fragmentSize, fragmentSize', fragmentPos) 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.Font (Font', hbScale) -- | Convert from Harfbuzz units to device pixels as a Double hbScale' font = (/hbScale font) . fromIntegral -- | Convert from Harfbuzz units to device pixels as a Double or Length. c font = fromDouble . hbScale' font -- | Compute minimum width for some richtext. inlineMinWidth :: Font' -> Paragraph -> Double inlineMinWidth font self = hbScale' font $ width $ layoutPlain' self 0 -- | Compute minimum width & height for some richtext. inlineMin :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y inlineMin font self = Size (c font $ width rect) (c font $ height rect) where rect = layoutPlain' self 0 -- | Compute natural (single-line) width for some richtext. inlineNatWidth :: Font' -> Paragraph -> Double inlineNatWidth font self = hbScale' font $ width $ layoutPlain' self maxBound -- | Compute height for rich text at given width. inlineHeight :: Font' -> Double -> Paragraph -> Double inlineHeight font width self = hbScale' font $ height $ layoutPlain' self $ round (hbScale font * width) -- | Compute width & height of some richtext at configured width. inlineSize :: (CastDouble x, CastDouble y) => Font' -> Paragraph -> Size x y inlineSize font self = layoutSize font $ layoutPlain self -- | Retrieve children out of some richtext, -- associating given userdata with them. inlineChildren :: [x] -> Paragraph -> [(x, Fragment)] inlineChildren vals self = layoutChildren vals $ layoutPlain self -- | Retrieve a laid-out paragraph's rect & convert to CatTrap types. layoutSize :: (CastDouble x, CastDouble y) => Font' -> ParagraphLayout -> Size x y layoutSize font self = Size (c font $ width r) (c font $ height r) where r = paragraphRect self -- | Retrieve a laid-out paragraph's children & associate with given userdata. layoutChildren :: [x] -> ParagraphLayout -> [(x, Fragment)] layoutChildren vals self = zip vals $ concat $ map inner $ spanLayouts self where inner (SpanLayout y) = y -- | Layout a paragraph at given width & retrieve resulting rect. layoutPlain' :: Paragraph -> Int32 -> Rect Int32 layoutPlain' (Paragraph a b c d) width = paragraphRect $ layoutPlain $ Paragraph a b c d { paragraphMaxWidth = width } -- | Retrieve the rect for a fragment & convert to CatTrap types. 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 -- | Variant of `fragmentSize` asserting to the typesystem that both fields -- of the resulting `Size` are of the same type. fragmentSize' :: CastDouble x => Font' -> Fragment -> Size x x fragmentSize' = fragmentSize -- Work around for typesystem. -- | Retrieve the position of a fragment. 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