{-# 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.Internal.Text (Text)
import qualified DearImGui.Internal.Text as Text

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
  { ConfigSetup -> FontConfig -> IO ()
applyToConfig :: FontConfig -> IO ()
  }

instance Semigroup ConfigSetup where
  ConfigSetup FontConfig -> IO ()
f <> :: ConfigSetup -> ConfigSetup -> ConfigSetup
<> ConfigSetup FontConfig -> IO ()
g =
    (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc -> FontConfig -> IO ()
f FontConfig
fc IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FontConfig -> IO ()
g FontConfig
fc
instance Monoid ConfigSetup where
  mempty :: ConfigSetup
mempty = (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup (IO () -> FontConfig -> IO ()
forall a b. a -> b -> a
const IO ()
forall a. Monoid a => a
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 $mLatin :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bLatin :: Ranges
Latin = RangesBuiltin GlyphRanges.Latin

-- | Default + Korean characters
pattern Korean :: Ranges
pattern $mKorean :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bKorean :: Ranges
Korean = RangesBuiltin GlyphRanges.Korean

-- | Default + Hiragana, Katakana, Half-Width, Selection of 2999 Ideographs
pattern Japanese :: Ranges
pattern $mJapanese :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bJapanese :: Ranges
Japanese = RangesBuiltin GlyphRanges.Japanese

-- | Default + Half-Width + Japanese Hiragana/Katakana + full set of about 21000 CJK Unified Ideographs
pattern ChineseFull :: Ranges
pattern $mChineseFull :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bChineseFull :: Ranges
ChineseFull = RangesBuiltin GlyphRanges.ChineseFull

-- | Default + Half-Width + Japanese Hiragana/Katakana + set of 2500 CJK Unified Ideographs for common simplified Chinese
pattern ChineseSimplifiedCommon :: Ranges
pattern $mChineseSimplifiedCommon :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bChineseSimplifiedCommon :: Ranges
ChineseSimplifiedCommon = RangesBuiltin GlyphRanges.ChineseSimplifiedCommon

-- | Default + about 400 Cyrillic characters
pattern Cyrillic :: Ranges
pattern $mCyrillic :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bCyrillic :: Ranges
Cyrillic = RangesBuiltin GlyphRanges.Cyrillic

-- | Default + Thai characters
pattern Thai :: Ranges
pattern $mThai :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bThai :: Ranges
Thai = RangesBuiltin GlyphRanges.Thai

-- | Default + Vietnamese characters
pattern Vietnamese :: Ranges
pattern $mVietnamese :: forall {r}. Ranges -> ((# #) -> r) -> ((# #) -> r) -> r
$bVietnamese :: Ranges
Vietnamese = RangesBuiltin GlyphRanges.Vietnamese


-- | Ranges builder monoid interface to be executed through 'buildRanges'.
--
-- @
-- addRanges FontRanges.DefaultRanges <> addText "Привет"
-- @
newtype RangesBuilderSetup = RangesBuilderSetup
  { RangesBuilderSetup -> GlyphRangesBuilder -> IO ()
applyToBuilder :: GlyphRangesBuilder -> IO ()
  }

instance Semigroup RangesBuilderSetup where
  RangesBuilderSetup GlyphRangesBuilder -> IO ()
f <> :: RangesBuilderSetup -> RangesBuilderSetup -> RangesBuilderSetup
<> RangesBuilderSetup GlyphRangesBuilder -> IO ()
g =
    (GlyphRangesBuilder -> IO ()) -> RangesBuilderSetup
RangesBuilderSetup \GlyphRangesBuilder
fc -> GlyphRangesBuilder -> IO ()
f GlyphRangesBuilder
fc IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GlyphRangesBuilder -> IO ()
g GlyphRangesBuilder
fc

instance Monoid RangesBuilderSetup where
  mempty :: RangesBuilderSetup
mempty = (GlyphRangesBuilder -> IO ()) -> RangesBuilderSetup
RangesBuilderSetup (IO () -> GlyphRangesBuilder -> IO ()
forall a b. a -> b -> a
const IO ()
forall a. Monoid a => a
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 :: forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Traversable t) =>
t FontSource -> m (t Font)
rebuild t FontSource
sources = IO (t Font) -> m (t Font)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (t Font) -> m (t Font)) -> IO (t Font) -> m (t Font)
forall a b. (a -> b) -> a -> b
$ Managed (t Font) -> (t Font -> IO (t Font)) -> IO (t Font)
forall a r. Managed a -> (a -> IO r) -> IO r
Managed.with Managed (t Font)
action t Font -> IO (t Font)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    action :: Managed (t Font)
action = do
      Managed ()
forall (m :: * -> *). MonadIO m => m ()
clear
      t Font
fonts <- (FontSource -> Managed Font) -> t FontSource -> Managed (t Font)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse FontSource -> Managed Font
forall (m :: * -> *). MonadManaged m => FontSource -> m Font
setupFont t FontSource
sources
      Managed ()
forall (m :: * -> *). MonadIO m => m ()
build
      t Font -> Managed (t Font)
forall a. a -> Managed a
forall (m :: * -> *) a. Monad m => a -> m a
return t Font
fonts

-- | Reset font atlas, clearing internal data
--
-- Alias for 'Raw.clearFontAtlas'
clear :: (MonadIO m) => m ()
clear :: forall (m :: * -> *). MonadIO m => m ()
clear = m ()
forall (m :: * -> *). MonadIO m => m ()
Raw.clearFontAtlas

-- | Build font atlas
--
-- Alias for 'Raw.buildFontAtlas'
build :: (MonadIO m) => m ()
build :: forall (m :: * -> *). MonadIO m => m ()
build = m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: forall (m :: * -> *).
MonadIO m =>
FilePath
-> Float -> Maybe FontConfig -> Maybe GlyphRanges -> m (Maybe Font)
addFontFromFileTTF FilePath
font Float
size Maybe FontConfig
config Maybe GlyphRanges
ranges = IO (Maybe Font) -> m (Maybe Font)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  res :: Font
res@(Font Ptr ImFont
ptr) <- FilePath -> (CString -> IO Font) -> IO Font
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
font \CString
fontPtr ->
    CString -> CFloat -> FontConfig -> GlyphRanges -> IO Font
forall (m :: * -> *).
MonadIO m =>
CString -> CFloat -> FontConfig -> GlyphRanges -> m Font
Raw.addFontFromFileTTF
      CString
fontPtr
      (Float -> CFloat
CFloat Float
size)
      (FontConfig -> Maybe FontConfig -> FontConfig
forall a. a -> Maybe a -> a
fromMaybe (Ptr ImFontConfig -> FontConfig
FontConfig Ptr ImFontConfig
forall a. Ptr a
nullPtr) Maybe FontConfig
config)
      (GlyphRanges -> Maybe GlyphRanges -> GlyphRanges
forall a. a -> Maybe a -> a
fromMaybe (Ptr ImWchar -> GlyphRanges
GlyphRanges Ptr ImWchar
forall a. Ptr a
nullPtr) Maybe GlyphRanges
ranges)
  Maybe Font -> IO (Maybe Font)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Font -> IO (Maybe Font)) -> Maybe Font -> IO (Maybe Font)
forall a b. (a -> b) -> a -> b
$
    if Ptr ImFont -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ImFont
ptr Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr
      then Maybe Font
forall a. Maybe a
Nothing
      else Font -> Maybe Font
forall a. a -> Maybe a
Just Font
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_ :: forall (m :: * -> *).
MonadIO m =>
FilePath -> Float -> m (Maybe Font)
addFontFromFileTTF_ FilePath
font Float
size =
  FilePath
-> Float -> Maybe FontConfig -> Maybe GlyphRanges -> m (Maybe Font)
forall (m :: * -> *).
MonadIO m =>
FilePath
-> Float -> Maybe FontConfig -> Maybe GlyphRanges -> m (Maybe Font)
addFontFromFileTTF FilePath
font Float
size Maybe FontConfig
forall a. Maybe a
Nothing Maybe GlyphRanges
forall a. Maybe a
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 :: forall (m :: * -> *). MonadManaged m => FontSource -> m Font
setupFont = \case
  FontSource
DefaultFont ->
    m Font
forall (m :: * -> *). MonadIO m => m Font
Raw.addFontDefault
  FromTTF FilePath
path Float
size Maybe ConfigSetup
configSetup Ranges
ranges -> do
    Maybe GlyphRanges
glyphRanges' <- Ranges -> m (Maybe GlyphRanges)
forall (m :: * -> *).
MonadManaged m =>
Ranges -> m (Maybe GlyphRanges)
setupRanges Ranges
ranges
    Maybe FontConfig
config <- (forall r. (Maybe FontConfig -> IO r) -> IO r)
-> m (Maybe FontConfig)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed (Maybe ConfigSetup -> (Maybe FontConfig -> IO r) -> IO r
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe ConfigSetup -> (Maybe FontConfig -> m a) -> m a
withConfig Maybe ConfigSetup
configSetup)
    Maybe Font
mFont <- FilePath
-> Float -> Maybe FontConfig -> Maybe GlyphRanges -> m (Maybe Font)
forall (m :: * -> *).
MonadIO m =>
FilePath
-> Float -> Maybe FontConfig -> Maybe GlyphRanges -> m (Maybe Font)
addFontFromFileTTF FilePath
path Float
size Maybe FontConfig
config Maybe GlyphRanges
glyphRanges'
    case Maybe Font
mFont of
      Maybe Font
Nothing ->
        IO Font -> m Font
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Font -> m Font) -> (FilePath -> IO Font) -> FilePath -> m Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Font
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m Font) -> FilePath -> m Font
forall a b. (a -> b) -> a -> b
$ FilePath
"Couldn't load font from " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
      Just Font
font ->
        Font -> m Font
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Font
font

-- | Configure glyph ranges with provided configuration, return a handle
-- and defer builder destructors, if needed.
setupRanges :: (MonadManaged m) => Ranges -> m (Maybe GlyphRanges)
setupRanges :: forall (m :: * -> *).
MonadManaged m =>
Ranges -> m (Maybe GlyphRanges)
setupRanges = \case
  RangesRaw GlyphRanges
ranges ->
    Maybe GlyphRanges -> m (Maybe GlyphRanges)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GlyphRanges -> m (Maybe GlyphRanges))
-> Maybe GlyphRanges -> m (Maybe GlyphRanges)
forall a b. (a -> b) -> a -> b
$ GlyphRanges -> Maybe GlyphRanges
forall a. a -> Maybe a
Just GlyphRanges
ranges
  RangesBuiltin Builtin
builtin ->
    Maybe GlyphRanges -> m (Maybe GlyphRanges)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GlyphRanges -> m (Maybe GlyphRanges))
