{-|
Module      : Monomer.Graphics.Text
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Helper functions for calculating text size.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Strict #-}

module Monomer.Graphics.Text (
  calcTextSize,
  calcTextSize_,
  fitTextToSize,
  fitTextToWidth,
  alignTextLines,
  moveTextLines,
  getTextLinesSize,
  getGlyphsMin,
  getGlyphsMax
) where

import Control.Lens ((&), (^.), (^?), (+~), ix, non)
import Data.Default
import Data.List (foldl')
import Data.Maybe
import Data.Sequence (Seq(..), (<|))
import Data.Text (Text)

import qualified Data.Sequence as Seq
import qualified Data.Text as T

import Monomer.Common
import Monomer.Core.StyleTypes
import Monomer.Core.StyleUtil
import Monomer.Graphics.Types
import Monomer.Helper

import qualified Monomer.Common.Lens as L
import qualified Monomer.Graphics.Lens as L

type GlyphGroup = Seq GlyphPos

-- | Returns the size a given text an style will take.
calcTextSize
  :: FontManager   -- ^ The font manager.
  -> StyleState    -- ^ The style.
  -> Text          -- ^ The text to calculate.
  -> Size          -- ^ The calculated size.
calcTextSize :: FontManager -> StyleState -> Text -> Size
calcTextSize FontManager
fontMgr StyleState
style !Text
text = Size
size where
  size :: Size
size = FontManager
-> StyleState
-> TextMode
-> TextTrim
-> Maybe Double
-> Maybe Int
-> Text
-> Size
calcTextSize_ FontManager
fontMgr StyleState
style TextMode
SingleLine TextTrim
KeepSpaces Maybe Double
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Text
text

-- | Returns the size a given text an style will take.
calcTextSize_
  :: FontManager   -- ^ The font manager.
  -> StyleState    -- ^ The style.
  -> TextMode      -- ^ Single or multiline.
  -> TextTrim      -- ^ Whether to trim or keep spaces.
  -> Maybe Double  -- ^ Optional max width (needed for multiline).
  -> Maybe Int     -- ^ Optional max lines.
  -> Text          -- ^ The text to calculate.
  -> Size          -- ^ The calculated size.
calcTextSize_ :: FontManager
-> StyleState
-> TextMode
-> TextTrim
-> Maybe Double
-> Maybe Int
-> Text
-> Size
calcTextSize_ FontManager
fontMgr StyleState
style TextMode
mode TextTrim
trim Maybe Double
mwidth Maybe Int
mlines Text
text = Size
newSize where
  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fontSize :: FontSize
fontSize = StyleState -> FontSize
styleFontSize StyleState
style
  !metrics :: TextMetrics
metrics = FontManager -> Font -> FontSize -> TextMetrics
computeTextMetrics FontManager
fontMgr Font
font FontSize
fontSize
  width :: Double
width = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
forall a. RealFloat a => a
maxNumericValue Maybe Double
mwidth

  textLinesW :: Seq TextLine
textLinesW = FontManager
-> StyleState -> Double -> TextTrim -> Text -> Seq TextLine
fitTextToWidth FontManager
fontMgr StyleState
style Double
width TextTrim
trim Text
text
  textLines :: Seq TextLine
textLines
    | TextMode
mode TextMode -> TextMode -> Bool
forall a. Eq a => a -> a -> Bool
== TextMode
SingleLine = Int -> Seq TextLine -> Seq TextLine
forall a. Int -> Seq a -> Seq a
Seq.take Int
1 Seq TextLine
textLinesW
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mlines = Int -> Seq TextLine -> Seq TextLine
forall a. Int -> Seq a -> Seq a
Seq.take (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
mlines) Seq TextLine
textLinesW
    | Bool
otherwise = Seq TextLine
textLinesW

  newSize :: Size
newSize
    | Bool -> Bool
not (Seq TextLine -> Bool
forall a. Seq a -> Bool
Seq.null Seq TextLine
textLines) = Seq TextLine -> Size
getTextLinesSize Seq TextLine
textLines
    | Bool
otherwise = Double -> Double -> Size
Size Double
0 (TextMetrics -> Double
_txmLineH TextMetrics
metrics)

{-|
Fits the given text to a determined size, splitting on multiple lines as needed.
Since the function returns glyphs that may be partially visible, the text can
overflow vertically or horizontally and a scissor is needed. The rectangles are
returned with zero offset (i.e., x = 0 and first line y = 0), and a translation
transform is needed when rendering.
-}
fitTextToSize
  :: FontManager   -- ^ The font manager.
  -> StyleState    -- ^ The style.
  -> TextOverflow  -- ^ Whether to clip or use ellipsis.
  -> TextMode      -- ^ Single or multiline.
  -> TextTrim      -- ^ Whether to trim or keep spaces.
  -> Maybe Int     -- ^ Optional max lines.
  -> Size          -- ^ The bounding size.
  -> Text          -- ^ The text to fit.
  -> Seq TextLine  -- ^ The fitted text lines.
fitTextToSize :: FontManager
-> StyleState
-> TextOverflow
-> TextMode
-> TextTrim
-> Maybe Int
-> Size
-> Text
-> Seq TextLine
fitTextToSize FontManager
fontMgr StyleState
style TextOverflow
ovf TextMode
mode TextTrim
trim Maybe Int
mlines !Size
size !Text
text = Seq TextLine
newLines where
  Size Double
cw Double
ch = Size
size
  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fontSize :: FontSize
fontSize = StyleState -> FontSize
styleFontSize StyleState
style
  textMetrics :: TextMetrics
textMetrics = FontManager -> Font -> FontSize -> TextMetrics
computeTextMetrics FontManager
fontMgr Font
font FontSize
fontSize

  fitW :: Double
fitW
    | TextMode
mode TextMode -> TextMode -> Bool
forall a. Eq a => a -> a -> Bool
== TextMode
MultiLine = Double
cw
    | Bool
otherwise = Double
forall a. RealFloat a => a
maxNumericValue
  maxH :: Double
maxH = case Maybe Int
mlines of
    Just Int
maxLines -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
ch (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxLines Double -> Double -> Double
forall a. Num a => a -> a -> a
* TextMetrics
textMetrics TextMetrics -> Getting Double TextMetrics Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double TextMetrics Double
forall s a. HasLineH s a => Lens' s a
Lens' TextMetrics Double
L.lineH)
    Maybe Int
_ -> Double
ch

  textLinesW :: Seq TextLine
textLinesW = FontManager
-> StyleState -> Double -> TextTrim -> Text -> Seq TextLine
fitTextToWidth FontManager
fontMgr StyleState
style Double
fitW TextTrim
trim Text
text
  firstLine :: Seq TextLine
firstLine = Int -> Seq TextLine -> Seq TextLine
forall a. Int -> Seq a -> Seq a
Seq.take Int
1 Seq TextLine
textLinesW
  isMultiline :: Bool
isMultiline = TextMode
mode TextMode -> TextMode -> Bool
forall a. Eq a => a -> a -> Bool
== TextMode
MultiLine
  ellipsisReq :: Bool
ellipsisReq = TextOverflow
ovf TextOverflow -> TextOverflow -> Bool
forall a. Eq a => a -> a -> Bool
== TextOverflow
Ellipsis Bool -> Bool -> Bool
&& Seq TextLine -> Size
getTextLinesSize Seq TextLine
firstLine Size -> Getting Double Size Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Size Double
forall s a. HasW s a => Lens' s a
Lens' Size Double
L.w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
cw

  newLines :: Seq TextLine
newLines
    | Bool
isMultiline = FontManager
-> StyleState
-> TextOverflow
-> Double
-> Double
-> Seq TextLine
-> Seq TextLine
fitLinesToH FontManager
fontMgr StyleState
style TextOverflow
ovf Double
cw Double
maxH Seq TextLine
textLinesW
    | Bool
ellipsisReq = FontManager -> StyleState -> Double -> TextLine -> TextLine
addEllipsisToTextLine FontManager
fontMgr StyleState
style Double
cw (TextLine -> TextLine) -> Seq TextLine -> Seq TextLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
firstLine
    | Bool
otherwise = FontManager
-> StyleState -> TextTrim -> Double -> TextLine -> TextLine
clipTextLine FontManager
fontMgr StyleState
style TextTrim
trim Double
cw (TextLine -> TextLine) -> Seq TextLine -> Seq TextLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq TextLine
firstLine

-- | Fits a single line of text to the given width, potentially splitting into
--   several lines.
fitTextToWidth
  :: FontManager   -- ^ The fontManager.
  -> StyleState    -- ^ The style.
  -> Double        -- ^ The maximum width.
  -> TextTrim      -- ^ Whether to trim or keep spaces.
  -> Text          -- ^ The text to calculate.
  -> Seq TextLine  -- ^ The fitted text lines.
fitTextToWidth :: FontManager
-> StyleState -> Double -> TextTrim -> Text -> Seq TextLine
fitTextToWidth FontManager
fontMgr StyleState
style Double
width TextTrim
trim Text
text = Seq TextLine
resultLines where
  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fSize :: FontSize
fSize = StyleState -> FontSize
styleFontSize StyleState
style
  fSpcH :: FontSpace
fSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style
  fSpcV :: FontSpace
fSpcV = StyleState -> FontSpace
styleFontSpaceV StyleState
style
  break :: LineBreak
break = StyleState -> LineBreak
styleTextLineBreak StyleState
style
  lineH :: Double
lineH = TextMetrics -> Double
_txmLineH TextMetrics
metrics

  !metrics :: TextMetrics
metrics = FontManager -> Font -> FontSize -> TextMetrics
computeTextMetrics FontManager
fontMgr Font
font FontSize
fSize
  fitToWidth :: Double -> Double -> TextTrim -> Text -> Seq TextLine
fitToWidth = FontManager
-> Font
-> FontSize
-> FontSpace
-> FontSpace
-> TextMetrics
-> LineBreak
-> Double
-> Double
-> TextTrim
-> Text
-> Seq TextLine
fitLineToW FontManager
fontMgr Font
font FontSize
fSize FontSpace
fSpcH FontSpace
fSpcV TextMetrics
metrics LineBreak
break

  helper :: (Seq TextLine, Double) -> Text -> (Seq TextLine, Double)
helper (Seq TextLine, Double)
acc Text
line = (Seq TextLine
cLines Seq TextLine -> Seq TextLine -> Seq TextLine
forall a. Semigroup a => a -> a -> a
<> Seq TextLine
newLines, Double
newTop) where
    (Seq TextLine
cLines, Double
cTop) = (Seq TextLine, Double)
acc
    newLines :: Seq TextLine
newLines = Double -> Double -> TextTrim -> Text -> Seq TextLine
fitToWidth Double
cTop Double
width TextTrim
trim Text
line
    vspc :: Double
vspc = FontSpace -> Double
unFontSpace FontSpace
fSpcV
    newTop :: Double
newTop = Double
cTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq TextLine -> Int
forall a. Seq a -> Int
Seq.length Seq TextLine
newLines) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
lineH Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vspc)

  (Seq TextLine
resultLines, Double
_) = ((Seq TextLine, Double) -> Text -> (Seq TextLine, Double))
-> (Seq TextLine, Double) -> [Text] -> (Seq TextLine, Double)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq TextLine, Double) -> Text -> (Seq TextLine, Double)
helper (Seq TextLine
forall a. Seq a
Empty, Double
0) (Text -> [Text]
T.lines Text
text)

