Add font utils (#56)

- clearFontAtlas
- addFontDefault
- addFontFromFileTTF
- addFontFromMemoryTTF (raw only)
- buildFontAtlas

Vulkan example updated to use on f the imgui-distributed ttf files.

examples/vulkan/Main.hs

@@ -83,6 +83,20 @@ type Handler    = LogMessage -> ResourceT IO ()
 deriving via ( ReaderT Handler (ResourceT IO) )
   instance MonadResource ( LoggingT LogMessage (ResourceT IO) )
 
+gui :: MonadIO m => m ImGui.DrawData
+gui = do
+  -- Prepare frame
+  ImGui.Vulkan.vulkanNewFrame
+  ImGui.SDL.sdl2NewFrame
+  ImGui.newFrame
+
+  -- Run your windows
+  ImGui.showDemoWindow
+
+  -- Process ImGui state into draw commands
+  ImGui.render
+  ImGui.getDrawData
+
 main :: IO ()
 main = runResourceT . ( `runLoggingT` logHandler ) $ app @( LoggingT LogMessage ( ResourceT IO ) )
 
@@ -120,6 +134,12 @@ app = do
     ImGui.createContext
     ImGui.destroyContext
 
+  logDebug "Adding fonts"
+  ImGui.clearFontAtlas
+  _default <- ImGui.addFontDefault
+  _custom <- ImGui.addFontFromFileTTF "imgui/misc/fonts/ProggyTiny.ttf" 10
+  ImGui.buildFontAtlas
+
   let
     preferredFormat :: Vulkan.SurfaceFormatKHR
     preferredFormat =
@@ -341,12 +361,6 @@ app = do
                 pure ( True, False )
               else
                 handleJust vulkanException ( pure . reloadQuit ) do
-                  ImGui.Vulkan.vulkanNewFrame
-                  ImGui.SDL.sdl2NewFrame
-                  ImGui.newFrame
-                  ImGui.showDemoWindow
-                  ImGui.render
-                  drawData <- ImGui.getDrawData
                   let
                     commandBuffer :: Vulkan.CommandBuffer
                     commandBuffer = commandBuffers Boxed.Vector.! fromIntegral nextImageIndex
@@ -355,7 +369,10 @@ app = do
                   Vulkan.resetCommandBuffer commandBuffer Vulkan.zero
                   beginCommandBuffer commandBuffer
                   cmdBeginRenderPass commandBuffer imGuiRenderPass framebuffer clearValues swapchainExtent
+
+                  drawData <- gui
                   ImGui.Vulkan.vulkanRenderDrawData drawData commandBuffer Nothing
+
                   cmdEndRenderPass commandBuffer
                   endCommandBuffer commandBuffer
                   submitCommandBuffer

src/DearImGui.hs

@@ -245,6 +245,13 @@ module DearImGui
   , Raw.wantCaptureMouse
   , Raw.wantCaptureKeyboard
 
+    -- * Fonts
+  , Raw.Font
+  , addFontFromFileTTF
+  , Raw.addFontDefault
+  , Raw.buildFontAtlas
+  , Raw.clearFontAtlas
+
     -- * Types
   , module DearImGui.Enums
   , module DearImGui.Structs
@@ -1664,3 +1671,22 @@ pushStyleVar style valRef = liftIO do
 popStyleVar :: (MonadIO m) => Int -> m ()
 popStyleVar n = liftIO do
   Raw.popStyleVar (fromIntegral n)
+
+
+-- | Load a font from TTF file.
+--
+-- Specify font path and atlas glyph size.
+--
+-- Use 'addFontDefault' if you want to retain built-in font too.
+--
+-- Call 'buildFontAtlas' after adding all the fonts.
+--
+-- Call backend-specific `CreateFontsTexture` before using 'newFrame'.
+addFontFromFileTTF :: MonadIO m => FilePath -> Float -> m (Maybe Raw.Font)
+addFontFromFileTTF font size = liftIO do
+  res@(Raw.Font ptr) <- withCString font \fontPtr ->
+    Raw.addFontFromFileTTF fontPtr (CFloat size)
+  pure $
+    if castPtr ptr == nullPtr
+      then Nothing
+      else Just res

src/DearImGui/Context.hs

@@ -34,5 +34,6 @@ imguiContext = mempty
       , ( TypeName "ImVec3", [t| ImVec3 |] )
       , ( TypeName "ImVec4", [t| ImVec4 |] )
       , ( TypeName "ImGuiContext", [t| ImGuiContext |] )
+      , ( TypeName "ImFont", [t| ImFont |] )
       ]
   }

src/DearImGui/Raw.hs

@@ -209,6 +209,14 @@ module DearImGui.Raw
   , wantCaptureMouse
   , wantCaptureKeyboard
 
+    -- * Fonts in default font atlas
+  , Font(..)
+  , addFontDefault
+  , addFontFromFileTTF
+  , addFontFromMemoryTTF
+  , buildFontAtlas
+  , clearFontAtlas
+
     -- * Types
   , module DearImGui.Enums
   , module DearImGui.Structs
@@ -1514,3 +1522,54 @@ wantCaptureMouse = liftIO do
 wantCaptureKeyboard :: MonadIO m => m Bool
 wantCaptureKeyboard = liftIO do
   (0 /=) <$> [C.exp| bool { GetIO().WantCaptureKeyboard } |]
+
+
+-- | Wraps @ImFont*@.
+newtype Font = Font (Ptr ImFont)
+
+addFontDefault :: MonadIO m => m Font
+addFontDefault = liftIO do
+  Font <$> [C.block|
+    ImFont* {
+      return GetIO().Fonts->AddFontDefault();
+    }
+  |]
+
+addFontFromFileTTF :: MonadIO m => CString -> CFloat -> m Font
+addFontFromFileTTF filenamePtr sizePixels = liftIO do
+  Font <$> [C.block|
+    ImFont* {
+      return GetIO().Fonts->AddFontFromFileTTF(
+        $(char* filenamePtr),
+        $(float sizePixels));
+    }
+  |]
+
+-- | Transfer a buffer with TTF data to font atlas builder.
+addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> m Font
+addFontFromMemoryTTF (castPtr -> fontDataPtr, fromIntegral -> fontSize) sizePixels = liftIO do
+  Font <$> [C.block|
+    ImFont* {
+      return GetIO().Fonts->AddFontFromMemoryTTF(
+        $(void* fontDataPtr),
+        $(int fontSize),
+        $(float sizePixels)
+      );
+    }
+  |]
+
+buildFontAtlas :: MonadIO m => m ()
+buildFontAtlas = liftIO do
+  [C.block|
+    void {
+      GetIO().Fonts->Build();
+    }
+  |]
+
+clearFontAtlas :: MonadIO m => m ()
+clearFontAtlas = liftIO do
+  [C.block|
+    void {
+      GetIO().Fonts->Clear();
+    }
+  |]

src/DearImGui/Structs.hs

@@ -74,3 +74,6 @@ instance Storable ImVec4 where
 
 -- | DearImGui context handle.
 data ImGuiContext
+
+-- | Individual font handle.
+data ImFont