{-|
Module      : Monomer.Widgets.Util.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 to text related operations in widgets.
-}
{-# LANGUAGE BangPatterns #-}

module Monomer.Widgets.Util.Text (
  getTextMetrics,
  getTextSize,
  getTextSize_,
  getSingleTextLineRect,
  getTextGlyphs
) where

import Control.Lens ((&), (^.), (+~))
import Data.Default
import Data.Sequence (Seq(..), (<|), (|>))
import Data.Text (Text)

import Monomer.Core
import Monomer.Graphics

import qualified Monomer.Core.Lens as L

-- | Returns the text metrics of the active style.
getTextMetrics :: WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics :: WidgetEnv s e -> StyleState -> TextMetrics
getTextMetrics WidgetEnv s e
wenv StyleState
style = TextMetrics
textMetrics where
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
  !textMetrics :: TextMetrics
textMetrics = FontManager -> Font -> FontSize -> TextMetrics
computeTextMetrics FontManager
fontMgr Font
font FontSize
fontSize
  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fontSize :: FontSize
fontSize = StyleState -> FontSize
styleFontSize StyleState
style

-- | Returns the size of the text using the active style and default options.
getTextSize :: WidgetEnv s e -> StyleState -> Text -> Size
getTextSize :: WidgetEnv s e -> StyleState -> Text -> Size
getTextSize WidgetEnv s e
wenv StyleState
style !Text
text = Size
size where
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
  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 of the text using the active style.
getTextSize_
  :: WidgetEnv s e  -- ^ The widget environment.
  -> StyleState     -- ^ The active style.
  -> TextMode       -- ^ Whether to use single or multi line.
  -> TextTrim       -- ^ Whether to trim spacers or keep them.
  -> Maybe Double   -- ^ Maximum width (required for multi line).
  -> Maybe Int      -- ^ Max lines.
  -> Text           -- ^ Text to measure.
  -> Size           -- ^ The calculated size.
getTextSize_ :: WidgetEnv s e
-> StyleState
-> TextMode
-> TextTrim
-> Maybe Double
-> Maybe Int
-> Text
-> Size
getTextSize_ WidgetEnv s e
wenv StyleState
style TextMode
mode TextTrim
trim Maybe Double
mwidth Maybe Int
mlines Text
text = Size
newSize where
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
  newSize :: Size
newSize = 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

-- | Returns the rect a single line of text needs to be displayed completely.
getSingleTextLineRect
  :: WidgetEnv s e  -- ^ The widget environment.
  -> StyleState     -- ^ The active style.
  -> Rect           -- ^ The bounding rect.
  -> AlignTH        -- ^ The horizontal alignment.
  -> AlignTV        -- ^ The vertical alignment.
  -> Text           -- ^ The text to measure.
  -> Rect           -- ^ The used rect. May be larger than the bounding rect.
getSingleTextLineRect :: WidgetEnv s e
-> StyleState -> Rect -> AlignTH -> AlignTV -> Text -> Rect
getSingleTextLineRect WidgetEnv s e
wenv StyleState
style !Rect
rect !AlignTH
alignH !AlignTV
alignV !Text
text = Rect
textRect where
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fSize :: FontSize
fSize = StyleState -> FontSize
styleFontSize StyleState
style
  fSpcH :: FontSpace
fSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style

  Rect Double
x Double
y Double
w Double
h = Rect
rect
  Size Double
tw Double
_ = FontManager -> Font -> FontSize -> FontSpace -> Text -> Size
computeTextSize FontManager
fontMgr Font
font FontSize
fSize FontSpace
fSpcH Text
text
  TextMetrics Double
asc Double
desc Double
lineh Double
lowerX = FontManager -> Font -> FontSize -> TextMetrics
computeTextMetrics FontManager
fontMgr Font
font FontSize
fSize

  tx :: Double
tx | AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATLeft = Double
x
     | AlignTH
alignH AlignTH -> AlignTH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTH
ATCenter = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
     | Bool
otherwise = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
tw)
  ty :: Double
ty | AlignTV
alignV AlignTV -> AlignTV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTV
ATTop = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
asc
     | AlignTV
alignV AlignTV -> AlignTV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTV
ATMiddle = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
desc Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lineh) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
     | AlignTV
alignV AlignTV -> AlignTV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTV
ATAscender = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
h 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
alignV AlignTV -> AlignTV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignTV
ATLowerX = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lowerX) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
     | Bool
otherwise = Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
desc

  textRect :: Rect
textRect = Rect :: Double -> Double -> Double -> Double -> Rect
Rect {
    _rX :: Double
_rX = Double
tx,
    _rY :: Double
_rY = Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lineh,
    _rW :: Double
_rW = Double
tw,
    _rH :: Double
_rH = Double
lineh
  }

-- | Returns the glyphs of a single line of text.
getTextGlyphs :: WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
getTextGlyphs :: WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
getTextGlyphs WidgetEnv s e
wenv StyleState
style !Text
text = Seq GlyphPos
glyphs where
  fontMgr :: FontManager
fontMgr = WidgetEnv s e
wenv WidgetEnv s e
-> Getting FontManager (WidgetEnv s e) FontManager -> FontManager
forall s a. s -> Getting a s a -> a
^. Getting FontManager (WidgetEnv s e) FontManager
forall s a. HasFontManager s a => Lens' s a
L.fontManager
  font :: Font
font = StyleState -> Font
styleFont StyleState
style
  fSize :: FontSize
fSize = StyleState -> FontSize
styleFontSize StyleState
style
  fSpcH :: FontSpace
fSpcH = StyleState -> FontSpace
styleFontSpaceH StyleState
style
  !glyphs :: Seq GlyphPos
glyphs = FontManager
-> Font -> FontSize -> FontSpace -> Text -> Seq GlyphPos
computeGlyphsPos FontManager
fontMgr Font
font FontSize
fSize FontSpace
fSpcH Text
text