-- | Aligns a Seq of TextLines to the given rect.
alignTextLines
  :: StyleState    -- ^ The style.
  -> Rect          -- ^ The bounding rect. Text may overflow.
  -> Seq TextLine  -- ^ The TextLines to align.
  -> Seq TextLine  -- ^ The aligned TextLines.
alignTextLines :: StyleState -> Rect -> Seq TextLine -> Seq TextLine
alignTextLines StyleState
style Rect
parentRect Seq TextLine
textLines = Seq TextLine
newTextLines where
  Rect Double
_ Double
py Double
_ Double
ph = Rect
parentRect
  Size Double
_ Double
th = Seq TextLine -> Size
getTextLinesSize Seq TextLine
textLines
  TextMetrics Double
asc Double
_ Double
lineH Double
lowerX = (Seq TextLine
textLines Seq TextLine
-> Getting (First TextLine) (Seq TextLine) TextLine
-> Maybe TextLine
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Seq TextLine)
-> Traversal' (Seq TextLine) (IxValue (Seq TextLine))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq TextLine)
0) Maybe TextLine
-> Getting TextMetrics (Maybe TextLine) TextMetrics -> TextMetrics
forall s a. s -> Getting a s a -> a
^. TextLine -> Iso' (Maybe TextLine) TextLine
forall a. Eq a => a -> Iso' (Maybe a) a
non TextLine
forall a. Default a => a
def ((TextLine -> Const TextMetrics TextLine)
 -> Maybe TextLine -> Const TextMetrics (Maybe TextLine))
