From 831fe4335d87b31eee0cf49d64e3d04b6b6186eb Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Sat, 28 Jan 2023 17:51:52 +1300 Subject: [PATCH] Test and fix rendering of consecutive newlines. --- app/Main.hs | 20 ++++++++++++++++---- src/Typograffiti/Store.hs | 5 +++-- src/Typograffiti/Text.hs | 24 ++++++++++++++---------- 3 files changed, 33 insertions(+), 16 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 4090112..610c806 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -28,7 +28,21 @@ main = do _ <- glCreateContext w let ttfName = "assets/Lora-Regular.ttf" - text <- pack <$> unwords <$> getArgs + args <- getArgs + let text = pack $ case args of + [] -> unlines [ + "Decoder Ring Theatre brings you the continuing adventures", + "of Canada's greatest superhero, that scourage of the underworld,", + "hunter of those who pray upon the innocent,", + "that marvelous masked mystery man", + "known only as The Red Panda!", + "", + "The Red Panda, masked crucader for justice, hides his secret identity", + "as one of the city's wealthiest men in his neverending battle", + "against crime & corruption. Only his trust driver, Kit Baxter", + "who joins him in the guise of The Flying Squirrel,", + "knows who wears the mask of The Red Panda!"] + _ -> unwords args drawText <- makeDrawText' ttfName 0 (PixelSize 15 15) $ defaultSample { sampleText = text } runExceptT $ do drawText0 <- liftEither drawText @@ -42,10 +56,8 @@ main = do sz@(V2 dw dh) <- liftIO $ glGetDrawableSize w liftIO $ glViewport 0 0 (fromIntegral dw) (fromIntegral dh) - let offset = V2 0 $ fromIntegral dy - V2 _ dy = arSize drawText' liftIO $ arDraw drawText' [ - TextTransformSpatial $ SpatialTransformTranslate $ fromIntegral dy + TextTransformSpatial $ SpatialTransformTranslate $ fromIntegral 10 ] (fromIntegral <$> sz) liftIO $ glSwapWindow w diff --git a/src/Typograffiti/Store.hs b/src/Typograffiti/Store.hs index bdd2b40..436b8ce 100644 --- a/src/Typograffiti/Store.hs +++ b/src/Typograffiti/Store.hs @@ -87,8 +87,9 @@ makeDrawTextCached store filepath index fontsize SampleText {..} = do (atlas:_) -> return atlas _ -> allocAtlas' (atlases font) (freetype font) glyphset - return $ drawLinesWrapper tabwidth $ \RichText {..} -> drawGlyphs store atlas $ - shape (harfbuzz font) defaultBuffer { HB.text = text } [] + return $ drawLinesWrapper tabwidth minLineHeight $ + \RichText {..} -> drawGlyphs store atlas $ + shape (harfbuzz font) defaultBuffer { HB.text = text } [] -- | Opens & sizes the given font using both FreeType & Harfbuzz, -- loading it into the `FontStore` before returning. diff --git a/src/Typograffiti/Text.hs b/src/Typograffiti/Text.hs index 0d5ba28..e9f05d8 100644 --- a/src/Typograffiti/Text.hs +++ b/src/Typograffiti/Text.hs @@ -52,14 +52,17 @@ data SampleText = SampleText { -- Defaults to ASCII, no ligatures. tabwidth :: Int, -- ^ How many spaces wide should a tab be rendered? - -- Defaults to 4. - fontOptions :: FontOptions + -- Defaults to 4 spaces. + fontOptions :: FontOptions, -- ^ Additional font options offered by Harfbuzz. + minLineHeight :: Float + -- ^ Number of pixels tall each line should be at minimum. + -- Defaults to 10px. } -- | Constructs a `SampleText` with default values. defaultSample :: SampleText -defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4 defaultFontOptions +defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4 defaultFontOptions 10 -- | Appends an OpenType feature callers may use to the `Sample` ensuring its -- glyphs are available. Call after setting `sampleText`. addSampleFeature :: String -> Word32 -> SampleText -> SampleText @@ -145,8 +148,9 @@ makeDrawText lib filepath index fontsize SampleText {..} = do liftFreetype $ ft_Done_Face font drawGlyphs <- makeDrawGlyphs - return $ freeAtlasWrapper atlas $ drawLinesWrapper tabwidth $ \RichText {..} -> - drawGlyphs atlas $ shape font' defaultBuffer { HB.text = text } features + return $ freeAtlasWrapper atlas $ drawLinesWrapper tabwidth minLineHeight + $ \RichText {..} -> + drawGlyphs atlas $ shape font' defaultBuffer { HB.text = text } features where x2 = (*2) float2fixed :: Float -> FT_Fixed @@ -158,16 +162,15 @@ makeDrawText' a b c d = -- | Internal utility for rendering multiple lines of text & expanding tabs as configured. type TextRenderer m = RichText -> m (AllocatedRendering [TextTransform]) -drawLinesWrapper :: (MonadIO m, MonadFail m) => Int -> TextRenderer m -> TextRenderer m -drawLinesWrapper indent cb RichText {..} = do +drawLinesWrapper :: (MonadIO m, MonadFail m) => Int -> Float -> TextRenderer m -> TextRenderer m +drawLinesWrapper indent lineheight cb RichText {..} = do let features' = splitFeatures 0 features (Txt.lines text) ++ repeat [] let cb' (a, b) = cb $ RichText a b - liftIO $ print $ Txt.lines text renderers <- mapM cb' $ flip zip features' $ map processLine $ Txt.lines text let drawLine ts wsz y renderer = do arDraw renderer (move 0 y:ts) wsz let V2 _ height = arSize renderer - return (y + toEnum height) + return (y + max lineheight (toEnum height)) let draw ts wsz = do foldM (drawLine ts wsz) 0 renderers return () @@ -195,7 +198,8 @@ drawLinesWrapper indent cb RichText {..} = do splitFeatures (offset + toEnum n) features' lines' processLine :: Text -> Text - processLine = expandTabs 0 + processLine "" = " " -- Prevent Harfbuzz from throwing errors. + processLine cs = expandTabs 0 cs -- monospace tabshaping, good enough outside full line-layout. expandTabs n cs = case Txt.break (== '\t') cs of (tail, "") -> tail -- 2.30.2