packages feed

dear-imgui 1.2.2 → 1.3.0

raw patch · 12 files changed

+1391/−97 lines, 12 filesdep ~sdl2new-component:exe:fontsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: sdl2

API changes (from Hackage documentation)

- DearImGui: addFontDefault :: MonadIO m => m Font
- DearImGui: addFontFromFileTTF :: MonadIO m => FilePath -> Float -> m (Maybe Font)
- DearImGui: buildFontAtlas :: MonadIO m => m ()
- DearImGui: clearFontAtlas :: MonadIO m => m ()
- DearImGui.Raw: Font :: Ptr ImFont -> Font
- DearImGui.Raw: addFontDefault :: MonadIO m => m Font
- DearImGui.Raw: addFontFromFileTTF :: MonadIO m => CString -> CFloat -> m Font
- DearImGui.Raw: addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> m Font
- DearImGui.Raw: buildFontAtlas :: MonadIO m => m ()
- DearImGui.Raw: clearFontAtlas :: MonadIO m => m ()
- DearImGui.Raw: newtype Font
+ DearImGui: data ImFontConfig
+ DearImGui: data ImFontGlyphRangesBuilder
+ DearImGui: popFont :: MonadIO m => m ()
+ DearImGui: pushFont :: MonadIO m => Font -> m ()
+ DearImGui: type ImWchar = Word16
+ DearImGui: withFont :: MonadUnliftIO m => Font -> m a -> m a
+ DearImGui.FontAtlas: ConfigSetup :: (FontConfig -> IO ()) -> ConfigSetup
+ DearImGui.FontAtlas: DefaultFont :: FontSource
+ DearImGui.FontAtlas: Font :: Ptr ImFont -> Font
+ DearImGui.FontAtlas: FromTTF :: FilePath -> Float -> Maybe ConfigSetup -> Ranges -> FontSource
+ DearImGui.FontAtlas: RangesBuilder :: RangesBuilderSetup -> Ranges
+ DearImGui.FontAtlas: RangesBuilderSetup :: (GlyphRangesBuilder -> IO ()) -> RangesBuilderSetup
+ DearImGui.FontAtlas: RangesBuiltin :: Builtin -> Ranges
+ DearImGui.FontAtlas: RangesRaw :: GlyphRanges -> Ranges
+ DearImGui.FontAtlas: [$sel:applyToBuilder:RangesBuilderSetup] :: RangesBuilderSetup -> GlyphRangesBuilder -> IO ()
+ DearImGui.FontAtlas: [$sel:applyToConfig:ConfigSetup] :: ConfigSetup -> FontConfig -> IO ()
+ DearImGui.FontAtlas: addChar :: ImWchar -> RangesBuilderSetup
+ DearImGui.FontAtlas: addFontFromFileTTF :: MonadIO m => FilePath -> Float -> Maybe FontConfig -> Maybe GlyphRanges -> m (Maybe Font)
+ DearImGui.FontAtlas: addFontFromFileTTF_ :: MonadIO m => FilePath -> Float -> m (Maybe Font)
+ DearImGui.FontAtlas: addRanges :: Ranges -> RangesBuilderSetup
+ DearImGui.FontAtlas: addRangesRaw :: GlyphRanges -> RangesBuilderSetup
+ DearImGui.FontAtlas: addText :: String -> RangesBuilderSetup
+ DearImGui.FontAtlas: build :: MonadIO m => m ()
+ DearImGui.FontAtlas: clear :: MonadIO m => m ()
+ DearImGui.FontAtlas: data FontSource
+ DearImGui.FontAtlas: data Ranges
+ DearImGui.FontAtlas: ellipsisChar :: ImWchar -> ConfigSetup
+ DearImGui.FontAtlas: fontBuilderFlags :: Int -> ConfigSetup
+ DearImGui.FontAtlas: fontDataOwnedByAtlas :: Bool -> ConfigSetup
+ DearImGui.FontAtlas: fontNo :: Int -> ConfigSetup
+ DearImGui.FontAtlas: glyphExtraSpacing :: (Float, Float) -> ConfigSetup
+ DearImGui.FontAtlas: glyphMaxAdvanceX :: Float -> ConfigSetup
+ DearImGui.FontAtlas: glyphMinAdvanceX :: Float -> ConfigSetup
+ DearImGui.FontAtlas: glyphOffset :: (Float, Float) -> ConfigSetup
+ DearImGui.FontAtlas: glyphRanges :: GlyphRanges -> ConfigSetup
+ DearImGui.FontAtlas: instance GHC.Base.Monoid DearImGui.FontAtlas.ConfigSetup
+ DearImGui.FontAtlas: instance GHC.Base.Monoid DearImGui.FontAtlas.RangesBuilderSetup
+ DearImGui.FontAtlas: instance GHC.Base.Semigroup DearImGui.FontAtlas.ConfigSetup
+ DearImGui.FontAtlas: instance GHC.Base.Semigroup DearImGui.FontAtlas.RangesBuilderSetup
+ DearImGui.FontAtlas: mergeMode :: Bool -> ConfigSetup
+ DearImGui.FontAtlas: newtype ConfigSetup
+ DearImGui.FontAtlas: newtype Font
+ DearImGui.FontAtlas: newtype RangesBuilderSetup
+ DearImGui.FontAtlas: oversampleH :: Int -> ConfigSetup
+ DearImGui.FontAtlas: oversampleV :: Int -> ConfigSetup
+ DearImGui.FontAtlas: pattern ChineseFull :: Ranges
+ DearImGui.FontAtlas: pattern ChineseSimplifiedCommon :: Ranges
+ DearImGui.FontAtlas: pattern Cyrillic :: Ranges
+ DearImGui.FontAtlas: pattern Japanese :: Ranges
+ DearImGui.FontAtlas: pattern Korean :: Ranges
+ DearImGui.FontAtlas: pattern Latin :: Ranges
+ DearImGui.FontAtlas: pattern Thai :: Ranges
+ DearImGui.FontAtlas: pattern Vietnamese :: Ranges
+ DearImGui.FontAtlas: pixelSnapH :: Bool -> ConfigSetup
+ DearImGui.FontAtlas: rasterizerMultiply :: Float -> ConfigSetup
+ DearImGui.FontAtlas: rebuild :: (MonadIO m, Traversable t) => t FontSource -> m (t Font)
+ DearImGui.FontAtlas: setupFont :: MonadManaged m => FontSource -> m Font
+ DearImGui.FontAtlas: setupRanges :: MonadManaged m => Ranges -> m (Maybe GlyphRanges)
+ DearImGui.FontAtlas: sizePixels :: Float -> ConfigSetup
+ DearImGui.FontAtlas: withConfig :: MonadUnliftIO m => Maybe ConfigSetup -> (Maybe FontConfig -> m a) -> m a
+ DearImGui.FontAtlas: withRanges :: MonadUnliftIO m => RangesBuilderSetup -> (GlyphRanges -> m a) -> m a
+ DearImGui.Raw: data ImFontConfig
+ DearImGui.Raw: data ImFontGlyphRangesBuilder
+ DearImGui.Raw: type ImWchar = Word16
+ DearImGui.Raw.Font: Font :: Ptr ImFont -> Font
+ DearImGui.Raw.Font: GlyphRanges :: Ptr ImWchar -> GlyphRanges
+ DearImGui.Raw.Font: addFontDefault :: MonadIO m => m Font
+ DearImGui.Raw.Font: addFontFromFileTTF :: MonadIO m => CString -> CFloat -> FontConfig -> GlyphRanges -> m Font
+ DearImGui.Raw.Font: addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> FontConfig -> GlyphRanges -> m Font
+ DearImGui.Raw.Font: buildFontAtlas :: MonadIO m => m ()
+ DearImGui.Raw.Font: clearFontAtlas :: MonadIO m => m ()
+ DearImGui.Raw.Font: newtype Font
+ DearImGui.Raw.Font: newtype GlyphRanges
+ DearImGui.Raw.Font: popFont :: MonadIO m => m ()
+ DearImGui.Raw.Font: pushFont :: MonadIO m => Font -> m ()
+ DearImGui.Raw.Font.Config: FontConfig :: Ptr ImFontConfig -> FontConfig
+ DearImGui.Raw.Font.Config: destroy :: MonadIO m => FontConfig -> m ()
+ DearImGui.Raw.Font.Config: new :: MonadIO m => m FontConfig
+ DearImGui.Raw.Font.Config: newtype FontConfig
+ DearImGui.Raw.Font.Config: setEllipsisChar :: MonadIO m => FontConfig -> ImWchar -> m ()
+ DearImGui.Raw.Font.Config: setFontBuilderFlags :: MonadIO m => FontConfig -> CUInt -> m ()
+ DearImGui.Raw.Font.Config: setFontDataOwnedByAtlas :: MonadIO m => FontConfig -> CBool -> m ()
+ DearImGui.Raw.Font.Config: setFontNo :: MonadIO m => FontConfig -> CInt -> m ()
+ DearImGui.Raw.Font.Config: setGlyphExtraSpacing :: MonadIO m => FontConfig -> Ptr ImVec2 -> m ()
+ DearImGui.Raw.Font.Config: setGlyphMaxAdvanceX :: MonadIO m => FontConfig -> CFloat -> m ()
+ DearImGui.Raw.Font.Config: setGlyphMinAdvanceX :: MonadIO m => FontConfig -> CFloat -> m ()
+ DearImGui.Raw.Font.Config: setGlyphOffset :: MonadIO m => FontConfig -> Ptr ImVec2 -> m ()
+ DearImGui.Raw.Font.Config: setGlyphRanges :: MonadIO m => FontConfig -> GlyphRanges -> m ()
+ DearImGui.Raw.Font.Config: setMergeMode :: MonadIO m => FontConfig -> CBool -> m ()
+ DearImGui.Raw.Font.Config: setOversampleH :: MonadIO m => FontConfig -> CInt -> m ()
+ DearImGui.Raw.Font.Config: setOversampleV :: MonadIO m => FontConfig -> CInt -> m ()
+ DearImGui.Raw.Font.Config: setPixelSnapH :: MonadIO m => FontConfig -> CBool -> m ()
+ DearImGui.Raw.Font.Config: setRasterizerMultiply :: MonadIO m => FontConfig -> CFloat -> m ()
+ DearImGui.Raw.Font.Config: setSizePixels :: MonadIO m => FontConfig -> CFloat -> m ()
+ DearImGui.Raw.Font.GlyphRanges: ChineseFull :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: ChineseSimplifiedCommon :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: Cyrillic :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: GlyphRanges :: Ptr ImWchar -> GlyphRanges
+ DearImGui.Raw.Font.GlyphRanges: GlyphRangesBuilder :: Ptr ImFontGlyphRangesBuilder -> GlyphRangesBuilder
+ DearImGui.Raw.Font.GlyphRanges: GlyphRangesVector :: Ptr () -> GlyphRangesVector
+ DearImGui.Raw.Font.GlyphRanges: Japanese :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: Korean :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: Latin :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: Thai :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: Vietnamese :: Builtin
+ DearImGui.Raw.Font.GlyphRanges: addChar :: MonadIO m => GlyphRangesBuilder -> ImWchar -> m ()
+ DearImGui.Raw.Font.GlyphRanges: addRanges :: MonadIO m => GlyphRangesBuilder -> GlyphRanges -> m ()
+ DearImGui.Raw.Font.GlyphRanges: addText :: MonadIO m => GlyphRangesBuilder -> CString -> m ()
+ DearImGui.Raw.Font.GlyphRanges: buildRangesVector :: MonadIO m => GlyphRangesBuilder -> m GlyphRangesVector
+ DearImGui.Raw.Font.GlyphRanges: builtinSetup :: Builtin -> Maybe GlyphRanges
+ DearImGui.Raw.Font.GlyphRanges: data Builtin
+ DearImGui.Raw.Font.GlyphRanges: destroy :: MonadIO m => GlyphRangesBuilder -> m ()
+ DearImGui.Raw.Font.GlyphRanges: destroyRangesVector :: MonadIO m => GlyphRangesVector -> m ()
+ DearImGui.Raw.Font.GlyphRanges: fromRangesVector :: GlyphRangesVector -> GlyphRanges
+ DearImGui.Raw.Font.GlyphRanges: getBuiltin :: Builtin -> GlyphRanges
+ DearImGui.Raw.Font.GlyphRanges: instance GHC.Classes.Eq DearImGui.Raw.Font.GlyphRanges.Builtin
+ DearImGui.Raw.Font.GlyphRanges: instance GHC.Classes.Ord DearImGui.Raw.Font.GlyphRanges.Builtin
+ DearImGui.Raw.Font.GlyphRanges: instance GHC.Enum.Bounded DearImGui.Raw.Font.GlyphRanges.Builtin
+ DearImGui.Raw.Font.GlyphRanges: instance GHC.Enum.Enum DearImGui.Raw.Font.GlyphRanges.Builtin
+ DearImGui.Raw.Font.GlyphRanges: instance GHC.Show.Show DearImGui.Raw.Font.GlyphRanges.Builtin
+ DearImGui.Raw.Font.GlyphRanges: new :: MonadIO m => m GlyphRangesBuilder
+ DearImGui.Raw.Font.GlyphRanges: newtype GlyphRanges
+ DearImGui.Raw.Font.GlyphRanges: newtype GlyphRangesBuilder
+ DearImGui.Raw.Font.GlyphRanges: newtype GlyphRangesVector