-> ((TextMetrics -> Const TextMetrics TextMetrics)
    -> TextLine -> Const TextMetrics TextLine)
-> Getting TextMetrics (Maybe TextLine) TextMetrics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextMetrics -> Const TextMetrics TextMetrics)
-> TextLine -> Const TextMetrics TextLine
forall s a. HasMetrics s a => Lens' s a
Lens' TextLine TextMetrics
L.metrics

  isSingle :: Bool
isSingle = Seq TextLine -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq TextLine
textLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  alignH :: AlignTH
alignH = StyleState -> AlignTH
styleTextAlignH StyleState
style
  alignV :: AlignTV
alignV = StyleState -> AlignTV
styleTextAlignV StyleState
style

  alignOffsetY :: Double
alignOffsetY = case AlignTV
alignV of
    AlignTV
ATTop -> Double
0
    AlignTV
ATAscender
      | Bool
isSingle -> (Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
asc) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    AlignTV
ATLowerX
      | Bool
isSingle -> (Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lowerX) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
asc Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lowerX)
    AlignTV
ATBottom -> Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
th
    AlignTV
ATBaseline -> Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
th
    AlignTV
_ -> (Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
th) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 -- ATMiddle

  offsetY :: Double
offsetY = Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
alignOffsetY
  newTextLines :: Seq TextLine
newTextLines = (TextLine -> TextLine) -> Seq TextLine -> Seq TextLine
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect -> Double -> AlignTH -> TextLine -> TextLine
alignTextLine Rect
parentRect Double
offsetY AlignTH
alignH) Seq TextLine
textLines

-- | Moves a Seq of TextLines by the given offset.
moveTextLines
  :: Point         -- ^ The offset.
  -> Seq TextLine  -- ^ The TextLines.
  -> Seq TextLine  -- ^ The displaced TextLines.
moveTextLines :: Point -> Seq TextLine -> Seq TextLine
moveTextLines (Point Double
offsetX Double
offsetY) Seq TextLine
textLines = Seq TextLine
newTextLines where
  moveTextLine :: b -> b
moveTextLine b
tl = b
tl
    b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasRect s a => Lens' s a
Lens' b a
L.rect ((a -> Identity a) -> b -> Identity b)
-> ((Double -> Identity Double) -> a -> Identity a)
-> (Double -> Identity Double)
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> a -> Identity a
forall s a. HasX s a => Lens' s a
Lens' a Double
L.x ((Double -> Identity Double) -> b -> Identity b)
-> Double -> b -> b
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Double
offsetX
    b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
forall s a. HasRect s a => Lens' s a
Lens' b a
L.rect ((a -> Identity a) -> b -> Identity b)
-> ((Double -> Identity Double) -> a -> Identity a)
-> (Double -> Identity Double)
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> a -> Identity a
forall s a. HasY s a => Lens' s a
Lens' a Double
L.y ((Double -> Identity Double) -> b -> Identity b)
-> Double -> b -> b
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Double
offsetY
  newTextLines :: Seq TextLine
newTextLines = (TextLine -> TextLine) -> Seq TextLine -> Seq TextLine
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextLine -> TextLine
forall {a} {b}.
(HasX a Double, HasRect b a, HasY a Double) =>
b -> b
moveTextLine Seq TextLine
textLines

-- | Returns the combined size of a sequence of text lines.
getTextLinesSize :: Seq TextLine -> Size
getTextLinesSize :: Seq TextLine -> Size
getTextLinesSize Seq TextLine
textLines = Size
size where
  -- Excludes last line vertical spacing
  spaceV :: Double
spaceV = FontSpace -> Double
unFontSpace (FontSpace -> Double) -> FontSpace -> Double
forall a b. (a -> b) -> a -> b
$ FontSpace -> (TextLine -> FontSpace) -> Maybe TextLine -> FontSpace
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FontSpace
forall a. Default a => a
def TextLine -> FontSpace
_tlFontSpaceV (Seq TextLine
textLines Seq TextLine
-> Getting (First TextLine) (Seq TextLine) TextLine
-> Maybe TextLine
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index (Seq TextLine)
-> Traversal' (Seq TextLine) (IxValue (Seq TextLine))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq TextLine)
0)
  lineW :: s -> a
lineW s
line = s
line s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. (a -> Const a a) -> s -> Const a s
forall s a. HasSize s a => Lens' s a
Lens' s a
L.size ((a -> Const a a) -> s -> Const a s)
-> ((a -> Const a a) -> a -> Const a a) -> Getting a s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> a -> Const a a
forall s a. HasW s a => Lens' s a
Lens' a a
L.w
  lineH :: TextLine -> Double
