Make getTextRect depend on getTextRect_, based on glyphs

app/Main.hs

@@ -145,7 +145,7 @@ buildUI model = trace "Creating UI" widgetTree where
       label (model ^. textField1) `style` [bgColor lightBlue, textLeft],
       textField textField1 `style` [bgColor lightBlue, textLeft],
       hgrid [
-        label_ "This is a really long label used to check what I did works fine" [textEllipsis],
+        label_ "This is a really long label used to check what I did works fine" [textEllipsis] `style` [width 300],
         label "Jj label"
       ],
       hstack [

package.yaml

@@ -35,8 +35,8 @@ dependencies:
 - extra
 - formatting
 - http-client
-- lens
 - JuicyPixels
+- lens
 - mtl
 - nanovg
 - OpenGL

src/Monomer/Widgets/Button.hs

@@ -127,8 +127,6 @@ makeButton config state = widget where
   getSizeReq wenv inst = sizeReq where
     style = activeStyle wenv inst
     Size w h = getTextSize wenv style caption
---    glyphs = getTextGlyphs wenv style caption
---    factor = traceShow (w, h, getGlyphsWidth glyphs) 1
     factor = 1
     sizeReq = (FlexSize w factor, FixedSize h)
 

src/Monomer/Widgets/Label.hs

@@ -6,6 +6,7 @@ module Monomer.Widgets.Label (
 import Debug.Trace
 
 import Control.Applicative ((<|>))
+import Control.Lens ((^.))
 import Control.Monad (forM_)
 import Data.Default
 import Data.Maybe
@@ -76,7 +77,7 @@ makeLabel config state = widget where
   }
 
   overflow = fromMaybe Ellipsis (_lscTextOverflow config)
-  mode = fromMaybe SingleLine (_lscTextMode config)
+  mode = fromMaybe MultiLine (_lscTextMode config)
   trimSpaces = fromMaybe True (_lscTrimSpaces config)
   LabelState caption textLines = state
 
@@ -91,7 +92,8 @@ makeLabel config state = widget where
 
   getSizeReq wenv inst = sizeReq where
     style = activeStyle wenv inst
-    Size w h = getTextSize wenv style caption
+    targetW = fmap getMinSizeReq (style ^. L.sizeReqW)
+    Size w h = getTextSize_ wenv style mode trimSpaces targetW caption
     factor = 1
     sizeReq = (FlexSize w factor, FixedSize h)
 

src/Monomer/Widgets/Util/Misc.hs

@@ -10,6 +10,13 @@ import Monomer.Event
 
 import qualified Monomer.Lens as L
 
+maxNumericValue :: (RealFloat a) => a
+maxNumericValue = x where
+  n = floatDigits x
+  b = floatRadix x
+  (_, u) = floatRange x
+  x = encodeFloat (b^n - 1) (u - n)
+
 pointInViewport :: Point -> WidgetInstance s e -> Bool
 pointInViewport p inst = pointInRect p (_wiViewport inst)
 

src/Monomer/Widgets/Util/Text.hs

@@ -5,6 +5,7 @@ module Monomer.Widgets.Util.Text (
   TextLine(..),
   getTextMetrics,
   getTextSize,
+  getTextSize_,
   getTextRect,
   getTextGlyphs,
   getGlyphsMin,
@@ -25,6 +26,7 @@ import qualified Data.Text as T
 
 import Monomer.Core
 import Monomer.Graphics
+import Monomer.Widgets.Util.Misc
 import Monomer.Widgets.Util.Style
 
 type GlyphGroup = Seq GlyphPos
@@ -51,10 +53,29 @@ getTextMetrics wenv style = textMetrics where
   fontSize = styleFontSize style
 
 getTextSize :: WidgetEnv s e -> StyleState -> Text -> Size
-getTextSize wenv style !text = textBounds where
+getTextSize wenv style !text = newSize where
+  newSize = getTextSize_ wenv style SingleLine False Nothing text
+
+getTextSize_
+  :: WidgetEnv s e
+  -> StyleState
+  -> TextMode
+  -> Bool
+  -> Maybe Double
+  -> Text
+  -> Size
+getTextSize_ wenv style mode trim mwidth text = newSize where
   font = styleFont style
   fontSize = styleFontSize style
-  !textBounds = computeTextSize (_weRenderer wenv) font fontSize text
+  !metrics = computeTextMetrics (_weRenderer wenv) font fontSize
+  width = fromMaybe maxNumericValue mwidth
+  textLinesW = fitTextToW wenv style width trim text
+  textLines
+    | mode == SingleLine = Seq.take 1 textLinesW
+    | otherwise = textLinesW
+  newSize
+    | not (Seq.null textLines) = getTextLinesSize textLines
+    | otherwise = Size 0 (_txmLineH metrics)
 
 getTextRect
   :: WidgetEnv s e -> StyleState -> Rect -> Align -> Text -> Rect
@@ -68,7 +89,7 @@ getTextGlyphs :: WidgetEnv s e -> StyleState -> Text -> Seq GlyphPos
 getTextGlyphs wenv style !text = glyphs where
   font = styleFont style
   fontSize = styleFontSize style
-  glyphs = computeGlyphsPos (_weRenderer wenv) font fontSize text
+  !glyphs = computeGlyphsPos (_weRenderer wenv) font fontSize text
 
 getGlyphsMin :: Seq GlyphPos -> Double
 getGlyphsMin Empty = 0
@@ -185,7 +206,7 @@ fitTextToW
 fitTextToW wenv style width trim text = resultLines where
   font = styleFont style
   fontSize = styleFontSize style
-  metrics = computeTextMetrics (_weRenderer wenv) font fontSize
+  !metrics = computeTextMetrics (_weRenderer wenv) font fontSize
   lineH = _txmLineH metrics
   helper acc line = (cLines <> newLines, newTop) where
     (cLines, cTop) = acc
@@ -206,7 +227,7 @@ fitSingleTextToW
 fitSingleTextToW wenv font fontSize metrics top width trim text = result where
   spaces = "    "
   newText = T.replace "\t" spaces text
-  glyphs = computeGlyphsPos (_weRenderer wenv) font fontSize newText
+  !glyphs = computeGlyphsPos (_weRenderer wenv) font fontSize newText
   groups = fitGroups (splitGroups glyphs) width
   resetGroups
     | trim = fmap (resetGlyphs . trimGlyphs) groups
@@ -247,7 +268,7 @@ addEllipsisToTextLine wenv style width textLine = newTextLine where
     | otherwise = (idx, w)
   (dropChars, _) = foldl' dropHelper (0, 0) textGlyphs
   newText = T.dropEnd dropChars text <> "..."
-  newGlyphs = computeGlyphsPos (_weRenderer wenv) font fontSize newText
+  !newGlyphs = computeGlyphsPos (_weRenderer wenv) font fontSize newText
   newW = getGlyphsWidth newGlyphs
   newTextLine = TextLine {
     _tlText = newText,

tasks.md

@@ -243,13 +243,14 @@
   - Provided viewport should consider parent viewport
   - Check scroll styling works correctly (contentRect being applied, etc)
     - Also handle hover so scrollbars get correct cursor
+  - Move computeTextRect out of Renderer
 
 - Pending
   - Multiline label
   - Check 1px difference on right side of labels/buttons
-  - Move computeTextRect out of Renderer
   - Check displaced textField when adding characters on right align
     - Also, when right is reached from left, everything is pushed out of screen
+  - Check dropdown width/ellipsis
   - Add testing
     - Delayed until this point to try to settle down interfaces
     - Validate stack assigns space correctly