diff --git a/app/Main.hs b/app/Main.hs index 0093a671..66b89759 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -80,8 +80,8 @@ handleAppEvent model evt = case evt of buildUI :: App -> WidgetInstance App AppEvent buildUI model = trace "Creating UI" widgetTree3 where widgetTree3 = hgrid [ - label "Hola\nEsta\nes\nuna\nnueva\tprueba\n\n Doble!" `style` [bgColor pink, textRight], - label "Este es un label bien largo para ver si se cortan bien las lineas" `style` [bgColor blue, textRight], + label "Hola\nEsta\nes\nuna\nnueva\tprueba\n\n Doble!" `style` [bgColor pink, textBottom, textCenter], + label "Este es un label bien largo para ver si se cortan correctamentereallyverybien las lineas" `style` [bgColor blue, textBottom, textRight], label "", label "" ] diff --git a/src/Monomer/Widgets/InputField.hs b/src/Monomer/Widgets/InputField.hs index 8ea56070..b432ca30 100644 --- a/src/Monomer/Widgets/InputField.hs +++ b/src/Monomer/Widgets/InputField.hs @@ -377,7 +377,7 @@ newTextState wenv inst oldState value text cursor selection = newState where style = activeStyle wenv inst contentArea = getContentArea style inst !(Rect cx cy cw ch) = contentArea - !textMetrics = getTextMetrics wenv style contentArea align text + !textMetrics = getTextMetrics wenv style !textRect = getTextRect wenv style contentArea align text TextMetrics ta ts tl = textMetrics Rect tx ty tw th = textRect diff --git a/src/Monomer/Widgets/Label.hs b/src/Monomer/Widgets/Label.hs index f6021ee8..a197fc23 100644 --- a/src/Monomer/Widgets/Label.hs +++ b/src/Monomer/Widgets/Label.hs @@ -111,7 +111,7 @@ makeLabel config state = widget where alignH = styleTextAlignH style alignV = styleTextAlignV style fontColor = styleFontColor style - tempTextLines = fitTextLines wenv style cw caption + tempTextLines = fitTextLines wenv style cw True caption newTextLines = alignTextLines contentArea alignH alignV tempTextLines newWidget = makeLabel config (LabelState caption newTextLines) newInst = inst { @@ -119,21 +119,23 @@ makeLabel config state = widget where } render renderer wenv inst = - forM_ textLines (drawTextLine renderer style) + forM_ textLines (drawTextLine renderer style textMetrics) where style = activeStyle wenv inst + textMetrics = getTextMetrics wenv style -drawTextLine :: Renderer -> StyleState -> TextLine -> IO () -drawTextLine renderer style textLine = do +drawTextLine :: Renderer -> StyleState -> TextMetrics -> TextLine -> IO () +drawTextLine renderer style textMetrics textLine = do setFillColor renderer fontColor renderText renderer point font fontSize text where + TextMetrics asc desc lineH = textMetrics TextLine text size rect glyphs = textLine Rect tx ty tw th = rect font = styleFont style fontSize = styleFontSize style fontColor = styleFontColor style - point = Point tx (ty + th) + point = Point tx (ty + th + desc) type GlyphGroup = Seq GlyphPos @@ -180,16 +182,17 @@ fitTextLines :: WidgetEnv s e -> StyleState -> Double + -> Bool -> Text -> Seq TextLine -fitTextLines wenv style width text = resultLines where +fitTextLines wenv style width trim text = resultLines where font = styleFont style fontSize = styleFontSize style metrics = computeTextMetrics (_weRenderer wenv) font fontSize lineH = _txhLineH metrics helper acc currLine = (currLines <> newLines, newTop) where (currLines, currTop) = acc - newLines = fitTextLine wenv font fontSize currTop width lineH currLine + newLines = fitTextLine wenv font fontSize currTop width lineH trim currLine newTop = currTop + fromIntegral (Seq.length newLines) * lineH (resultLines, _) = foldl' helper (Empty, 0) (T.lines text) @@ -200,17 +203,24 @@ fitTextLine -> Double -> Double -> Double + -> Bool -> Text -> Seq TextLine -fitTextLine wenv font fontSize top width lineH text = result where +fitTextLine wenv font fontSize top width lineH trim text = result where spaces = " " newText = T.replace "\t" spaces text glyphs = computeGlyphsPos (_weRenderer wenv) font fontSize newText groups = fitGroups (splitGroups glyphs) width - --resetGroups = fmap (`resetGlyphsPos` 0) groups - resetGroups = fmap resetGlyphs groups + resetGroups + | trim = fmap (resetGlyphs . trimGlyphs) groups + | otherwise = fmap resetGlyphs groups result = Seq.mapWithIndex (buildTextLine top lineH) resetGroups +trimGlyphs :: Seq GlyphPos -> Seq GlyphPos +trimGlyphs glyphs = newGlyphs where + isSpaceGlyph g = _glpGlyph g == ' ' + newGlyphs = Seq.dropWhileL isSpaceGlyph $ Seq.dropWhileR isSpaceGlyph glyphs + buildTextLine :: Double -> Double -> Int -> Seq GlyphPos -> TextLine buildTextLine top lineH idx glyphs = textLine where x = 0 diff --git a/src/Monomer/Widgets/Util/Text.hs b/src/Monomer/Widgets/Util/Text.hs index 48bcd01c..9b779864 100644 --- a/src/Monomer/Widgets/Util/Text.hs +++ b/src/Monomer/Widgets/Util/Text.hs @@ -22,8 +22,8 @@ import Monomer.Graphics import Monomer.Widgets.Util.Style getTextMetrics - :: WidgetEnv s e -> StyleState -> Rect -> Align -> Text -> TextMetrics -getTextMetrics wenv style !rect !align !text = textMetrics where + :: WidgetEnv s e -> StyleState -> TextMetrics +getTextMetrics wenv style = textMetrics where renderer = _weRenderer wenv !textMetrics = computeTextMetrics renderer font fontSize font = styleFont style