lineH TextLine
line = TextLine
line TextLine -> Getting Double TextLine Double -> Double
forall s a. s -> Getting a s a -> a
^. (Size -> Const Double Size) -> TextLine -> Const Double TextLine
forall s a. HasSize s a => Lens' s a
Lens' TextLine Size
L.size ((Size -> Const Double Size) -> TextLine -> Const Double TextLine)
-> Getting Double Size Double -> Getting Double TextLine Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Double Size Double
forall s a. HasH s a => Lens' s a
Lens' Size Double
L.h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FontSpace -> Double
unFontSpace (TextLine -> FontSpace
_tlFontSpaceV TextLine
line)
  ~Double
width = Seq Double -> Double
forall a. Ord a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((TextLine -> Double) -> Seq TextLine -> Seq Double
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextLine -> Double
forall {s} {a} {a}. (HasSize s a, HasW a a) => s -> a
lineW Seq TextLine
textLines)
  height :: Double
height = Seq Double -> Double
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TextLine -> Double) -> Seq TextLine -> Seq Double
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextLine -> Double
lineH Seq TextLine
textLines) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
spaceV
  size :: Size
size
    | Seq TextLine -> Bool
forall a. Seq a -> Bool
Seq.null Seq TextLine
textLines = Size
forall a. Default a => a
def
    | Bool
otherwise = Double -> Double -> Size
Size Double
width Double
height

-- | Gets the minimum x a Seq of Glyphs will use.
getGlyphsMin :: Seq GlyphPos -> Double
getGlyphsMin :: Seq GlyphPos -> Double
getGlyphsMin Seq GlyphPos
Empty = Double
0
getGlyphsMin (GlyphPos
g :<| Seq GlyphPos
gs) = GlyphPos -> Double
_glpXMin GlyphPos
g

-- | Gets the maximum x a Seq of Glyphs will use.
getGlyphsMax :: Seq GlyphPos -> Double
getGlyphsMax :: Seq GlyphPos -> Double
getGlyphsMax Seq GlyphPos
Empty = Double
0
getGlyphsMax (Seq GlyphPos
gs :|> GlyphPos
g) = GlyphPos -> Double
_glpXMax GlyphPos
g

-- Helpers
alignTextLine :: Rect -> Double -> AlignTH -> TextLine -> TextLine
alignTextLine :: Rect -> Double -> AlignTH -> TextLine -> TextLine
alignTextLine Rect
parentRect Double
offsetY AlignTH
alignH TextLine
textLine = TextLine
newTextLine where
  Rect Double
px Double
_ Double
pw Double
_ = Rect
parentRect
  Rect Double
tx Double
ty Double
tw Double
th = TextLine -> Rect
_tlRect TextLine
textLine

  alignOffsetX :: Double
alignOffsetX = case AlignTH
alignH of
    AlignTH
ATLeft -> Double
0
    AlignTH