-> Maybe GlyphRanges -> m (Maybe GlyphRanges)
forall a b. (a -> b) -> a -> b
$ Builtin -> Maybe GlyphRanges
GlyphRanges.builtinSetup Builtin
builtin
  RangesBuilder RangesBuilderSetup
settings -> do
    GlyphRanges
built <- (forall r. (GlyphRanges -> IO r) -> IO r) -> m GlyphRanges
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
managed ((forall r. (GlyphRanges -> IO r) -> IO r) -> m GlyphRanges)
-> (forall r. (GlyphRanges -> IO r) -> IO r) -> m GlyphRanges
forall a b. (a -> b) -> a -> b
$ RangesBuilderSetup -> (GlyphRanges -> IO r) -> IO r
forall (m :: * -> *) a.
MonadUnliftIO m =>
RangesBuilderSetup -> (GlyphRanges -> m a) -> m a
withRanges RangesBuilderSetup
settings
    Maybe GlyphRanges -> m (Maybe GlyphRanges)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GlyphRanges -> m (Maybe GlyphRanges))
-> Maybe GlyphRanges -> m (Maybe GlyphRanges)
forall a b. (a -> b) -> a -> b
$ GlyphRanges -> Maybe GlyphRanges
forall a. a -> Maybe a
Just GlyphRanges
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 :: forall (m :: * -> *) a.
MonadUnliftIO m =>
RangesBuilderSetup -> (GlyphRanges -> m a) -> m a
withRanges (RangesBuilderSetup GlyphRangesBuilder -> IO ()
setup) GlyphRanges -> m a
fn =
  m (GlyphRangesVector, GlyphRangesBuilder)
