From d85314ac4de7faae8e66176002f19c5bb24f5516 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 17 Feb 2023 18:29:16 +1300 Subject: [PATCH] Fix font resizing issues, looking up appropriate Harfbuzz scaling. --- app/Main.hs | 4 ++-- src/Typograffiti/Atlas.hs | 20 ++++++++++--------- src/Typograffiti/Store.hs | 42 +++++++++++++++++++++++++++++---------- src/Typograffiti/Text.hs | 29 ++++++++++++++++++++------- 4 files changed, 66 insertions(+), 29 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 610c806..d70bac2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -32,14 +32,14 @@ main = do 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,", + "of Canada's greatest superhero, that scourge 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", + "against crime & corruption. Only his trusty driver, Kit Baxter", "who joins him in the guise of The Flying Squirrel,", "knows who wears the mask of The Red Panda!"] _ -> unwords args diff --git a/src/Typograffiti/Atlas.hs b/src/Typograffiti/Atlas.hs index 86bdac7..63a4332 100644 --- a/src/Typograffiti/Atlas.hs +++ b/src/Typograffiti/Atlas.hs @@ -67,13 +67,15 @@ data Atlas = Atlas { -- ^ The texture holding the pre-rendered glyphs. atlasTextureSize :: V2 Int, -- ^ The size of the texture. - atlasMetrics :: IntMap GlyphMetrics + atlasMetrics :: IntMap GlyphMetrics, -- ^ Mapping from glyphs to their position in the texture. + atlasScale :: (Float, Float) + -- ^ Scaling factor for font-units given by Harfbuzz. } deriving (Show) -- | Initializes an empty atlas. emptyAtlas :: GLuint -> Atlas -emptyAtlas t = Atlas t 0 mempty +emptyAtlas t = Atlas t 0 mempty (0, 0) -- | Precomputed positioning of glyphs in an `Atlas` texture. data AtlasMeasure = AM { @@ -165,8 +167,8 @@ texturize cb xymap atlas@Atlas{..} glyph -- might need during the life of the 'Atlas'. Character texturization only -- happens once. allocAtlas :: (MonadIO m, MonadFail m, MonadError TypograffitiError m) => - GlyphRetriever m -> [Word32] -> m Atlas -allocAtlas cb glyphs = do + GlyphRetriever m -> [Word32] -> (Float, Float) -> m Atlas +allocAtlas cb glyphs scale = do AM {..} <- foldM (measure cb 512) emptyAM glyphs let V2 w h = amWH xymap = amMap @@ -186,7 +188,7 @@ allocAtlas cb glyphs = do glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glBindTexture GL_TEXTURE_2D 0 glPixelStorei GL_UNPACK_ALIGNMENT 4 - return atlas { atlasTextureSize = V2 w h } + return atlas { atlasTextureSize = V2 w h, atlasScale = scale } -- | Releases all resources associated with the given 'Atlas'. freeAtlas :: MonadIO m => Atlas -> m () @@ -202,8 +204,8 @@ makeCharQuad Atlas {..} (penx, peny, mLast) (GlyphInfo {codepoint=glyph}, GlyphP case IM.lookup iglyph atlasMetrics of Nothing -> throwError $ TypograffitiErrorNoMetricsForGlyph iglyph Just GlyphMetrics {..} -> do - let x = penx + f x_offset - y = peny + f y_offset + let x = penx + f x_offset*fst atlasScale + y = peny + f y_offset*snd atlasScale V2 w h = f' <$> glyphSize V2 aszW aszH = f' <$> atlasTextureSize V2 texL texT = f' <$> fst glyphTexBB @@ -214,11 +216,11 @@ makeCharQuad Atlas {..} (penx, peny, mLast) (GlyphInfo {codepoint=glyph}, GlyphP br = (V2 (x+w) y, V2 (texR/aszW) (texB/aszH)) bl = (V2 (x) y, V2 (texL/aszW) (texB/aszH)) - return (penx + f x_advance/150, peny + f y_advance/150, + return (penx + f x_advance*fst atlasScale, peny + f y_advance*snd atlasScale, UV.fromList [tl, tr, br, tl, br, bl] : mLast) where f :: Int32 -> Float - f = fromIntegral + f = fromIntegral f' :: Int -> Float f' = fromIntegral diff --git a/src/Typograffiti/Store.hs b/src/Typograffiti/Store.hs index d296ef0..3586bb0 100644 --- a/src/Typograffiti/Store.hs +++ b/src/Typograffiti/Store.hs @@ -31,8 +31,9 @@ import Data.Text.Glyphize (defaultBuffer, Buffer(..), shape, GlyphInfo(..), GlyphPos(..), FontOptions) import qualified Data.Text.Glyphize as HB import qualified Data.Text.Lazy as Txt +import Foreign.Storable (peek) import FreeType.Core.Base -import FreeType.Core.Types (FT_Fixed) +import FreeType.Core.Types (FT_Fixed, FT_UShort) import FreeType.Format.Multiple (ft_Set_Var_Design_Coordinates) import Typograffiti.Atlas @@ -55,8 +56,12 @@ data Font = Font { -- ^ Font as represented by Harfbuzz. freetype :: FT_Face, -- ^ Font as represented by FreeType. - atlases :: TMVar [(IS.IntSet, Atlas)] + atlases :: TMVar [(IS.IntSet, Atlas)], -- ^ Glyphs from the font rendered into GPU atleses. + lineHeight :: Float, + -- ^ Default lineheight for this font. + fontScale :: (Float, Float) + -- ^ Scaling parameters for Harfbuzz layout. } -- | Opens a font sized to given value & prepare to render text in it. @@ -67,8 +72,11 @@ makeDrawTextCached :: (MonadIO m, MonadFail m, MonadError TypograffitiError m, m (RichText -> n (AllocatedRendering [TextTransform])) makeDrawTextCached store filepath index fontsize SampleText {..} = do s <- liftIO $ atomically $ readTMVar $ fontMap store - font <- case M.lookup (filepath, fontsize, index, fontOptions) s of - Nothing -> allocFont store filepath index fontsize fontOptions + let fontOpts' = fontOptions { + HB.optionScale = Nothing, HB.optionPtEm = Nothing, HB.optionPPEm = Nothing + } + font <- case M.lookup (filepath, fontsize, index, fontOpts') s of + Nothing -> allocFont store filepath index fontsize fontOpts' Just font -> return font let glyphs = map (codepoint . fst) $ @@ -80,9 +88,10 @@ makeDrawTextCached store filepath index fontsize SampleText {..} = do a <- liftIO $ atomically $ readTMVar $ atlases font atlas <- case [a' | (gs, a') <- a, glyphset `IS.isSubsetOf` gs] of (atlas:_) -> return atlas - _ -> allocAtlas' (atlases font) (freetype font) glyphset + _ -> allocAtlas' (atlases font) (freetype font) glyphset (fontScale font) - return $ drawLinesWrapper tabwidth minLineHeight $ + let lh = if minLineHeight == 0 then lineHeight font else minLineHeight + return $ drawLinesWrapper tabwidth lh $ \RichText {..} -> drawGlyphs store atlas $ shape (harfbuzz font) defaultBuffer { HB.text = text } [] @@ -104,8 +113,14 @@ allocFont FontStore {..} filepath index fontsize options = liftFreetype $ do let designCoords = map float2fixed $ HB.fontVarCoordsDesign font' unless (null designCoords) $ liftIO $ ft_Set_Var_Design_Coordinates font designCoords + font_ <- liftIO $ peek font + size <- srMetrics <$> liftIO (peek $ frSize font_) + let lineHeight = fixed2float $ smHeight size + let upem = short2float $ frUnits_per_EM font_ + let scale = (short2float (smX_ppem size)/upem/2, short2float (smY_ppem size)/upem/2) + atlases <- liftIO $ atomically $ newTMVar [] - let ret = Font font' font atlases + let ret = Font font' font atlases lineHeight scale atomically $ do map <- takeTMVar fontMap @@ -114,15 +129,20 @@ allocFont FontStore {..} filepath index fontsize options = liftFreetype $ do where x2 = (*2) float2fixed :: Float -> FT_Fixed - float2fixed = toEnum . fromEnum . (*65536) + float2fixed = toEnum . fromEnum . (*bits16) + fixed2float :: FT_Fixed -> Float + fixed2float = (/bits16) . toEnum . fromEnum + bits16 = 2**16 + short2float :: FT_UShort -> Float + short2float = toEnum . fromEnum -- | Allocates a new Atlas for the given font & glyphset, -- loading it into the atlas cache before returning. allocAtlas' :: (MonadIO m, MonadFail m, MonadError TypograffitiError m) => - TMVar [(IS.IntSet, Atlas)] -> FT_Face -> IS.IntSet -> m Atlas -allocAtlas' atlases font glyphset = do + TMVar [(IS.IntSet, Atlas)] -> FT_Face -> IS.IntSet -> (Float, Float) -> m Atlas +allocAtlas' atlases font glyphset scale = do let glyphs = map toEnum $ IS.toList glyphset - atlas <- allocAtlas (glyphRetriever font) glyphs + atlas <- allocAtlas (glyphRetriever font) glyphs scale liftIO $ atomically $ do a <- takeTMVar atlases diff --git a/src/Typograffiti/Text.hs b/src/Typograffiti/Text.hs index 2454c84..95c0399 100644 --- a/src/Typograffiti/Text.hs +++ b/src/Typograffiti/Text.hs @@ -25,11 +25,12 @@ import Data.Text.Glyphize (defaultBuffer, shape, GlyphInfo (..), FontOptions (..), defaultFontOptions) import qualified Data.Text.Glyphize as HB import FreeType.Core.Base -import FreeType.Core.Types (FT_Fixed) +import FreeType.Core.Types (FT_Fixed, FT_UShort) import FreeType.Format.Multiple (ft_Set_Var_Design_Coordinates) import Data.Text.Lazy (Text, pack) import qualified Data.Text.Lazy as Txt import Data.Word (Word32) +import Foreign.Storable (peek) import Typograffiti.Atlas import Typograffiti.Cache @@ -58,12 +59,12 @@ data SampleText = SampleText { -- ^ Additional font options offered by Harfbuzz. minLineHeight :: Float -- ^ Number of pixels tall each line should be at minimum. - -- Defaults to 10px. + -- Defaults to 0 indicate to use the font's default lineheight. } -- | Constructs a `SampleText` with default values. defaultSample :: SampleText -defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4 defaultFontOptions 10 +defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4 defaultFontOptions 0 -- | Appends an OpenType feature callers may use to the `Sample` ensuring its -- glyphs are available. Call after setting `sampleText`. addSampleFeature :: String -> Word32 -> SampleText -> SampleText @@ -133,8 +134,17 @@ makeDrawText lib filepath index fontsize SampleText {..} = do (floor $ 26.6 * 2 * h) (toEnum dpix) (toEnum dpiy) + font_ <- liftIO $ peek font + size <- srMetrics <$> liftIO (peek $ frSize font_) + let lineHeight = if minLineHeight == 0 then fixed2float $ smHeight size else minLineHeight + let upem = short2float $ frUnits_per_EM font_ + let scale = (short2float (smX_ppem size)/upem/2, short2float (smY_ppem size)/upem/2) + bytes <- liftIO $ B.readFile filepath - let font' = HB.createFontWithOptions fontOptions $ HB.createFace bytes $ toEnum index + let fontOpts' = fontOptions { + HB.optionScale = Nothing, HB.optionPtEm = Nothing, HB.optionPPEm = Nothing + } + let font' = HB.createFontWithOptions fontOpts' $ HB.createFace bytes $ toEnum index let glyphs = map (codepoint . fst) $ shape font' defaultBuffer { HB.text = Txt.replicate (toEnum $ succ $ length sampleFeatures) sampleText @@ -145,17 +155,22 @@ makeDrawText lib filepath index fontsize SampleText {..} = do unless (null designCoords) $ liftFreetype $ ft_Set_Var_Design_Coordinates font designCoords - atlas <- allocAtlas (glyphRetriever font) glyphs' + atlas <- allocAtlas (glyphRetriever font) glyphs' scale liftFreetype $ ft_Done_Face font drawGlyphs <- makeDrawGlyphs - return $ freeAtlasWrapper atlas $ drawLinesWrapper tabwidth minLineHeight + return $ freeAtlasWrapper atlas $ drawLinesWrapper tabwidth lineHeight $ \RichText {..} -> drawGlyphs atlas $ shape font' defaultBuffer { HB.text = text } features where x2 = (*2) float2fixed :: Float -> FT_Fixed - float2fixed = toEnum . fromEnum . (*65536) + float2fixed = toEnum . fromEnum . (*bits16) + fixed2float :: FT_Fixed -> Float + fixed2float = (/bits16) . toEnum . fromEnum + bits16 = 2**16 + short2float :: FT_UShort -> Float + short2float = toEnum . fromEnum -- | Variant of `makeDrawText` which initializes FreeType itself. makeDrawText' a b c d = -- 2.30.2