ATCenter -> (Double
pw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    AlignTH
ATRight -> Double
pw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw

  offsetX :: Double
offsetX = Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
alignOffsetX
  newTextLine :: TextLine
newTextLine = TextLine
textLine {
    _tlRect = Rect (tx + offsetX) (ty + offsetY) tw th
  }

fitLinesToH
  :: FontManager
  -> StyleState
  -> TextOverflow
  -> Double
  -> Double
  -> Seq TextLine
  -> Seq TextLine
fitLinesToH :: FontManager
-> StyleState
-> TextOverflow
-> Double
-> Double
-> Seq TextLine
-> Seq TextLine
fitLinesToH FontManager
fontMgr StyleState
style TextOverflow
overflow Double
w Double
h Seq TextLine
Empty = Seq TextLine
forall a. Seq a
Empty
fitLinesToH FontManager
fontMgr StyleState
style TextOverflow
overflow Double
w Double
h (TextLine
g1 :<| TextLine
g2 :<| Seq TextLine
gs)
  | TextOverflow
overflow TextOverflow -> TextOverflow -> Bool
forall a. Eq a => a -> a -> Bool
== TextOverflow
Ellipsis Bool -> Bool -> Bool
&& Double
h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
g1H Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g2H = TextLine
g1 TextLine -> Seq TextLine -> Seq TextLine
forall a. a -> Seq a -> Seq a
:<| Seq TextLine
rest
  | TextOverflow
overflow TextOverflow -> TextOverflow -> Bool
forall a. Eq a => a -> a -> Bool
== TextOverflow
Ellipsis Bool -> Bool -> Bool
&& Double
h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
g1H = TextLine -> Seq TextLine
forall a. a -> Seq a
Seq.singleton TextLine
ellipsisG1
  | TextOverflow
overflow TextOverflow -> TextOverflow -> Bool
forall a. Eq a => a -> a -> Bool
== TextOverflow
ClipText Bool -> Bool -> Bool
&& Double
h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
g1H = TextLine
g1 TextLine -> Seq TextLine -> Seq TextLine
forall a. a -> Seq a -> Seq a
:<| Seq TextLine
rest
  where
    g1H :: Double
g1H = Size -> Double
_sH (TextLine -> Size
_tlSize TextLine
g1)
    g2H :: Double
g2H = Size -> Double
_sH (TextLine -> Size
_tlSize TextLine
g2)
    newH :: Double
newH = Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
g1H
    rest :: Seq TextLine
rest = FontManager
-> StyleState
-> TextOverflow
-> Double
-> Double
-> Seq TextLine
-> Seq TextLine
fitLinesToH FontManager
fontMgr StyleState
style TextOverflow
overflow Double
w Double
newH (TextLine
g2 TextLine -> Seq TextLine -> Seq TextLine
forall a. a -> Seq a -> Seq a
:<| Seq TextLine
gs)
    ellipsisG1 :: TextLine
ellipsisG1 = FontManager -> StyleState -> Double -> TextLine -> TextLine
addEllipsisToTextLine FontManager
fontMgr StyleState
style Double
w TextLine
g1
fitLinesToH FontManager
fontMgr StyleState
style TextOverflow
overflow Double
w Double
h (TextLine
g :<| Seq TextLine
gs)
  | Double
h Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = TextLine -> Seq TextLine
forall a. a -> Seq a
Seq.singleton TextLine
newG
  | Bool
otherwise = Seq TextLine
forall a. Seq a
Empty
  where
    gW :: Double
gW = Size -> Double
_sW (TextLine -> Size
_tlSize TextLine
g)
    newG :: TextLine
newG
      | TextOverflow
overflow TextOverflow -> TextOverflow -> Bool
forall a. Eq a => a -> a -> Bool
== TextOverflow
Ellipsis Bool -> Bool -> Bool
&& Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
gW = FontManager -> StyleState -> Double -> TextLine -> TextLine
addEllipsisToTextLine FontManager
fontMgr StyleState
style Double
w TextLine
g
      | Bool
otherwise = TextLine
g

fitLineToW
  :: FontManager
  -> Font
  -> FontSize
  -> FontSpace
  -> FontSpace
  -> TextMetrics
  -> LineBreak
  -> Double
  -> Double
  -> TextTrim
  -> Text
  -> Seq TextLine
fitLineToW :: FontManager
-> Font
-> FontSize
-> FontSpace
-> FontSpace
-> TextMetrics
-> LineBreak
-> Double
-> Double
-> TextTrim
-> Text
-> Seq TextLine
fitLineToW FontManager
fontMgr Font
font FontSize
fSize FontSpace
fSpcH FontSpace
fSpcV TextMetrics
metrics LineBreak
break Double
top Double
width TextTrim
trim Text
text = Seq TextLine
res where
  spaces :: Text
spaces = Int -> Text -> Text
T.replicate Int
4 Text
" "
  newText :: Text
newText = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\t" Text
spaces Text
text
  !glyphs :: Seq GlyphPos
glyphs = FontManager
-> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
computeGlyphsPos FontManager
fontMgr Font
font FontSize
fSize FontSpace
fSpcH Text
newText
  -- Do not break line on trailing spaces, they are removed in the next step
  -- In the case of KeepSpaces, lines with only spaces (empty looking) are valid
  keepTailSpaces :: Bool
keepTailSpaces = TextTrim
trim TextTrim -> TextTrim -> Bool
forall a. Eq a => a -> a -> Bool
== TextTrim
TrimSpaces
  groups :: Seq (Seq GlyphPos)
groups
    | LineBreak
break LineBreak -> LineBreak -> Bool
forall a. Eq a => a -> a -> Bool
== LineBreak
OnCharacters = LineBreak -> Double -> Seq GlyphPos -> Seq (Seq GlyphPos)
splitGroups LineBreak
break Double
width Seq GlyphPos
glyphs
    | Bool
otherwise = Seq (Seq GlyphPos) -> Double -> Bool -> Seq (Seq GlyphPos)
fitGroups (LineBreak -> Double -> Seq GlyphPos -> Seq (Seq GlyphPos)
splitGroups LineBreak
break Double
width Seq GlyphPos
glyphs) Double
width Bool
keepTailSpaces
  resetGroups :: Seq (Seq GlyphPos)
resetGroups
    | TextTrim
trim TextTrim -> TextTrim -> Bool
forall a. Eq a => a -> a -> Bool
== TextTrim
TrimSpaces = (Seq GlyphPos -> Seq GlyphPos)
-> Seq (Seq GlyphPos) -> Seq (Seq GlyphPos)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq GlyphPos -> Seq GlyphPos
trimGlyphs Seq (Seq GlyphPos)
groups
    | Bool
otherwise = Seq (Seq GlyphPos)
groups
  buildLine :: Int -> Seq GlyphPos -> TextLine
buildLine = Font
-> FontSize
-> FontSpace
-> FontSpace
-> TextMetrics
-> Double
-> Int
-> Seq GlyphPos
-> TextLine
buildTextLine Font
font FontSize
fSize FontSpace
fSpcH FontSpace
fSpcV TextMetrics
metrics Double
top
  res :: Seq TextLine
res
    | Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" = (Int -> Seq GlyphPos -> TextLine)
-> Seq (Seq GlyphPos) -> Seq TextLine
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex Int -> Seq GlyphPos -> TextLine
buildLine Seq (Seq GlyphPos)
resetGroups
    | Bool
otherwise = TextLine -> Seq TextLine
forall a. a -> Seq a
Seq.singleton (Int -> Seq GlyphPos -> TextLine
buildLine Int
0 Seq GlyphPos
forall a. Seq a
Empty)

buildTextLine
  :: Font
  -> FontSize
  -> FontSpace
  -> FontSpace
  -> TextMetrics
  -> Double
  -> Int
  -> Seq GlyphPos
  -> TextLine
buildTextLine :: Font
-> FontSize
-> FontSpace
-> FontSpace
-> TextMetrics
-> Double
-> Int
-> Seq GlyphPos
-> TextLine
buildTextLine Font
font FontSize
fSize FontSpace
fSpcH FontSpace
fSpcV TextMetrics
metrics Double
top Int
idx Seq GlyphPos
glyphs = TextLine
textLine where
  lineH :: Double
lineH = TextMetrics -> Double
_txmLineH TextMetrics
metrics
  x :: Double
x = Double
0
  y :: Double
y = Double
top Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
lineH Double -> Double -> Double
forall a. Num a => a -> a -> a
+ FontSpace -> Double
unFontSpace FontSpace
fSpcV)
  width :: Double
width = Seq GlyphPos -> Double
getGlyphsWidth Seq GlyphPos
glyphs
  height :: Double
height = Double
lineH
  text :: Text
