~alcinnz/CatTrap

ref: d549219c1de66809be3801517e80971b977fa42b CatTrap/Graphics/Layout/Inline.hs -rw-r--r-- 3.6 KiB
d549219c — Adrian Cochrane Reference-document generic layout/tree-traversal, seperate natural from final size fields. 1 year, 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
{-# LANGUAGE TupleSections #-}
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