Files

ChangeLog.md view
@@ -1,12 +1,19 @@ # Changelog for dear-imgui +## [1.3.0]++- Added `DearImGui.FontAtlas` and related `DearImGui.Raw.Font.*` bits.+- Removed old font atlas functions from `DearImGui` and `DearImGui.Raw`.+ ## [1.2.2]  - `imgui` updated to 1.85.  ## [1.2.1] +- Added `DearImGui.Raw.DrawList` for drawing primitives. - Added `DearImGui.Raw.IO` with attribute setters.+- Added `DearImGui.Raw.ListClipper` for efficient list viewports.  ## [1.2.0] @@ -44,4 +51,6 @@ [1.0.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.2 [1.1.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.1.0 [1.2.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.2.0+[1.2.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.2.1+[1.2.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.2.2 [1.3.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.0
dear-imgui.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: dear-imgui-version: 1.2.2+version: 1.3.0 author: Oliver Charles maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com license: BSD-3-Clause@@ -124,8 +124,12 @@     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:@@ -266,7 +270,7 @@     , transformers         >= 0.5.6 && < 0.6     , unordered-containers-        >= 0.2.11 && < 0.2.15+        >= 0.2.11 && < 0.3  executable test   import: common, build-flags@@ -291,6 +295,14 @@   import: common, build-flags   main-is: Readme.hs   hs-source-dirs: examples+  build-depends: sdl2, gl, dear-imgui, managed+  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
+ examples/fonts/Main.hs view
@@ -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
examples/vulkan/Main.hs view
@@ -134,12 +134,6 @@     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 =
src/DearImGui.hs view
@@ -86,6 +86,11 @@   , pushStyleVar   , popStyleVar +  , withFont+  , Raw.Font.pushFont+  , Raw.Font.popFont+  , Raw.Font.Font+     -- * Cursor/Layout   , Raw.separator   , Raw.sameLine@@ -247,13 +252,6 @@   , Raw.wantCaptureMouse   , Raw.wantCaptureKeyboard -    -- * Fonts-  , Raw.Font-  , addFontFromFileTTF-  , Raw.addFontDefault-  , Raw.buildFontAtlas-  , Raw.clearFontAtlas-     -- * Utilities      -- ** ListClipper@@ -287,6 +285,9 @@ -- 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 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 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 --
src/DearImGui/Context.hs view
@@ -34,9 +34,12 @@       , ( 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 |] )       ]   }
+ src/DearImGui/FontAtlas.hs view
@@ -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
src/DearImGui/Raw.hs view
@@ -211,14 +211,6 @@   , wantCaptureMouse   , wantCaptureKeyboard -    -- * Fonts in default font atlas-  , Font(..)-  , addFontDefault-  , addFontFromFileTTF-  , addFontFromMemoryTTF-  , buildFontAtlas-  , clearFontAtlas-     -- * Utilities      -- ** Miscellaneous@@ -1562,58 +1554,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. --
+ src/DearImGui/Raw/Font.hs view
@@ -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();+    }+  |]
+ src/DearImGui/Raw/Font/Config.hs view
@@ -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);+    }+  |]
+ src/DearImGui/Raw/Font/GlyphRanges.hs view
@@ -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<ImWchar>*@.+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<ImWchar>* ranges = IM_NEW(ImVector<ImWchar>);+      $(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<ImWchar>*) $(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<ImWchar>*) $(void* vecPtr)));+    }+  |]
src/DearImGui/Structs.hs view
@@ -5,7 +5,7 @@  -- base import Data.Word-  ( Word32 )+  ( Word32, Word16 ) import Foreign   ( Storable(..), castPtr, plusPtr ) @@ -80,6 +80,12 @@ -- | 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 @@  -- | 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