text = String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (String -> GlyphPos -> String) -> String -> Seq GlyphPos -> String
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\String
ac GlyphPos
g -> GlyphPos -> Char
_glpGlyph GlyphPos
g Char -> String -> String
forall a. a -> [a] -> [a]
: String
ac) [] Seq GlyphPos
glyphs
  textLine :: TextLine
textLine = TextLine {
    _tlFont :: Font
_tlFont = Font
font,
    _tlFontSize :: FontSize
_tlFontSize = FontSize
fSize,
    _tlFontSpaceH :: FontSpace
_tlFontSpaceH = FontSpace
fSpcH,
    _tlFontSpaceV :: FontSpace
_tlFontSpaceV = FontSpace
fSpcV,
    _tlMetrics :: TextMetrics
_tlMetrics = TextMetrics
metrics,
    _tlText :: Text
_tlText = Text
text,
    _tlSize :: Size
_tlSize = Double -> Double -> Size
Size Double
width Double
height,
    _tlRect :: Rect
_tlRect = Double -> Double -> Double -> Double -> Rect
Rect Double
x Double
y Double
width Double
height,
    _tlGlyphs :: Seq GlyphPos
_tlGlyphs = Seq GlyphPos
glyphs
  }

addEllipsisToTextLine
  :: FontManager
  -> StyleState
  -> Double
  -> TextLine
  -> TextLine
addEllipsisToTextLine :: FontManager -> StyleState -> Double -> TextLine -> TextLine
addEllipsisToTextLine FontManager
fontMgr StyleState
style Double
width TextLine
textLine = TextLine
newTextLine where
  TextLine{Text
Seq GlyphPos
Rect
Size
TextMetrics
FontSpace
FontSize
Font
_tlFontSpaceV :: TextLine -> FontSpace
_tlRect :: TextLine -> Rect
_tlSize :: TextLine -> Size
_tlFont :: TextLine -> Font
_tlFontSize :: TextLine -> FontSize
_tlFontSpaceH :: TextLine -> FontSpace
_tlMetrics :: TextLine -> TextMetrics
_tlText :: TextLine -> Text
_tlGlyphs :: TextLine -> Seq GlyphPos
_tlFont :: Font
_tlFontSize :: FontSize
_tlFontSpaceH :: FontSpace
_tlFontSpaceV :: FontSpace
_tlMetrics :: TextMetrics
_tlText :: Text
_tlSize :: Size
_tlRect :: Rect
_tlGlyphs :: Seq GlyphPos
..} = TextLine
textLine
  Size Double
tw Double
th = Size
_tlSize
  Size Double
dw Double
dh = FontManager -> StyleState -> Text -> Size
calcTextSize FontManager
fontMgr StyleState
style Text
"..."

  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fontSize :: FontSize
fontSize = StyleState -> FontSize
styleFontSize StyleState
style
  fontSpcH :: FontSpace
fontSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style
  targetW :: Double
targetW = Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw

  dropHelper :: (a, Double) -> GlyphPos -> (a, Double)
dropHelper (a
idx, Double
w) GlyphPos
g
    | Double -> Double -> Bool
isSafeLE (GlyphPos -> Double
_glpW GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) Double
dw = (a
idx a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, GlyphPos -> Double
_glpW GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w)
    | Bool
otherwise = (a
idx, Double
w)
  (Int
dropChars, Double
_) = ((Int, Double) -> GlyphPos -> (Int, Double))
-> (Int, Double) -> Seq GlyphPos -> (Int, Double)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Double) -> GlyphPos -> (Int, Double)
forall {a}. Num a => (a, Double) -> GlyphPos -> (a, Double)
dropHelper (Int
0, Double
targetW) (Seq GlyphPos -> Seq GlyphPos
forall a. Seq a -> Seq a
Seq.reverse Seq GlyphPos
_tlGlyphs)

  newText :: Text
newText = Int -> Text -> Text
T.dropEnd Int
dropChars Text
_tlText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
  !newGlyphs :: Seq GlyphPos
newGlyphs = FontManager
-> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
computeGlyphsPos FontManager
fontMgr Font
font FontSize
fontSize FontSpace
fontSpcH Text
newText

  newW :: Double
newW = Seq GlyphPos -> Double
getGlyphsWidth Seq GlyphPos
newGlyphs
  newTextLine :: TextLine
newTextLine = TextLine
textLine {
    _tlText = newText,
    _tlSize = _tlSize { _sW = newW },
    _tlRect = _tlRect { _rW = newW },
    _tlGlyphs = newGlyphs
  }

clipTextLine
  :: FontManager
  -> StyleState
  -> TextTrim
  -> Double
  -> TextLine
  -> TextLine
clipTextLine :: FontManager
-> StyleState -> TextTrim -> Double -> TextLine -> TextLine
clipTextLine FontManager
fontMgr StyleState
style TextTrim
trim Double
width TextLine
textLine = TextLine
newTextLine where
  TextLine{Text
Seq GlyphPos
Rect
Size
TextMetrics
FontSpace
FontSize
Font
_tlFontSpaceV :: TextLine -> FontSpace
_tlRect :: TextLine -> Rect
_tlSize :: TextLine -> Size
_tlFont :: TextLine -> Font
_tlFontSize :: TextLine -> FontSize
_tlFontSpaceH :: TextLine -> FontSpace
_tlMetrics :: TextLine -> TextMetrics
_tlText :: TextLine -> Text
_tlGlyphs :: TextLine -> Seq GlyphPos
_tlFont :: Font
_tlFontSize :: FontSize
_tlFontSpaceH :: FontSpace
_tlFontSpaceV :: FontSpace
_tlMetrics :: TextMetrics
_tlText :: Text
_tlSize :: Size
_tlRect :: Rect
_tlGlyphs :: Seq GlyphPos
..} = TextLine
textLine
  Size Double
tw Double
th = Size
_tlSize

  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fontSize :: FontSize
