~alcinnz/CatTrap

ref: b07f5dcbcf23cb75b2db2022f807d3847505a0bf CatTrap/Graphics/Layout/Inline.hs -rw-r--r-- 3.8 KiB
b07f5dcb — Adrian Cochrane Refactor to use newer Balkón APIs. 1 year, 3 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
73
74
75
76
77
78
79
80
81
{-# 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) where

import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                Fragment(..), ParagraphLayout(..), 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 :: Paragraph a -> [Fragment 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 :: ParagraphLayout a -> [Fragment a]
layoutChildren self = paragraphFragments self -- TODO: Extract tree...

-- | 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) => Fragment a -> Size x y
fragmentSize 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 => Fragment 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]
  }