3 files changed, 87 insertions(+), 46 deletions(-)

M app/Main.hs
M src/Typograffiti/Atlas.hs
M src/Typograffiti/Utils.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

@@ 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

@@ 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)