fontSize = StyleState -> FontSize
styleFontSize StyleState
style
  fontSpcH :: FontSpace
fontSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style

  takeHelper :: (a, Double) -> GlyphPos -> (a, Double)
takeHelper (a
idx, Double
w) GlyphPos
g
    | Double -> Double -> Bool
isSafeLE (GlyphPos -> Double
_glpW GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) Double
width = (a
idx a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, GlyphPos -> Double
_glpW GlyphPos
g Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w)
    | Bool
otherwise = (a
idx, Double
w)

  (Integer
takeChars, Double
_) = ((Integer, Double) -> GlyphPos -> (Integer, Double))
-> (Integer, Double) -> Seq GlyphPos -> (Integer, Double)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Integer, Double) -> GlyphPos -> (Integer, Double)
forall {a}. Num a => (a, Double) -> GlyphPos -> (a, Double)
takeHelper (Integer
0, Double
0) Seq GlyphPos
_tlGlyphs
  validGlyphs :: Seq GlyphPos
validGlyphs = (GlyphPos -> Bool) -> Seq GlyphPos -> Seq GlyphPos
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL (\GlyphPos
g -> Double -> Double -> Bool
isSafeLE (GlyphPos -> Double
_glpXMax GlyphPos
g) Double
width) Seq GlyphPos
_tlGlyphs
  newText :: Text
newText
    | TextTrim
trim TextTrim -> TextTrim -> Bool
forall a. Eq a => a -> a -> Bool
== TextTrim
KeepSpaces = Int -> Text -> Text
T.take (Seq GlyphPos -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
validGlyphs) Text
_tlText
    | Bool
otherwise = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Seq GlyphPos -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq GlyphPos
validGlyphs) Text
_tlText

  !newGlyphs :: Seq GlyphPos
newGlyphs = FontManager
-> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
computeGlyphsPos FontManager
fontMgr Font
font FontSize
fontSize FontSpace
fontSpcH Text
newText
  newW :: Double
newW = Seq GlyphPos -> Double
getGlyphsWidth Seq GlyphPos
newGlyphs
  newTextLine :: TextLine
newTextLine = TextLine
textLine {
    _tlText = newText,
    _tlSize = _tlSize { _sW = newW },
    _tlRect = _tlRect { _rW = newW },
    _tlGlyphs = newGlyphs
  }

fitGroups :: Seq GlyphGroup -> Double -> Bool -> Seq GlyphGroup
fitGroups :: Seq (Seq GlyphPos) -> Double -> Bool -> Seq (Seq GlyphPos)
fitGroups Seq (Seq GlyphPos)
Empty Double
_ Bool
_ = Seq (Seq GlyphPos)
forall a. Seq a
Empty
fitGroups (Seq GlyphPos
g :<| Seq (Seq GlyphPos)
gs) !Double
width !Bool
keepTailSpaces = Seq GlyphPos
currentLine Seq GlyphPos -> Seq (Seq GlyphPos) -> Seq (Seq GlyphPos)
forall a. a -> Seq a -> Seq a
<| Seq (Seq GlyphPos)
extraLines where
  gW :: Double
gW = Seq GlyphPos -> Double
getGlyphsWidth Seq GlyphPos
g
  gMax :: Double
gMax = Seq GlyphPos -> Double
getGlyphsMax Seq GlyphPos
g
  extraGroups :: (Seq GlyphPos, Seq (Seq GlyphPos))
extraGroups = Seq (Seq GlyphPos)
-> Double -> Double -> Bool -> (Seq GlyphPos, Seq (Seq GlyphPos))
fitExtraGroups Seq (Seq GlyphPos)
gs (Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gW) Double
gMax Bool
keepTailSpaces
  (Seq GlyphPos
lineGroups, Seq (Seq GlyphPos)
remainingGroups) = (Seq GlyphPos, Seq (Seq GlyphPos))
extraGroups
  currentLine :: Seq GlyphPos
currentLine = Seq GlyphPos
g Seq GlyphPos -> Seq GlyphPos -> Seq GlyphPos
forall a. Semigroup a => a -> a -> a
<> Seq GlyphPos
lineGroups
  extraLines :: Seq (Seq GlyphPos)
extraLines = Seq (Seq GlyphPos) -> Double -> Bool -> Seq (Seq GlyphPos)
fitGroups Seq (Seq GlyphPos)
remainingGroups Double
width Bool
keepTailSpaces

fitExtraGroups
  :: Seq GlyphGroup
  -> Double
  -> Double
  -> Bool
  -> (Seq GlyphPos, Seq GlyphGroup)
fitExtraGroups :: Seq (Seq GlyphPos)
-> Double -> Double -> Bool -> (Seq GlyphPos, Seq (Seq GlyphPos))
fitExtraGroups Seq (Seq GlyphPos)
Empty Double
_ Double
_ Bool
_ = (Seq GlyphPos
forall a. Seq a
Empty, Seq (Seq GlyphPos)
forall a. Seq a
Empty)
fitExtraGroups (Seq GlyphPos
g :<| Seq (Seq GlyphPos)
gs) !Double
width !Double
prevGMax !Bool
keepTailSpaces
  | Double -> Double -> Bool
isSafeLE (Double
gW Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
wDiff) Double
width Bool -> Bool -> Bool
|| Bool
keepSpace = (Seq GlyphPos
g Seq GlyphPos -> Seq GlyphPos -> Seq GlyphPos
forall a. Semigroup a => a -> a -> a
<> Seq GlyphPos
newFit, Seq (Seq GlyphPos)
newRest)
  | Bool
otherwise = (Seq GlyphPos
forall a. Seq a
Empty, Seq GlyphPos
g Seq GlyphPos -> Seq (Seq GlyphPos) -> Seq (Seq GlyphPos)
forall a. a -> Seq a -> Seq a
:<| Seq (Seq GlyphPos)
gs)
  where
    gW :: Double
