From e75651a82ba9558f52c5cd37f5e3859f109a1ca3 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane <adrian@openwork.nz> Date: Wed, 2 Feb 2022 09:47:45 +1300 Subject: [PATCH] Upgrade API Usage, fixing build (#10) * Get Typograffiti to successfully compile by upgrading FreeType2 API usage * Upgrade SDL API usage by test program. Co-authored-by: Adrian Cochrane <alcinnz@VirtualBox-7e9ebd4b.localdomain> Co-authored-by: Adrian Cochrane <alcinnz@lavabit.com> --- app/Main.hs | 6 +-- src/Typograffiti/Atlas.hs | 41 +++++++++++-------- src/Typograffiti/Utils.hs | 86 +++++++++++++++++++++++++++------------ 3 files changed, 87 insertions(+), 46 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a307808..94091bc 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -58,9 +58,9 @@ main = do let openGL = defaultOpenGL { glProfile = Core Debug 3 3 } wcfg = defaultWindow - { windowInitialSize = V2 640 480 - , windowOpenGL = Just openGL - , windowResizable = True + { windowInitialSize = V2 640 480 + , windowGraphicsContext = OpenGLContext openGL + , windowResizable = True } w <- createWindow "Typograffiti" wcfg diff --git a/src/Typograffiti/Atlas.hs b/src/Typograffiti/Atlas.hs index c925473..edccf71 100644 --- a/src/Typograffiti/Atlas.hs +++ b/src/Typograffiti/Atlas.hs @@ -22,8 +22,11 @@ import qualified Data.Vector.Unboxed as UV import Foreign.Marshal.Utils (with) import Graphics.GL.Core32 import Graphics.GL.Types -import Graphics.Rendering.FreeType.Internal.Bitmap as BM -import Graphics.Rendering.FreeType.Internal.GlyphMetrics as GM +import FreeType.Core.Types as BM +import FreeType.Support.Bitmap as BM +import FreeType.Support.Bitmap.Internal as BM +--import Graphics.Rendering.FreeType.Internal.Bitmap as BM +--import Graphics.Rendering.FreeType.Internal.GlyphMetrics as GM import Linear import Typograffiti.GL @@ -95,11 +98,13 @@ measure fce maxw (prev, am@AM{..}) char -- https://www.freetype.org/freetype2/docs/tutorial/step1.html loadChar fce (fromIntegral $ fromEnum char) ft_LOAD_RENDER -- Get the glyph slot - slot <- liftIO $ peek $ glyph fce + fce' <- liftIO $ peek fce + let slot = frGlyph fce' -- Get the bitmap - bmp <- liftIO $ peek $ bitmap slot - let bw = fromIntegral $ BM.width bmp - bh = fromIntegral $ rows bmp + slot' <- liftIO $ peek slot + let bmp = gsrBitmap slot' + let bw = fromIntegral $ BM.bWidth bmp + bh = fromIntegral $ bRows bmp gotoNextRow = (x + bw + spacing) >= maxw rh = if gotoNextRow then 0 else max bh rowHeight nx = if gotoNextRow then 0 else x + bw + spacing @@ -119,28 +124,30 @@ texturize xymap atlas@Atlas{..} char -- Load the char loadChar atlasFontFace (fromIntegral $ fromEnum char) ft_LOAD_RENDER -- Get the slot and bitmap - slot <- liftIO $ peek $ glyph atlasFontFace - bmp <- liftIO $ peek $ bitmap slot + atlasFontFace' <- liftIO $ peek atlasFontFace + let slot = frGlyph atlasFontFace' + slot' <- liftIO $ peek slot + let bmp = gsrBitmap slot' -- Update our texture by adding the bitmap glTexSubImage2D GL_TEXTURE_2D 0 (fromIntegral x) (fromIntegral y) - (fromIntegral $ BM.width bmp) - (fromIntegral $ rows bmp) + (fromIntegral $ BM.bWidth bmp) + (fromIntegral $ bRows bmp) GL_RED GL_UNSIGNED_BYTE - (castPtr $ buffer bmp) + (castPtr $ bBuffer bmp) -- Get the glyph metrics - ftms <- liftIO $ peek $ metrics slot + let ftms = gsrMetrics slot' -- Add the metrics to the atlas - let vecwh = fromIntegral <$> V2 (BM.width bmp) (rows bmp) + let vecwh = fromIntegral <$> V2 (BM.bWidth bmp) (bRows bmp) canon = floor @Double @Int . (* 0.015625) . fromIntegral - vecsz = canon <$> V2 (GM.width ftms) (GM.height ftms) - vecxb = canon <$> V2 (horiBearingX ftms) (horiBearingY ftms) - vecyb = canon <$> V2 (vertBearingX ftms) (vertBearingY ftms) - vecad = canon <$> V2 (horiAdvance ftms) (vertAdvance ftms) + vecsz = canon <$> V2 (gmWidth ftms) (gmHeight ftms) + vecxb = canon <$> V2 (gmHoriBearingX ftms) (gmHoriBearingY ftms) + vecyb = canon <$> V2 (gmVertBearingX ftms) (gmVertBearingY ftms) + vecad = canon <$> V2 (gmHoriAdvance ftms) (gmVertAdvance ftms) mtrcs = GlyphMetrics { glyphTexBB = (pos, pos + vecwh) , glyphTexSize = vecwh , glyphSize = vecsz diff --git a/src/Typograffiti/Utils.hs b/src/Typograffiti/Utils.hs index 3524ca5..316b853 100644 --- a/src/Typograffiti/Utils.hs +++ b/src/Typograffiti/Utils.hs @@ -9,7 +9,7 @@ module Typograffiti.Utils ( , getLibrary , getKerning , glyphFormatString - , hasKerning +-- , hasKerning , loadChar , loadGlyph , newFace @@ -17,22 +17,23 @@ module Typograffiti.Utils ( , setPixelSizes , withFreeType , runFreeType + , ft_KERNING_DEFAULT, ft_KERNING_UNFITTED, ft_KERNING_UNSCALED + , ft_LOAD_DEFAULT, ft_LOAD_NO_SCALE, ft_LOAD_RENDER, ft_LOAD_NO_BITMAP, ft_LOAD_VERTICAL_LAYOUT + , ft_LOAD_FORCE_AUTOHINT, ft_LOAD_CROP_BITMAP, ft_LOAD_PEDANTIC, ft_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH + , ft_LOAD_NO_RECURSE, ft_LOAD_IGNORE_TRANSFORM, ft_LOAD_MONOCHROME, ft_LOAD_LINEAR_DESIGN + , ft_LOAD_NO_AUTOHINT, ft_LOAD_COLOR, ft_LOAD_COMPUTE_METRICS, ft_LOAD_BITMAP_METRICS_ONLY ) where import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Except import Control.Monad.State.Strict import Control.Monad (unless) -import Graphics.Rendering.FreeType.Internal as FT -import Graphics.Rendering.FreeType.Internal.PrimitiveTypes as FT -import Graphics.Rendering.FreeType.Internal.Library as FT -import Graphics.Rendering.FreeType.Internal.FaceType as FT -import Graphics.Rendering.FreeType.Internal.Face as FT hiding (generic) -import Graphics.Rendering.FreeType.Internal.GlyphSlot as FT -import Graphics.Rendering.FreeType.Internal.Bitmap as FT -import Graphics.Rendering.FreeType.Internal.Vector as FT +import FreeType.Core.Base as FT +import FreeType.Core.Base.Internal as FT +import FreeType.Core.Types as FT import Foreign as FT import Foreign.C.String as FT +import Unsafe.Coerce -- TODO: Tease out the correct way to handle errors. -- They're kinda thrown all willy nilly. @@ -42,12 +43,11 @@ type FreeTypeIO = FreeTypeT IO glyphFormatString :: FT_Glyph_Format -> String -glyphFormatString fmt - | fmt == ft_GLYPH_FORMAT_COMPOSITE = "ft_GLYPH_FORMAT_COMPOSITE" - | fmt == ft_GLYPH_FORMAT_OUTLINE = "ft_GLYPH_FORMAT_OUTLINE" - | fmt == ft_GLYPH_FORMAT_PLOTTER = "ft_GLYPH_FORMAT_PLOTTER" - | fmt == ft_GLYPH_FORMAT_BITMAP = "ft_GLYPH_FORMAT_BITMAP" - | otherwise = "ft_GLYPH_FORMAT_NONE" +glyphFormatString FT_GLYPH_FORMAT_COMPOSITE = "ft_GLYPH_FORMAT_COMPOSITE" +glyphFormatString FT_GLYPH_FORMAT_OUTLINE = "ft_GLYPH_FORMAT_OUTLINE" +glyphFormatString FT_GLYPH_FORMAT_PLOTTER = "ft_GLYPH_FORMAT_PLOTTER" +glyphFormatString FT_GLYPH_FORMAT_BITMAP = "ft_GLYPH_FORMAT_BITMAP" +glyphFormatString _ = "ft_GLYPH_FORMAT_NONE" liftE :: MonadIO m => String -> IO (Either FT_Error a) -> FreeTypeT m a @@ -65,7 +65,7 @@ runIOErr msg f = do runFreeType :: MonadIO m => FreeTypeT m a -> m (Either String (a, FT_Library)) runFreeType f = do (e,lib) <- liftIO $ alloca $ \p -> do - e <- ft_Init_FreeType p + e <- ft_Init_FreeType' p lib <- peek p return (e,lib) if e /= 0 @@ -89,40 +89,74 @@ newFace :: MonadIO m => FilePath -> FreeTypeT m FT_Face newFace fp = do ft <- lift get liftE "ft_New_Face" $ withCString fp $ \str -> - alloca $ \ptr -> ft_New_Face ft str 0 ptr >>= \case + alloca $ \ptr -> ft_New_Face' ft (unsafeCoerce str) 0 ptr >>= \case 0 -> Right <$> peek ptr e -> return $ Left e setCharSize :: (MonadIO m, Integral i) => FT_Face -> i -> i -> i -> i -> FreeTypeT m () setCharSize ff w h dpix dpiy = runIOErr "ft_Set_Char_Size" $ - ft_Set_Char_Size ff (fromIntegral w) (fromIntegral h) + ft_Set_Char_Size' ff (fromIntegral w) (fromIntegral h) (fromIntegral dpix) (fromIntegral dpiy) setPixelSizes :: (MonadIO m, Integral i) => FT_Face -> i -> i -> FreeTypeT m () setPixelSizes ff w h = - runIOErr "ft_Set_Pixel_Sizes" $ ft_Set_Pixel_Sizes ff (fromIntegral w) (fromIntegral h) + runIOErr "ft_Set_Pixel_Sizes" $ ft_Set_Pixel_Sizes' ff (fromIntegral w) (fromIntegral h) getCharIndex :: (MonadIO m, Integral i) => FT_Face -> i -> FreeTypeT m FT_UInt getCharIndex ff ndx = liftIO $ ft_Get_Char_Index ff $ fromIntegral ndx loadGlyph :: MonadIO m => FT_Face -> FT_UInt -> FT_Int32 -> FreeTypeT m () -loadGlyph ff fg flags = runIOErr "ft_Load_Glyph" $ ft_Load_Glyph ff fg flags +loadGlyph ff fg flags = runIOErr "ft_Load_Glyph" $ ft_Load_Glyph' ff fg flags loadChar :: MonadIO m => FT_Face -> FT_ULong -> FT_Int32 -> FreeTypeT m () -loadChar ff char flags = runIOErr "ft_Load_Char" $ ft_Load_Char ff char flags - -hasKerning :: MonadIO m => FT_Face -> FreeTypeT m Bool -hasKerning = liftIO . ft_HAS_KERNING +loadChar ff char flags = runIOErr "ft_Load_Char" $ ft_Load_Char' ff char flags + +--hasKerning :: MonadIO m => FT_Face -> FreeTypeT m Bool +--hasKerning = liftIO . ft_HAS_KERNING +--ft_HAS_KERNING FT_HAS_KERNING = return True +--ft_HAS_KERNING _ = return False + +-- Matching patterns defined in freetype2 module. +ft_KERNING_DEFAULT, ft_KERNING_UNFITTED, ft_KERNING_UNSCALED :: Word32 +ft_KERNING_DEFAULT = 0 +ft_KERNING_UNFITTED = 1 +ft_KERNING_UNSCALED = 2 + +ft_LOAD_DEFAULT, ft_LOAD_NO_SCALE, ft_LOAD_NO_HINTING, ft_LOAD_RENDER, + ft_LOAD_NO_BITMAP, ft_LOAD_VERTICAL_LAYOUT, ft_LOAD_FORCE_AUTOHINT, + ft_LOAD_CROP_BITMAP, ft_LOAD_PEDANTIC, ft_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH, + ft_LOAD_NO_RECURSE, ft_LOAD_IGNORE_TRANSFORM, ft_LOAD_MONOCHROME, + ft_LOAD_LINEAR_DESIGN, ft_LOAD_NO_AUTOHINT, ft_LOAD_COLOR, + ft_LOAD_COMPUTE_METRICS, ft_LOAD_BITMAP_METRICS_ONLY :: FT_Int32 +ft_LOAD_DEFAULT = 0 +ft_LOAD_NO_SCALE = 1 +ft_LOAD_NO_HINTING = 2 +ft_LOAD_RENDER = 4 +ft_LOAD_NO_BITMAP = 8 +ft_LOAD_VERTICAL_LAYOUT = 16 +ft_LOAD_FORCE_AUTOHINT = 32 +ft_LOAD_CROP_BITMAP = 64 +ft_LOAD_PEDANTIC = 128 +ft_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH = 512 +ft_LOAD_NO_RECURSE = 1024 +ft_LOAD_IGNORE_TRANSFORM = 2048 +ft_LOAD_MONOCHROME = 4096 +ft_LOAD_LINEAR_DESIGN = 8192 +ft_LOAD_NO_AUTOHINT = 32768 +ft_LOAD_COLOR = 1048576 +ft_LOAD_COMPUTE_METRICS = 2097152 +ft_LOAD_BITMAP_METRICS_ONLY = 4194304 getKerning :: MonadIO m => FT_Face -> FT_UInt -> FT_UInt -> FT_Kerning_Mode -> FreeTypeT m (Int,Int) getKerning ff prevNdx curNdx flags = liftE "ft_Get_Kerning" $ alloca $ \ptr -> - ft_Get_Kerning ff prevNdx curNdx (fromIntegral flags) ptr >>= \case + ft_Get_Kerning' ff prevNdx curNdx (fromIntegral flags) ptr >>= \case 0 -> do FT_Vector vx vy <- peek ptr return $ Right (fromIntegral vx, fromIntegral vy) e -> return $ Left e getAdvance :: MonadIO m => FT_GlyphSlot -> FreeTypeT m (Int,Int) getAdvance slot = do - FT_Vector vx vy <- liftIO $ peek $ advance slot + slot' <- liftIO $ peek slot + let FT_Vector vx vy = gsrAdvance slot' return (fromIntegral vx, fromIntegral vy) -- 2.30.2