-> ((GlyphRangesVector, GlyphRangesBuilder) -> m ())
-> ((GlyphRangesVector, GlyphRangesBuilder) -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m (GlyphRangesVector, GlyphRangesBuilder)
acquire (GlyphRangesVector, GlyphRangesBuilder) -> m ()
forall {m :: * -> *}.
MonadIO m =>
(GlyphRangesVector, GlyphRangesBuilder) -> m ()
release (GlyphRangesVector, GlyphRangesBuilder) -> m a
forall {b}. (GlyphRangesVector, b) -> m a
execute
  where
    acquire :: m (GlyphRangesVector, GlyphRangesBuilder)
acquire = do
      GlyphRangesBuilder
builder <- m GlyphRangesBuilder
forall (m :: * -> *). MonadIO m => m GlyphRangesBuilder
GlyphRanges.new
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ GlyphRangesBuilder -> IO ()
setup GlyphRangesBuilder
builder
      GlyphRangesVector
rangesVec <- GlyphRangesBuilder -> m GlyphRangesVector
forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> m GlyphRangesVector
GlyphRanges.buildRangesVector GlyphRangesBuilder
builder
      (GlyphRangesVector, GlyphRangesBuilder)
-> m (GlyphRangesVector, GlyphRangesBuilder)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlyphRangesVector
rangesVec, GlyphRangesBuilder
builder)

    release :: (GlyphRangesVector, GlyphRangesBuilder) -> m ()
