diff --git a/dear-imgui.cabal b/dear-imgui.cabal index 8bd4f07..7e1662f 100644 --- a/dear-imgui.cabal +++ b/dear-imgui.cabal @@ -124,8 +124,12 @@ library src exposed-modules: DearImGui + DearImGui.FontAtlas DearImGui.Raw DearImGui.Raw.DrawList + DearImGui.Raw.Font + DearImGui.Raw.Font.Config + DearImGui.Raw.Font.GlyphRanges DearImGui.Raw.ListClipper DearImGui.Raw.IO other-modules: @@ -295,6 +299,14 @@ executable readme if (!flag(examples) || !flag(sdl) || !flag(opengl2)) buildable: False +executable fonts + import: common, build-flags + main-is: Main.hs + hs-source-dirs: examples/fonts + build-depends: sdl2, gl, dear-imgui, managed + if (!flag(examples) || !flag(sdl) || !flag(opengl2)) + buildable: False + executable image import: common, build-flags main-is: Image.hs diff --git a/examples/fonts/Main.hs b/examples/fonts/Main.hs new file mode 100644 index 0000000..02a184c --- /dev/null +++ b/examples/fonts/Main.hs @@ -0,0 +1,150 @@ +{-# language BlockArguments #-} +{-# language LambdaCase #-} +{-# language OverloadedStrings #-} +{-# language RecordWildCards #-} +{-# language NamedFieldPuns #-} +{-# language DeriveTraversable #-} + +{- | Font usage example. + +Loads two non-standard fonts + +This example uses NotoSansJP-Regular.otf from Google Fonts +Licensed under the SIL Open Font License, Version 1.1 +https://fonts.google.com/noto/specimen/Noto+Sans+JP +-} + +module Main ( main ) where + +import Control.Exception +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Managed +import Data.IORef +import DearImGui +import qualified DearImGui.FontAtlas as FontAtlas +import DearImGui.OpenGL2 +import DearImGui.SDL +import DearImGui.SDL.OpenGL +import Graphics.GL +import SDL + +-- Rebuild syntax enables us to keep fonts in any +-- traversable type, so let's make our life a little easier. +-- But feel free to use lists or maps. +data FontSet a = FontSet + { droidFont :: a + , defaultFont :: a + , notoFont :: a + } + deriving (Functor, Foldable, Traversable) + +main :: IO () +main = do + -- Window initialization is similar to another examples. + initializeAll + runManaged do + window <- do + let title = "Hello, Dear ImGui!" + let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL } + managed $ bracket (createWindow title config) destroyWindow + glContext <- managed $ bracket (glCreateContext window) glDeleteContext + _ <- managed $ bracket createContext destroyContext + _ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown + _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown + + -- We use high-level syntax to build font atlas and + -- get handles to use in the main loop. + fontSet <- FontAtlas.rebuild FontSet + { -- The first mentioned font is loaded first + -- and set as a global default. + droidFont = + FontAtlas.FromTTF + "./imgui/misc/fonts/DroidSans.ttf" + 15 + Nothing + FontAtlas.Cyrillic + + -- You also may use a default hardcoded font for + -- some purposes (i.e. as fallback) + , defaultFont = + FontAtlas.DefaultFont + + -- To optimize atlas size, use ranges builder and + -- provide source localization data. + , notoFont = + FontAtlas.FromTTF + "./examples/fonts/NotoSansJP-Regular.otf" + 20 + Nothing + ( FontAtlas.RangesBuilder $ mconcat + [ FontAtlas.addRanges FontAtlas.Latin + , FontAtlas.addText "私をクリックしてください" + , FontAtlas.addText "こんにちは" + ] + ) + } + + liftIO $ do + fontFlag <- newIORef False + mainLoop window do + let FontSet{..} = fontSet + withWindowOpen "Hello, ImGui!" do + -- To use a font for widget text, you may either put it + -- into a 'withFont' block: + withFont defaultFont do + text "Hello, ImGui!" + + text "Привет, ImGui!" + + -- ...or you can explicitly push and pop a font. + -- Though it's not recommended. + toggled <- readIORef fontFlag + + when toggled $ + pushFont notoFont + + -- Some of those are only present in Noto font range + -- and will render as `?`s. + text "こんにちは, ImGui!" + + let buttonText = if toggled then "私をクリックしてください" else "Click Me!" + button buttonText >>= \clicked -> + when clicked $ + modifyIORef' fontFlag not + + when toggled + popFont + + showDemoWindow + +mainLoop :: Window -> IO () -> IO () +mainLoop window frameAction = loop + where + loop = unlessQuit do + openGL2NewFrame + sdl2NewFrame + newFrame + + frameAction + + glClear GL_COLOR_BUFFER_BIT + render + openGL2RenderDrawData =<< getDrawData + glSwapWindow window + + loop + + unlessQuit action = do + shouldQuit <- checkEvents + if shouldQuit then pure () else action + + checkEvents = do + pollEventWithImGui >>= \case + Nothing -> + return False + Just event -> + (isQuit event ||) <$> checkEvents + + isQuit event = + SDL.eventPayload event == SDL.QuitEvent diff --git a/examples/fonts/NotoSansJP-Regular.otf b/examples/fonts/NotoSansJP-Regular.otf new file mode 100644 index 0000000..5791298 Binary files /dev/null and b/examples/fonts/NotoSansJP-Regular.otf differ diff --git a/examples/vulkan/Main.hs b/examples/vulkan/Main.hs index 0f9dd2a..1fafa47 100644 --- a/examples/vulkan/Main.hs +++ b/examples/vulkan/Main.hs @@ -134,12 +134,6 @@ 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 = diff --git a/src/DearImGui.hs b/src/DearImGui.hs index c2f8955..45a4133 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -86,6 +86,11 @@ module DearImGui , pushStyleVar , popStyleVar + , withFont + , Raw.Font.pushFont + , Raw.Font.popFont + , Raw.Font.Font + -- * Cursor/Layout , Raw.separator , Raw.sameLine @@ -247,13 +252,6 @@ module DearImGui , Raw.wantCaptureMouse , Raw.wantCaptureKeyboard - -- * Fonts - , Raw.Font - , addFontFromFileTTF - , Raw.addFontDefault - , Raw.buildFontAtlas - , Raw.clearFontAtlas - -- * Utilities -- ** ListClipper @@ -287,6 +285,9 @@ import System.IO -- dear-imgui import DearImGui.Enums import DearImGui.Structs +import qualified DearImGui.Raw as Raw +import qualified DearImGui.Raw.Font as Raw.Font +import qualified DearImGui.Raw.ListClipper as Raw.ListClipper -- managed import qualified Control.Monad.Managed as Managed @@ -303,9 +304,6 @@ import Control.Monad.IO.Class import UnliftIO (MonadUnliftIO) import UnliftIO.Exception (bracket, bracket_) -import qualified DearImGui.Raw as Raw -import qualified DearImGui.Raw.ListClipper as Raw.ListClipper - -- vector import qualified Data.Vector as V import qualified Data.Vector.Storable as VS @@ -1691,24 +1689,9 @@ 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 +-- | Render widgets inside the block using provided font. +withFont :: MonadUnliftIO m => Raw.Font.Font -> m a -> m a +withFont font = bracket_ (Raw.Font.pushFont font) Raw.Font.popFont -- | Clips a large list of items -- diff --git a/src/DearImGui/Context.hs b/src/DearImGui/Context.hs index 73e9068..1c91a60 100644 --- a/src/DearImGui/Context.hs +++ b/src/DearImGui/Context.hs @@ -34,9 +34,12 @@ imguiContext = mempty , ( TypeName "ImVec3", [t| ImVec3 |] ) , ( TypeName "ImVec4", [t| ImVec4 |] ) , ( TypeName "ImU32", [t| ImU32 |] ) + , ( TypeName "ImWchar", [t| ImWchar |] ) , ( TypeName "ImDrawList", [t| ImDrawList |] ) , ( TypeName "ImGuiContext", [t| ImGuiContext |] ) , ( TypeName "ImFont", [t| ImFont |] ) + , ( TypeName "ImFontConfig", [t| ImFontConfig |] ) + , ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] ) , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] ) ] } diff --git a/src/DearImGui/FontAtlas.hs b/src/DearImGui/FontAtlas.hs new file mode 100644 index 0000000..5f51f2e --- /dev/null +++ b/src/DearImGui/FontAtlas.hs @@ -0,0 +1,501 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGui.FontAtlas + +Font atlas builder, accompanied with lower-level functions. + +@ +import qualified DearImGui.FontAtlas as FontAtlas + +prepareAtlas = + FontAtlas.rebuild + [ FontAtlas.FileTTF "comic-sans-mono.ttf" 13 csOptions csRanges + , FontAtlas.Default + ] + where + csOptions = mconcat + [ FontAtlas.fontNo 1 + , FontAtlas.glyphOffset (0, -1) + ] + + csRanges = RangeBuilder $ mconcat + [ FontAtlas.addText "Hello world" + , FontRanges.addChar 'Ꙑ' + , FontRanges.addRanges FontRanges.Korean + ] +@ + +-} + +module DearImGui.FontAtlas + ( -- * Main types + Raw.Font(..) + , FontSource(..) + -- * Building atlas + , rebuild + -- ** Configuring sources + , ConfigSetup(..) + , fontDataOwnedByAtlas + , fontNo + , sizePixels + , oversampleH + , oversampleV + , pixelSnapH + , glyphExtraSpacing + , glyphOffset + , glyphRanges + , glyphMinAdvanceX + , glyphMaxAdvanceX + , mergeMode + , fontBuilderFlags + , rasterizerMultiply + , ellipsisChar + + -- ** Configuring ranges + , Ranges(..) + , RangesBuilderSetup(..) + , addChar + , addText + , addRanges + , addRangesRaw + + , pattern Latin + , pattern Korean + , pattern Japanese + , pattern ChineseFull + , pattern ChineseSimplifiedCommon + , pattern Cyrillic + , pattern Thai + , pattern Vietnamese + + -- * Lower level types and functions + -- , Raw.FontConfig(..) + -- , Raw.GlyphRanges(..) + , build + , clear + , setupFont + , setupRanges + , withRanges + , withConfig + , addFontFromFileTTF + , addFontFromFileTTF_ + ) + where + +-- base +import Data.Bool (bool) +import Data.Maybe (fromMaybe) +import Foreign +import Foreign.C + +-- transformers +import Control.Monad.IO.Class + ( MonadIO, liftIO ) + +-- managed +import Control.Monad.Managed + ( MonadManaged, managed ) +import qualified Control.Monad.Managed as Managed + +-- unlift +import UnliftIO (MonadUnliftIO) +import UnliftIO.Exception (bracket) + +-- dear-imgui +import DearImGui.Raw.Font (Font(..)) +import qualified DearImGui.Raw.Font as Raw +import DearImGui.Raw.Font.Config (FontConfig(..)) +import qualified DearImGui.Raw.Font.Config as FontConfig +import DearImGui.Raw.Font.GlyphRanges (GlyphRanges(..), GlyphRangesBuilder(..)) +import qualified DearImGui.Raw.Font.GlyphRanges as GlyphRanges + +import DearImGui.Structs (ImVec2(..), ImWchar) + +-- | Font setup data +data FontSource + = DefaultFont + | FromTTF FilePath Float (Maybe ConfigSetup) Ranges + -- TODO: FromMemory + +-- | Font config monoid interface to be used in 'FontSource'. +-- +-- @ +-- mergeMode True <> fontNo 1 +-- @ +newtype ConfigSetup = ConfigSetup + { applyToConfig :: FontConfig -> IO () + } + +instance Semigroup ConfigSetup where + ConfigSetup f <> ConfigSetup g = + ConfigSetup \fc -> f fc >> g fc +instance Monoid ConfigSetup where + mempty = ConfigSetup (const mempty) + +-- | Glyph ranges settings, from presets to builder configuration. +data Ranges + = RangesRaw GlyphRanges + | RangesBuiltin GlyphRanges.Builtin + | RangesBuilder RangesBuilderSetup + +-- | Basic Latin, Extended Latin +pattern Latin :: Ranges +pattern Latin = RangesBuiltin GlyphRanges.Latin + +-- | Default + Korean characters +pattern Korean :: Ranges +pattern Korean = RangesBuiltin GlyphRanges.Korean + +-- | Default + Hiragana, Katakana, Half-Width, Selection of 2999 Ideographs +pattern Japanese :: Ranges +pattern Japanese = RangesBuiltin GlyphRanges.Japanese + +-- | Default + Half-Width + Japanese Hiragana/Katakana + full set of about 21000 CJK Unified Ideographs +pattern ChineseFull :: Ranges +pattern ChineseFull = RangesBuiltin GlyphRanges.ChineseFull + +-- | Default + Half-Width + Japanese Hiragana/Katakana + set of 2500 CJK Unified Ideographs for common simplified Chinese +pattern ChineseSimplifiedCommon :: Ranges +pattern ChineseSimplifiedCommon = RangesBuiltin GlyphRanges.ChineseSimplifiedCommon + +-- | Default + about 400 Cyrillic characters +pattern Cyrillic :: Ranges +pattern Cyrillic = RangesBuiltin GlyphRanges.Cyrillic + +-- | Default + Thai characters +pattern Thai :: Ranges +pattern Thai = RangesBuiltin GlyphRanges.Thai + +-- | Default + Vietnamese characters +pattern Vietnamese :: Ranges +pattern Vietnamese = RangesBuiltin GlyphRanges.Vietnamese + + +-- | Ranges builder monoid interface to be executed through 'buildRanges'. +-- +-- @ +-- addRanges FontRanges.DefaultRanges <> addText "Привет" +-- @ +newtype RangesBuilderSetup = RangesBuilderSetup + { applyToBuilder :: GlyphRangesBuilder -> IO () + } + +instance Semigroup RangesBuilderSetup where + RangesBuilderSetup f <> RangesBuilderSetup g = + RangesBuilderSetup \fc -> f fc >> g fc + +instance Monoid RangesBuilderSetup where + mempty = RangesBuilderSetup (const mempty) + +-- | Rebuild font atlas with provided configuration +-- and return corresponding structure of font handles +-- to be used with 'withFont'. +-- +-- Accepts any 'Traversable' instance, so you are free to use +-- lists, maps or custom structures. +rebuild :: (MonadIO m, Traversable t) => t FontSource -> m (t Font) +rebuild sources = liftIO $ Managed.with action pure + where + action = do + clear + fonts <- traverse setupFont sources + build + return fonts + +-- | Reset font atlas, clearing internal data +-- +-- Alias for 'Raw.clearFontAtlas' +clear :: (MonadIO m) => m () +clear = Raw.clearFontAtlas + +-- | Build font atlas +-- +-- Alias for 'Raw.buildFontAtlas' +build :: (MonadIO m) => m () +build = Raw.buildFontAtlas + +-- | Load a font from TTF file. +-- +-- Specify font path and atlas glyph size. +-- +-- Use 'Raw.addFontDefault' if you want to retain built-in font too. +-- +-- Call 'build' after adding all the fonts, +-- particularly if you're loading them from memory or use custom glyphs. +-- Or stick to `rebuild` function. +-- +-- Call backend-specific `CreateFontsTexture` before using 'newFrame'. +addFontFromFileTTF :: MonadIO m + => FilePath -- ^ Font file path + -> Float -- ^ Font size in pixels + -> Maybe FontConfig -- ^ Configuration data + -> Maybe GlyphRanges -- ^ Glyph ranges to use + -> m (Maybe Font) -- ^ Returns font handle, if added successfully +addFontFromFileTTF font size config ranges = liftIO do + res@(Font ptr) <- withCString font \fontPtr -> + Raw.addFontFromFileTTF + fontPtr + (CFloat size) + (fromMaybe (FontConfig nullPtr) config) + (fromMaybe (GlyphRanges nullPtr) ranges) + pure $ + if castPtr ptr == nullPtr + then Nothing + else Just res + -- FIXME: turn off asserts, so it would work + +addFontFromFileTTF_ :: MonadIO m + => FilePath -- ^ Font file path + -> Float -- ^ Font size in pixels + -> m (Maybe Raw.Font) -- ^ Returns font handle, if added successfully +addFontFromFileTTF_ font size = + addFontFromFileTTF font size Nothing Nothing + +-- | Load a font with provided configuration, return its handle +-- and defer range builder and config destructors, if needed. +setupFont :: (MonadManaged m) => FontSource -> m Font +setupFont = \case + DefaultFont -> + Raw.addFontDefault + FromTTF path size configSetup ranges -> do + glyphRanges' <- setupRanges ranges + config <- managed (withConfig configSetup) + mFont <- addFontFromFileTTF path size config glyphRanges' + case mFont of + Nothing -> + liftIO . fail $ "Couldn't load font from " <> path + Just font -> + pure font + +-- | Configure glyph ranges with provided configuration, return a handle +-- and defer builder destructors, if needed. +setupRanges :: (MonadManaged m) => Ranges -> m (Maybe GlyphRanges) +setupRanges = \case + RangesRaw ranges -> + pure $ Just ranges + RangesBuiltin builtin -> + pure $ GlyphRanges.builtinSetup builtin + RangesBuilder settings -> do + built <- managed $ withRanges settings + pure $ Just built + +-- | Perform glyph ranges build based on provided configuration, +-- and execute a computation with built glyph ranges. +withRanges :: (MonadUnliftIO m) => RangesBuilderSetup -> (GlyphRanges -> m a) -> m a +withRanges (RangesBuilderSetup setup) fn = + bracket acquire release execute + where + acquire = do + builder <- GlyphRanges.new + liftIO $ setup builder + rangesVec <- GlyphRanges.buildRangesVector builder + return (rangesVec, builder) + + release (rangesVec, builder) = do + GlyphRanges.destroyRangesVector rangesVec + GlyphRanges.destroy builder + + execute (rangesVec, _) = + fn (GlyphRanges.fromRangesVector rangesVec) + +-- | Configure font config with provided setup, +-- and execute a computation with built object. +-- return its handle and list of resource destructors. +withConfig :: (MonadUnliftIO m) => Maybe ConfigSetup -> (Maybe FontConfig -> m a) -> m a +withConfig mSetup action = + case mSetup of + Nothing -> + action Nothing + Just (ConfigSetup setup) -> + bracket acquire (FontConfig.destroy) (action . Just) + where + acquire = do + config <- FontConfig.new + liftIO $ setup config + return config + +-- | Single Unicode character +addChar :: ImWchar -> RangesBuilderSetup +addChar char = + RangesBuilderSetup \builder -> + GlyphRanges.addChar builder char + +-- | UTF-8 string +addText :: String -> RangesBuilderSetup +addText str = + RangesBuilderSetup \builder -> + withCString str (GlyphRanges.addText builder) + +-- | Existing ranges (as is) +addRangesRaw :: GlyphRanges -> RangesBuilderSetup +addRangesRaw ranges = + RangesBuilderSetup \builder -> + GlyphRanges.addRanges builder ranges + +-- | Existing ranges (through settings interface) +addRanges :: Ranges -> RangesBuilderSetup +addRanges = \case + RangesRaw ranges -> + addRangesRaw ranges + RangesBuilder settings -> + settings + RangesBuiltin builtin -> + addRangesRaw (GlyphRanges.getBuiltin builtin) + +-- | TTF/OTF data ownership taken by the container ImFontAtlas (will delete memory itself). +-- +-- By default, it is @true@ +fontDataOwnedByAtlas :: Bool -> ConfigSetup +fontDataOwnedByAtlas value = + ConfigSetup \fc -> + FontConfig.setFontDataOwnedByAtlas fc (bool 0 1 value) + +-- | Index of font within TTF/OTF file. +-- +-- By default, it is @0@ +fontNo :: Int -> ConfigSetup +fontNo value = + ConfigSetup \fc -> + FontConfig.setFontNo fc (fromIntegral value) + +-- | Size in pixels for rasterizer +-- +-- More or less maps to the resulting font height. +-- +-- Implicitly set by @addFont...@ functions. +sizePixels :: Float -> ConfigSetup +sizePixels value = + ConfigSetup \fc -> + FontConfig.setSizePixels fc (CFloat value) + +-- | Rasterize at higher quality for sub-pixel positioning. +-- +-- Note: the difference between 2 and 3 is minimal so you can reduce this to 2 to save memory. +-- Read https://github.com/nothings/stb/blob/master/tests/oversample/README.md for details. +-- +-- By default, it is @3@ +oversampleH :: Int -> ConfigSetup +oversampleH value = + ConfigSetup \fc -> + FontConfig.setOversampleH fc (fromIntegral value) + +-- | Rasterize at higher quality for sub-pixel positioning. +-- +-- This is not really useful as we don't use sub-pixel positions on the Y axis. +-- +-- By default, it is @1@ +oversampleV :: Int -> ConfigSetup +oversampleV value = + ConfigSetup \fc -> + FontConfig.setOversampleV fc (fromIntegral value) + +-- | Align every glyph to pixel boundary. +-- +-- Useful if you are merging a non-pixel aligned font with the default font. +-- If enabled, you can set OversampleH/V to 1. +-- +-- By default, it is @false@ +pixelSnapH :: Bool -> ConfigSetup +pixelSnapH value = + ConfigSetup \fc -> + FontConfig.setPixelSnapH fc (bool 0 1 value) + +-- | Extra spacing (in pixels) between glyphs. +-- +-- Only X axis is supported for now. +-- +-- By default, it is @0, 0@ +glyphExtraSpacing :: (Float, Float) -> ConfigSetup +glyphExtraSpacing (x, y) = + ConfigSetup \fc -> + Foreign.with (ImVec2 x y) (FontConfig.setGlyphExtraSpacing fc) + +-- | Offset all glyphs from this font input. +-- +-- By default, it is @0, 0@ +glyphOffset :: (Float, Float) -> ConfigSetup +glyphOffset (x, y) = + ConfigSetup \fc -> + Foreign.with (ImVec2 x y) (FontConfig.setGlyphOffset fc) + +-- | Pointer to a user-provided list of Unicode range. +-- +-- 2 values per range, inclusive. Zero-terminated list. +-- +-- THE ARRAY DATA NEEDS TO PERSIST AS LONG AS THE FONT IS ALIVE. +-- +-- By default, it is @NULL@ +glyphRanges :: GlyphRanges -> ConfigSetup +glyphRanges value = + ConfigSetup \fc -> + FontConfig.setGlyphRanges fc value + +-- | Minimum AdvanceX for glyphs. +-- +-- Set Min to align font icons, set both Min/Max to enforce mono-space font. +-- +-- By default, it is @0@ +glyphMinAdvanceX :: Float -> ConfigSetup +glyphMinAdvanceX value = + ConfigSetup \fc -> + FontConfig.setGlyphMinAdvanceX fc (CFloat value) + +-- | Maximum AdvanceX for glyphs. +-- +-- By default, it is @FLT_MAX@. +glyphMaxAdvanceX :: Float -> ConfigSetup +glyphMaxAdvanceX value = + ConfigSetup \fc -> + FontConfig.setGlyphMaxAdvanceX fc (CFloat value) + +-- | Merge into previous ImFont, so you can combine multiple inputs font into one ImFont. +-- +-- e.g. ASCII font + icons + Japanese glyphs. +-- You may want to use @GlyphOffset.y@ when merging font of different heights. +-- +-- By default, it is @false@ +mergeMode :: Bool -> ConfigSetup +mergeMode value = + ConfigSetup \fc -> + FontConfig.setMergeMode fc (bool 0 1 value) + +-- | Settings for custom font GlyphRanges. +-- +-- THIS IS BUILDER IMPLEMENTATION DEPENDENT. +-- +-- By default, it is @0@. Leave it so if unsure. +fontBuilderFlags :: Int -> ConfigSetup +fontBuilderFlags value = + ConfigSetup \fc -> + FontConfig.setFontBuilderFlags fc (fromIntegral value) + +-- | Brighten (>1.0f) or darken (<1.0f) font output. +-- +-- Brightening small fonts may be a good workaround to make them more readable. +-- +-- By default, it is @1.0f@. +rasterizerMultiply :: Float -> ConfigSetup +rasterizerMultiply value = + ConfigSetup \fc -> + FontConfig.setRasterizerMultiply fc (CFloat value) + +-- | Explicitly specify unicode codepoint of ellipsis character. +-- +-- When fonts are being merged first specified ellipsis will be used. +-- +-- By default, it is @-1@ +ellipsisChar :: ImWchar -> ConfigSetup +ellipsisChar value = + ConfigSetup \fc -> + FontConfig.setEllipsisChar fc value diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs index 436afec..66ca8f9 100644 --- a/src/DearImGui/Raw.hs +++ b/src/DearImGui/Raw.hs @@ -211,14 +211,6 @@ module DearImGui.Raw , wantCaptureMouse , wantCaptureKeyboard - -- * Fonts in default font atlas - , Font(..) - , addFontDefault - , addFontFromFileTTF - , addFontFromMemoryTTF - , buildFontAtlas - , clearFontAtlas - -- * Utilities -- ** Miscellaneous @@ -1563,58 +1555,6 @@ 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(); - } - |] - - -- | This draw list will be the first rendering one. -- -- Useful to quickly draw shapes/text behind dear imgui contents. diff --git a/src/DearImGui/Raw/Font.hs b/src/DearImGui/Raw/Font.hs new file mode 100644 index 0000000..e6cde97 --- /dev/null +++ b/src/DearImGui/Raw/Font.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + + +{-| Fonts + +It includes default atlas management, font configuration and glyph ranges. + +-} + +module DearImGui.Raw.Font + ( -- * Types + Font(..) + , GlyphRanges(..) + -- * Adding fonts + , addFontDefault + , addFontFromFileTTF + , addFontFromMemoryTTF + -- * Using fonts + , pushFont + , popFont + + -- * Atlas management + , clearFontAtlas + , buildFontAtlas + ) + where + +-- base +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign ( Ptr, castPtr ) +import Foreign.C + +-- dear-imgui +import DearImGui.Context + ( imguiContext ) +import DearImGui.Structs +import DearImGui.Raw.Font.Config + ( FontConfig(..) ) +import DearImGui.Raw.Font.GlyphRanges + ( GlyphRanges(..) ) + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext) +C.include "imgui.h" +Cpp.using "namespace ImGui" + + +-- | Font runtime data handle +-- +-- Wraps @ImFont*@. +newtype Font = Font (Ptr ImFont) + +-- | Add the default font (@ProggyClean.ttf@, 13 px) to the atlas. +addFontDefault :: MonadIO m + => m Font -- ^ Returns font handle for future usage +addFontDefault = liftIO do + Font <$> [C.block| + ImFont* { + return GetIO().Fonts->AddFontDefault(); + } + |] + +-- | Add a custom OTF/TTF font from a file. +addFontFromFileTTF :: MonadIO m + => CString -- ^ Font file path + -> CFloat -- ^ Font size in pixels + -> FontConfig -- ^ Configuration data + -> GlyphRanges -- ^ Glyph ranges to use + -> m Font -- ^ Returns font handle for future usage +addFontFromFileTTF filenamePtr sizePixels (FontConfig fontConfig) (GlyphRanges glyphRanges) = liftIO do + Font <$> [C.block| + ImFont* { + return GetIO().Fonts->AddFontFromFileTTF( + $(char* filenamePtr), + $(float sizePixels), + $(ImFontConfig* fontConfig), + $(ImWchar* glyphRanges)); + } + |] + +-- | Transfer a buffer with TTF data to font atlas builder. +addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> FontConfig -> GlyphRanges -> m Font +addFontFromMemoryTTF (castPtr -> fontDataPtr, fromIntegral -> fontSize) sizePixels (FontConfig fontConfig) (GlyphRanges glyphRanges) = liftIO do + Font <$> [C.block| + ImFont* { + return GetIO().Fonts->AddFontFromMemoryTTF( + $(void* fontDataPtr), + $(int fontSize), + $(float sizePixels), + $(ImFontConfig* fontConfig), + $(ImWchar* glyphRanges) + ); + } + |] + + +-- | Pushes a font into the parameters stack, +-- so ImGui would render following text using it. +pushFont :: MonadIO m => Font -> m () +pushFont (Font font) = liftIO do + [C.exp| void { PushFont($(ImFont* font)); } |] + +-- | Pops a font pushed into the parameters stack +-- +-- Should be called only after a corresponding 'pushFont' call. +popFont :: MonadIO m => m () +popFont = liftIO do + [C.exp| void { PopFont(); } |] + +-- | Explicitly build pixels data for the atlas. +buildFontAtlas :: MonadIO m => m () +buildFontAtlas = liftIO do + [C.block| + void { + GetIO().Fonts->Build(); + } + |] + +-- | Clear all font atlas input and output data +clearFontAtlas :: MonadIO m => m () +clearFontAtlas = liftIO do + [C.block| + void { + GetIO().Fonts->Clear(); + } + |] diff --git a/src/DearImGui/Raw/Font/Config.hs b/src/DearImGui/Raw/Font/Config.hs new file mode 100644 index 0000000..cefaa50 --- /dev/null +++ b/src/DearImGui/Raw/Font/Config.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + + +{-| Font configuration + +IO functions to modify font config values. + +-} + +module DearImGui.Raw.Font.Config + ( FontConfig(..) + , new + , destroy + -- * Changing settings + , setFontDataOwnedByAtlas + , setFontNo + , setSizePixels + , setOversampleH + , setOversampleV + , setPixelSnapH + , setGlyphExtraSpacing + , setGlyphOffset + , setGlyphRanges + , setGlyphMinAdvanceX + , setGlyphMaxAdvanceX + , setMergeMode + , setFontBuilderFlags + , setRasterizerMultiply + , setEllipsisChar + ) + where + +-- base +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign ( Ptr ) +import Foreign.C + +-- dear-imgui +import DearImGui.Context + ( imguiContext ) +import DearImGui.Structs +import DearImGui.Raw.Font.GlyphRanges + ( GlyphRanges(..) ) + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext) +C.include "imgui.h" +Cpp.using "namespace ImGui" + +-- | Font configuration data handle +-- +-- Wraps @ImFontConfig*@. +newtype FontConfig = FontConfig (Ptr ImFontConfig) + +-- | Create an instance of config +new :: MonadIO m => m FontConfig +new = liftIO do + FontConfig <$> [C.block| + ImFontConfig* { + return IM_NEW(ImFontConfig); + } + |] + +-- | Destroy an instance of config +-- +-- Should be used __after__ font atlas building. +destroy :: MonadIO m => FontConfig -> m () +destroy (FontConfig config) = liftIO do + [C.block| + void { + IM_DELETE($(ImFontConfig* config)); + } + |] + + +-- | TTF/OTF data ownership taken by the container ImFontAtlas (will delete memory itself). +-- +-- By default, it is @true@ +setFontDataOwnedByAtlas :: MonadIO m => FontConfig -> CBool -> m () +setFontDataOwnedByAtlas (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->FontDataOwnedByAtlas = $(bool value); + } + |] + +-- | Index of font within TTF/OTF file +-- +-- By default, it is @0@ +setFontNo :: MonadIO m => FontConfig -> CInt -> m () +setFontNo (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->FontNo = $(int value); + } + |] + +-- | Size in pixels for rasterizer (more or less maps to the resulting font height). +-- +-- Implicitly set by @addFont...@ functions. +setSizePixels :: MonadIO m => FontConfig -> CFloat -> m () +setSizePixels (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->SizePixels = $(float value); + } + |] + +-- | Rasterize at higher quality for sub-pixel positioning. Note the difference between 2 and 3 is minimal so you can reduce this to 2 to save memory. Read https://github.com/nothings/stb/blob/master/tests/oversample/README.md for details. +-- +-- By default, it is @3@ +setOversampleH :: MonadIO m => FontConfig -> CInt -> m () +setOversampleH (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->OversampleH = $(int value); + } + |] + +-- | Rasterize at higher quality for sub-pixel positioning. This is not really useful as we don't use sub-pixel positions on the Y axis. +-- +-- By default, it is @1@ +setOversampleV :: MonadIO m => FontConfig -> CInt -> m () +setOversampleV (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->OversampleV = $(int value); + } + |] + +-- | Align every glyph to pixel boundary. Useful e.g. if you are merging a non-pixel aligned font with the default font. If enabled, you can set OversampleH/V to 1. +-- +-- By default, it is @false@ +setPixelSnapH :: MonadIO m => FontConfig -> CBool -> m () +setPixelSnapH (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->PixelSnapH = $(bool value); + } + |] + +-- | Extra spacing (in pixels) between glyphs. Only X axis is supported for now. +-- +-- By default, it is @0, 0@ +setGlyphExtraSpacing :: MonadIO m => FontConfig -> Ptr ImVec2 -> m () +setGlyphExtraSpacing (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->GlyphExtraSpacing = *$(ImVec2* value); + } + |] + +-- | Offset all glyphs from this font input. +-- +-- By default, it is @0, 0@ +setGlyphOffset :: MonadIO m => FontConfig -> Ptr ImVec2 -> m () +setGlyphOffset (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->GlyphOffset = *$(ImVec2* value); + } + |] + +-- | Pointer to a user-provided list of Unicode range (2 value per range, values are inclusive, zero-terminated list). THE ARRAY DATA NEEDS TO PERSIST AS LONG AS THE FONT IS ALIVE. +-- +-- By default, it is @NULL@ +setGlyphRanges :: MonadIO m => FontConfig -> GlyphRanges -> m () +setGlyphRanges (FontConfig fc) (GlyphRanges value) = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->GlyphRanges = $(ImWchar* value); + } + |] + +-- | Minimum AdvanceX for glyphs, set Min to align font icons, set both Min/Max to enforce mono-space font +-- +-- By default, it is @0@ +setGlyphMinAdvanceX :: MonadIO m => FontConfig -> CFloat -> m () +setGlyphMinAdvanceX (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->GlyphMinAdvanceX = $(float value); + } + |] + +-- | Maximum AdvanceX for glyphs +-- +-- By default, it is @FLT_MAX@ +setGlyphMaxAdvanceX :: MonadIO m => FontConfig -> CFloat -> m () +setGlyphMaxAdvanceX (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->GlyphMaxAdvanceX = $(float value); + } + |] + +-- | Merge into previous ImFont, so you can combine multiple inputs font into one ImFont (e.g. ASCII font + icons + Japanese glyphs). You may want to use GlyphOffset.y when merge font of different heights. +-- +-- By default, it is @false@ +setMergeMode :: MonadIO m => FontConfig -> CBool -> m () +setMergeMode (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->MergeMode = $(bool value); + } + |] + +-- | Settings for custom font builder. +-- THIS IS BUILDER IMPLEMENTATION DEPENDENT. +-- +-- By default, it is @0@. Leave it so if unsure. +setFontBuilderFlags :: MonadIO m => FontConfig -> CUInt -> m () +setFontBuilderFlags (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->FontBuilderFlags = $(unsigned int value); + } + |] + +-- | Brighten (>1.0f) or darken (<1.0f) font output. +-- Brightening small fonts may be a good workaround to make them more readable. +-- +-- By default, it is @1.0f@ +setRasterizerMultiply :: MonadIO m => FontConfig -> CFloat -> m () +setRasterizerMultiply (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->RasterizerMultiply = $(float value); + } + |] + +-- | Explicitly specify unicode codepoint of ellipsis character. When fonts are being merged first specified ellipsis will be used. +-- +-- By default, it is @-1@ +setEllipsisChar :: MonadIO m => FontConfig -> ImWchar -> m () +setEllipsisChar (FontConfig fc) value = liftIO do + [C.block| + void { + $(ImFontConfig* fc)->EllipsisChar = $(ImWchar value); + } + |] diff --git a/src/DearImGui/Raw/Font/GlyphRanges.hs b/src/DearImGui/Raw/Font/GlyphRanges.hs new file mode 100644 index 0000000..19c624f --- /dev/null +++ b/src/DearImGui/Raw/Font/GlyphRanges.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| Font glyph ranges builder + +Helper to build glyph ranges from text/string data. +Feed your application strings/characters to it then call 'buildRanges'. + +Low-level example of usage: + +@ + -- import ImGui.Fonts + -- import ImGui.Raw.GlyphRangesBuilder as GRB + + builder <- GRB.new + + GRB.addRanges builder getGlyphRangesDefault + liftIO $ withCString "Привет" $ GRB.addText builder + rangesVec <- GRB.buildRanges builder + let ranges = GRB.fromRangesVector rangesVec + + addFontFromFileTTF' + "./imgui/misc/fonts/DroidSans.ttf" 12 + Nothing + (Just ranges) + + -- it is strictly necessary to explicitly build the atlas + buildFontAtlas + + -- resource destruction comes only after the building + GRB.destroyRangesVector rangesVec + GRB.destroy builder +@ + +-} + +module DearImGui.Raw.Font.GlyphRanges + ( GlyphRanges(..) + + -- * Built-in ranges + , Builtin(..) + , getBuiltin + , builtinSetup + + -- * Preparing a builder + , GlyphRangesBuilder(..) + , new + , destroy + , addChar + , addText + , addRanges + + -- * Extracting data + , GlyphRangesVector(..) + , buildRangesVector + , fromRangesVector + , destroyRangesVector + ) + where + +-- base +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign ( Ptr ) +import Foreign.C +import System.IO.Unsafe (unsafePerformIO) + +-- dear-imgui +import DearImGui.Context + ( imguiContext ) +import DearImGui.Structs + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext) +C.include "imgui.h" +Cpp.using "namespace ImGui" + +-- | Glyph ranges handle +-- +-- Wraps @ImWchar*@. +newtype GlyphRanges = GlyphRanges (Ptr ImWchar) + +-- | Builtin glyph ranges tags. +data Builtin + = Latin + | Korean + | Japanese + | ChineseFull + | ChineseSimplifiedCommon + | Cyrillic + | Thai + | Vietnamese + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | Get builtin glyph ranges from a tag. +getBuiltin :: Builtin -> GlyphRanges +getBuiltin = \case + Latin -> getGlyphRangesDefault + Korean -> getGlyphRangesKorean + Japanese -> getGlyphRangesJapanese + ChineseFull -> getGlyphRangesChineseFull + ChineseSimplifiedCommon -> getGlyphRangesChineseSimplifiedCommon + Cyrillic -> getGlyphRangesCyrillic + Thai -> getGlyphRangesThai + Vietnamese -> getGlyphRangesVietnamese + +-- | Special case of @getBuiltin@, but for font source setup. +builtinSetup :: Builtin -> Maybe GlyphRanges +builtinSetup = \case + Latin -> Nothing + others -> Just (getBuiltin others) + +-- | Basic Latin, Extended Latin +getGlyphRangesDefault :: GlyphRanges +getGlyphRangesDefault = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesDefault(); + } + |] + +-- | Default + Korean characters +getGlyphRangesKorean :: GlyphRanges +getGlyphRangesKorean = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesKorean(); + } + |] + +-- | Default + Hiragana, Katakana, Half-Width, Selection of 2999 Ideographs +getGlyphRangesJapanese :: GlyphRanges +getGlyphRangesJapanese = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesJapanese(); + } + |] + +-- | Default + Half-Width + Japanese Hiragana/Katakana + full set of about 21000 CJK Unified Ideographs +getGlyphRangesChineseFull :: GlyphRanges +getGlyphRangesChineseFull = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesChineseFull(); + } + |] + +-- | Default + Half-Width + Japanese Hiragana/Katakana + set of 2500 CJK Unified Ideographs for common simplified Chinese +getGlyphRangesChineseSimplifiedCommon :: GlyphRanges +getGlyphRangesChineseSimplifiedCommon = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesChineseSimplifiedCommon(); + } + |] + +-- | Default + about 400 Cyrillic characters +getGlyphRangesCyrillic :: GlyphRanges +getGlyphRangesCyrillic = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesCyrillic(); + } + |] + +-- | Default + Thai characters +getGlyphRangesThai :: GlyphRanges +getGlyphRangesThai = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesThai(); + } + |] + +-- | Default + Vietnamese characters +getGlyphRangesVietnamese :: GlyphRanges +getGlyphRangesVietnamese = unsafePerformIO do + GlyphRanges <$> [C.block| + const ImWchar* { + return GetIO().Fonts->GetGlyphRangesVietnamese(); + } + |] + +-- | Glyph ranges builder handle +-- +-- Wraps @ImFontGlyphRangesBuilder*@. +newtype GlyphRangesBuilder = GlyphRangesBuilder (Ptr ImFontGlyphRangesBuilder) + +-- | Glyph ranges vector handle to keep builder output +-- +-- Wraps @ImVector*@. +newtype GlyphRangesVector = GlyphRangesVector (Ptr ()) + + +-- | Create an instance of builder +new :: MonadIO m => m GlyphRangesBuilder +new = liftIO do + GlyphRangesBuilder <$> [C.block| + ImFontGlyphRangesBuilder* { + return IM_NEW(ImFontGlyphRangesBuilder); + } + |] + +-- | Destroy an instance of builder +-- +-- Should be used __after__ font atlas building. +destroy :: MonadIO m => GlyphRangesBuilder -> m () +destroy (GlyphRangesBuilder builder) = liftIO do + [C.block| + void { + IM_DELETE($(ImFontGlyphRangesBuilder* builder)); + } + |] + + +-- | Add character +addChar :: MonadIO m => GlyphRangesBuilder -> ImWchar -> m () +addChar (GlyphRangesBuilder builder) wChar = liftIO do + [C.block| + void { + $(ImFontGlyphRangesBuilder* builder)->AddChar($(ImWchar wChar)); + } + |] + +-- | Add string (each character of the UTF-8 string are added) +addText :: MonadIO m => GlyphRangesBuilder -> CString -> m () +addText (GlyphRangesBuilder builder) string = liftIO do + [C.block| + void { + $(ImFontGlyphRangesBuilder* builder)->AddText($(char* string)); + } + |] +-- FIXME: the function uses 'const char* text_end = NULL' parameter, +-- which is pointer for the line ending. It is low level, though it +-- could be utilized for string length parameter. + +-- | Add ranges, e.g. 'addRanges builder getGlyphRangesDefault' +-- to force add all of ASCII/Latin+Ext +addRanges :: MonadIO m => GlyphRangesBuilder -> GlyphRanges -> m() +addRanges (GlyphRangesBuilder builder) (GlyphRanges ranges) = liftIO do + [C.block| + void { + $(ImFontGlyphRangesBuilder* builder)->AddRanges($(ImWchar* ranges)); + } + |] + + +-- | Build new ranges and create ranges vector instance, +-- containing them +buildRangesVector :: MonadIO m => GlyphRangesBuilder -> m (GlyphRangesVector) +buildRangesVector (GlyphRangesBuilder builder) = liftIO do + GlyphRangesVector <$> [C.block| + void* { + ImVector* ranges = IM_NEW(ImVector); + $(ImFontGlyphRangesBuilder* builder)->BuildRanges(ranges); + return ranges; + } + |] + +-- | Extract glyph ranges from a vector +-- +-- Should be used __before__ vector destruction. +fromRangesVector :: GlyphRangesVector -> GlyphRanges +fromRangesVector (GlyphRangesVector vecPtr) = unsafePerformIO do + GlyphRanges <$> [C.block| + ImWchar* { + return ((ImVector*) $(void* vecPtr))->Data; + } + |] + +-- | Destroy a ranges vector instance +-- +-- Should be used __after__ font atlas building. +destroyRangesVector :: MonadIO m => GlyphRangesVector -> m () +destroyRangesVector (GlyphRangesVector vecPtr) = liftIO do + [C.block| + void { + IM_DELETE(((ImVector*) $(void* vecPtr))); + } + |] diff --git a/src/DearImGui/Structs.hs b/src/DearImGui/Structs.hs index 061cb49..1b99b4b 100644 --- a/src/DearImGui/Structs.hs +++ b/src/DearImGui/Structs.hs @@ -5,7 +5,7 @@ module DearImGui.Structs where -- base import Data.Word - ( Word32 ) + ( Word32, Word16 ) import Foreign ( Storable(..), castPtr, plusPtr ) @@ -80,6 +80,12 @@ data ImGuiContext -- | Individual font handle. data ImFont +-- | Font configuration handle. +data ImFontConfig + +-- | Glyph ranges builder handle. +data ImFontGlyphRangesBuilder + -- | Opaque DrawList handle. data ImDrawList @@ -88,3 +94,7 @@ data ImGuiListClipper -- | 32-bit unsigned integer (often used to store packed colors). type ImU32 = Word32 + +-- | Single wide character (used mostly in glyph management) +type ImWchar = Word16 +-- FIXME: consider IMGUI_USE_WCHAR32