gW = Seq GlyphPos -> Double
getGlyphsWidth Seq GlyphPos
g
    gMin :: Double
gMin = Seq GlyphPos -> Double
getGlyphsMin Seq GlyphPos
g
    gMax :: Double
gMax = Seq GlyphPos -> Double
getGlyphsMax Seq GlyphPos
g
    wDiff :: Double
wDiff = Double
gMin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
prevGMax
    remWidth :: Double
remWidth = Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
gW Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
wDiff)
    keepSpace :: Bool
keepSpace = Bool
keepTailSpaces Bool -> Bool -> Bool
&& Seq GlyphPos -> Bool
isSpaceGroup Seq GlyphPos
g
    (Seq GlyphPos
newFit, Seq (Seq GlyphPos)
newRest) = Seq (Seq GlyphPos)
-> Double -> Double -> Bool -> (Seq GlyphPos, Seq (Seq GlyphPos))
fitExtraGroups Seq (Seq GlyphPos)
gs Double
remWidth Double
gMax Bool
keepTailSpaces

getGlyphsWidth :: Seq GlyphPos -> Double
getGlyphsWidth :: Seq GlyphPos -> Double
getGlyphsWidth Seq GlyphPos
glyphs = Seq GlyphPos -> Double
getGlyphsMax Seq GlyphPos
glyphs Double -> Double -> Double
forall a. Num a => a -> a -> a
- Seq GlyphPos -> Double
getGlyphsMin Seq GlyphPos
glyphs

isSpaceGroup :: Seq GlyphPos -> Bool
isSpaceGroup :: Seq GlyphPos -> Bool
isSpaceGroup Seq GlyphPos
Empty = Bool
False
isSpaceGroup (GlyphPos
g :<| Seq GlyphPos
gs) = Char -> Bool
isSpace (GlyphPos -> Char
_glpGlyph GlyphPos
g)

splitGroups :: LineBreak -> Double -> Seq GlyphPos -> Seq GlyphGroup
splitGroups :: LineBreak -> Double -> Seq GlyphPos -> Seq (Seq GlyphPos)
splitGroups LineBreak
_ Double
_ Seq GlyphPos
Empty = Seq (Seq GlyphPos)
forall a. Seq a
Empty
splitGroups LineBreak
break Double
width Seq GlyphPos
glyphs = Seq GlyphPos
group Seq GlyphPos -> Seq (Seq GlyphPos) -> Seq (Seq GlyphPos)
forall a. a -> Seq a -> Seq a
<| LineBreak -> Double -> Seq GlyphPos -> Seq (Seq GlyphPos)
splitGroups LineBreak
break Double
width Seq GlyphPos
rest where
  GlyphPos
g :<| Seq GlyphPos
gs = Seq GlyphPos
glyphs
  groupWordFn :: GlyphPos -> Bool
groupWordFn = Bool -> Bool
not (Bool -> Bool) -> (GlyphPos -> Bool) -> GlyphPos -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isWordDelimiter (Char -> Bool) -> (GlyphPos -> Char) -> GlyphPos -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphPos -> Char
_glpGlyph
  groupWidthFn :: GlyphPos -> Bool
groupWidthFn GlyphPos
g2 = GlyphPos -> Double
_glpXMax GlyphPos
g2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- GlyphPos -> Double
_glpXMin GlyphPos
g Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
width
  atWord :: Bool
atWord = LineBreak
break LineBreak -> LineBreak -> Bool
forall a. Eq a => a -> a -> Bool
== LineBreak
OnSpaces
  (Seq GlyphPos
group, Seq GlyphPos
rest)
    | Bool
atWord Bool -> Bool -> Bool
&& Char -> Bool
isWordDelimiter (GlyphPos -> Char
_glpGlyph GlyphPos
g) = (GlyphPos -> Seq GlyphPos
forall a. a -> Seq a
Seq.singleton GlyphPos
g, Seq GlyphPos
gs)
    | Bool
atWord = (GlyphPos -> Bool) -> Seq GlyphPos -> (Seq GlyphPos, Seq GlyphPos)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl GlyphPos -> Bool
groupWordFn Seq GlyphPos
glyphs
    | Bool
otherwise = (GlyphPos -> Bool) -> Seq GlyphPos -> (Seq GlyphPos, Seq GlyphPos)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl GlyphPos -> Bool
groupWidthFn Seq GlyphPos
glyphs

trimGlyphs :: Seq GlyphPos -> Seq GlyphPos
trimGlyphs :: Seq GlyphPos -> Seq GlyphPos
trimGlyphs Seq GlyphPos
glyphs = Seq GlyphPos
newGlyphs where
  isSpaceGlyph :: GlyphPos -> Bool
isSpaceGlyph GlyphPos
g = GlyphPos -> Char
_glpGlyph GlyphPos
g Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
  newGlyphs :: Seq GlyphPos
newGlyphs = (GlyphPos -> Bool) -> Seq GlyphPos -> Seq GlyphPos
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL GlyphPos -> Bool
isSpaceGlyph (Seq GlyphPos -> Seq GlyphPos) -> Seq GlyphPos -> Seq GlyphPos
forall a b. (a -> b) -> a -> b
$ (GlyphPos -> Bool) -> Seq GlyphPos -> Seq GlyphPos
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileR GlyphPos -> Bool
isSpaceGlyph Seq GlyphPos
glyphs

isWordDelimiter :: Char -> Bool
isWordDelimiter :: Char -> Bool
isWordDelimiter = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

isSpace :: Char -> Bool
isSpace :: Char -> Bool
isSpace = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

isSafeLE :: Double -> Double -> Bool
isSafeLE :: Double -> Double -> Bool
isSafeLE Double
width Double
target = Double
width Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
target Bool -> Bool -> Bool
|| Double -> Double
forall a. Num a => a -> a
abs (Double
target Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
width) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.001