release (GlyphRangesVector
rangesVec, GlyphRangesBuilder
builder) = do
      GlyphRangesVector -> m ()
forall (m :: * -> *). MonadIO m => GlyphRangesVector -> m ()
GlyphRanges.destroyRangesVector GlyphRangesVector
rangesVec
      GlyphRangesBuilder -> m ()
forall (m :: * -> *). MonadIO m => GlyphRangesBuilder -> m ()
GlyphRanges.destroy GlyphRangesBuilder
builder

    execute :: (GlyphRangesVector, b) -> m a
execute (GlyphRangesVector
rangesVec, b
_) =
      GlyphRanges -> m a
fn (GlyphRangesVector -> GlyphRanges
GlyphRanges.fromRangesVector GlyphRangesVector
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 :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe ConfigSetup -> (Maybe FontConfig -> m a) -> m a
withConfig Maybe ConfigSetup
mSetup Maybe FontConfig -> m a
action =
  case Maybe ConfigSetup
mSetup of
    Maybe ConfigSetup
Nothing ->
      Maybe FontConfig -> m a
action Maybe FontConfig
forall a. Maybe a
Nothing
    Just (ConfigSetup FontConfig -> IO ()
setup) ->
      m FontConfig -> (FontConfig -> m ()) -> (FontConfig -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m FontConfig
acquire (FontConfig -> m ()
forall (m :: * -> *). MonadIO m => FontConfig -> m ()
FontConfig.destroy) (Maybe FontConfig -> m a
action (Maybe FontConfig -> m a)
-> (FontConfig -> Maybe FontConfig) -> FontConfig -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontConfig -> Maybe FontConfig
forall a. a -> Maybe a
Just)
      where
        acquire :: m FontConfig
acquire = do
          FontConfig
config <- m FontConfig
forall (m :: * -> *). MonadIO m => m FontConfig
FontConfig.new
          IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FontConfig -> IO ()
setup FontConfig
config
          FontConfig -> m FontConfig
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FontConfig
config

-- | Single Unicode character
addChar :: ImWchar -> RangesBuilderSetup
addChar :: ImWchar -> RangesBuilderSetup
addChar ImWchar
char =
  (GlyphRangesBuilder -> IO ()) -> RangesBuilderSetup
RangesBuilderSetup \GlyphRangesBuilder
builder ->
    GlyphRangesBuilder -> ImWchar -> IO ()
forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> ImWchar -> m ()
GlyphRanges.addChar GlyphRangesBuilder
builder ImWchar
char

-- | UTF-8 string
addText :: Text -> RangesBuilderSetup
addText :: Text -> RangesBuilderSetup
addText Text
str =
  (GlyphRangesBuilder -> IO ()) -> RangesBuilderSetup
RangesBuilderSetup \GlyphRangesBuilder
builder ->
    Text -> (CString -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> (CString -> m a) -> m a
Text.withCString Text
str (GlyphRangesBuilder -> CString -> IO ()
forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> CString -> m ()
GlyphRanges.addText GlyphRangesBuilder
builder)

-- | Existing ranges (as is)
addRangesRaw :: GlyphRanges -> RangesBuilderSetup
addRangesRaw :: GlyphRanges -> RangesBuilderSetup
addRangesRaw GlyphRanges
ranges =
  (GlyphRangesBuilder -> IO ()) -> RangesBuilderSetup
RangesBuilderSetup \GlyphRangesBuilder
builder ->
    GlyphRangesBuilder -> GlyphRanges -> IO ()
forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> GlyphRanges -> m ()
GlyphRanges.addRanges GlyphRangesBuilder
builder GlyphRanges
ranges

-- | Existing ranges (through settings interface)
addRanges :: Ranges -> RangesBuilderSetup
addRanges :: Ranges -> RangesBuilderSetup
addRanges = \case
  RangesRaw GlyphRanges
ranges ->
    GlyphRanges -> RangesBuilderSetup
addRangesRaw GlyphRanges
ranges
  RangesBuilder RangesBuilderSetup
settings ->
    RangesBuilderSetup
settings
  RangesBuiltin Builtin
builtin ->
    GlyphRanges -> RangesBuilderSetup
addRangesRaw (Builtin -> GlyphRanges
GlyphRanges.getBuiltin Builtin
builtin)

-- | TTF/OTF data ownership taken by the container ImFontAtlas (will delete memory itself).
--
-- By default, it is @true@
fontDataOwnedByAtlas :: Bool -> ConfigSetup
fontDataOwnedByAtlas :: Bool -> ConfigSetup
fontDataOwnedByAtlas Bool
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CBool -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CBool -> m ()
FontConfig.setFontDataOwnedByAtlas FontConfig
fc (CBool -> CBool -> Bool -> CBool
forall a. a -> a -> Bool -> a
bool CBool
0 CBool
1 Bool
value)

-- | Index of font within TTF/OTF file.
--
-- By default, it is @0@
fontNo :: Int -> ConfigSetup
fontNo :: Int -> ConfigSetup
fontNo Int
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CInt -> m ()
FontConfig.setFontNo FontConfig
fc (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value)

-- | Size in pixels for rasterizer
--
-- More or less maps to the resulting font height.
--
-- Implicitly set by @addFont...@ functions.
sizePixels :: Float -> ConfigSetup
sizePixels :: Float -> ConfigSetup
sizePixels Float
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CFloat -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CFloat -> m ()
FontConfig.setSizePixels FontConfig
fc (Float -> CFloat
CFloat 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@
oversampleH :: Int -> ConfigSetup
oversampleH :: Int -> ConfigSetup
oversampleH Int
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CInt -> m ()
FontConfig.setOversampleH FontConfig
fc (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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@
oversampleV :: Int -> ConfigSetup
oversampleV :: Int -> ConfigSetup
oversampleV Int
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CInt -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CInt -> m ()
FontConfig.setOversampleV FontConfig
fc (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 :: Bool -> ConfigSetup
pixelSnapH Bool
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CBool -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CBool -> m ()
FontConfig.setPixelSnapH FontConfig
fc (CBool -> CBool -> Bool -> CBool
forall a. a -> a -> Bool -> a
bool CBool
0 CBool
1 Bool
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 :: (Float, Float) -> ConfigSetup
glyphExtraSpacing (Float
x, Float
y) =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Foreign.with (Float -> Float -> ImVec2
ImVec2 Float
x Float
y) (FontConfig -> Ptr ImVec2 -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> Ptr ImVec2 -> m ()
FontConfig.setGlyphExtraSpacing FontConfig
fc)

-- | Offset all glyphs from this font input.
--
-- By default, it is @0, 0@
glyphOffset :: (Float, Float) -> ConfigSetup
glyphOffset :: (Float, Float) -> ConfigSetup
glyphOffset (Float
x, Float
y) =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Foreign.with (Float -> Float -> ImVec2
ImVec2 Float
x Float
y) (FontConfig -> Ptr ImVec2 -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> Ptr ImVec2 -> m ()
FontConfig.setGlyphOffset FontConfig
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 :: GlyphRanges -> ConfigSetup
glyphRanges GlyphRanges
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> GlyphRanges -> IO ()
forall (m :: * -> *).
MonadIO m =>
FontConfig -> GlyphRanges -> m ()
FontConfig.setGlyphRanges FontConfig
fc GlyphRanges
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 :: Float -> ConfigSetup
glyphMinAdvanceX Float
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CFloat -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CFloat -> m ()
FontConfig.setGlyphMinAdvanceX FontConfig
fc (Float -> CFloat
CFloat Float
value)

-- | Maximum AdvanceX for glyphs.
--
-- By default, it is @FLT_MAX@.
glyphMaxAdvanceX :: Float -> ConfigSetup
glyphMaxAdvanceX :: Float -> ConfigSetup
glyphMaxAdvanceX Float
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CFloat -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CFloat -> m ()
FontConfig.setGlyphMaxAdvanceX FontConfig
fc (Float -> CFloat
CFloat 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 merging font of different heights.
--
-- By default, it is @false@
mergeMode :: Bool -> ConfigSetup
mergeMode :: Bool -> ConfigSetup
mergeMode Bool
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CBool -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CBool -> m ()
FontConfig.setMergeMode FontConfig
fc (CBool -> CBool -> Bool -> CBool
forall a. a -> a -> Bool -> a
bool CBool
0 CBool
1 Bool
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 :: Int -> ConfigSetup
fontBuilderFlags Int
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CUInt -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CUInt -> m ()
FontConfig.setFontBuilderFlags FontConfig
fc (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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@.
rasterizerMultiply :: Float -> ConfigSetup
rasterizerMultiply :: Float -> ConfigSetup
rasterizerMultiply Float
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> CFloat -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> CFloat -> m ()
FontConfig.setRasterizerMultiply FontConfig
fc (Float -> CFloat
CFloat 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@
ellipsisChar :: ImWchar -> ConfigSetup
ellipsisChar :: ImWchar -> ConfigSetup
ellipsisChar ImWchar
value =
  (FontConfig -> IO ()) -> ConfigSetup
ConfigSetup \FontConfig
fc ->
    FontConfig -> ImWchar -> IO ()
forall (m :: * -> *). MonadIO m => FontConfig -> ImWchar -> m ()
FontConfig.setEllipsisChar FontConfig
fc ImWchar
value