{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module DearImGui.Raw.Font.GlyphRanges
( GlyphRanges(..)
, Builtin(..)
, getBuiltin
, builtinSetup
, GlyphRangesBuilder(..)
, new
, destroy
, addChar
, addText
, addRanges
, GlyphRangesVector(..)
, buildRangesVector
, fromRangesVector
, destroyRangesVector
)
where
import Control.Monad.IO.Class
( MonadIO, liftIO )
import Foreign ( Ptr )
import Foreign.C
import System.IO.Unsafe (unsafePerformIO)
import DearImGui.Raw.Context
( imguiContext )
import DearImGui.Structs
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Cpp as Cpp
C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext)
C.include "imgui.h"
Cpp.using "namespace ImGui"
newtype GlyphRanges = GlyphRanges (Ptr ImWchar)
data Builtin
= Latin
| Korean
| Japanese
| ChineseFull
| ChineseSimplifiedCommon
| Cyrillic
| Thai
| Vietnamese
deriving (Builtin -> Builtin -> Bool
(Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool) -> Eq Builtin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Builtin -> Builtin -> Bool
== :: Builtin -> Builtin -> Bool
$c/= :: Builtin -> Builtin -> Bool
/= :: Builtin -> Builtin -> Bool
Eq, Eq Builtin
Eq Builtin =>
(Builtin -> Builtin -> Ordering)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Bool)
-> (Builtin -> Builtin -> Builtin)
-> (Builtin -> Builtin -> Builtin)
-> Ord Builtin
Builtin -> Builtin -> Bool
Builtin -> Builtin -> Ordering
Builtin -> Builtin -> Builtin
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Builtin -> Builtin -> Ordering
compare :: Builtin -> Builtin -> Ordering
$c< :: Builtin -> Builtin -> Bool
< :: Builtin -> Builtin -> Bool
$c<= :: Builtin -> Builtin -> Bool
<= :: Builtin -> Builtin -> Bool
$c> :: Builtin -> Builtin -> Bool
> :: Builtin -> Builtin -> Bool
$c>= :: Builtin -> Builtin -> Bool
>= :: Builtin -> Builtin -> Bool
$cmax :: Builtin -> Builtin -> Builtin
max :: Builtin -> Builtin -> Builtin
$cmin :: Builtin -> Builtin -> Builtin
min :: Builtin -> Builtin -> Builtin
Ord, Int -> Builtin -> ShowS
[Builtin] -> ShowS
Builtin -> String
(Int -> Builtin -> ShowS)
-> (Builtin -> String) -> ([Builtin] -> ShowS) -> Show Builtin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Builtin -> ShowS
showsPrec :: Int -> Builtin -> ShowS
$cshow :: Builtin -> String
show :: Builtin -> String
$cshowList :: [Builtin] -> ShowS
showList :: [Builtin] -> ShowS
Show, Int -> Builtin
Builtin -> Int
Builtin -> [Builtin]
Builtin -> Builtin
Builtin -> Builtin -> [Builtin]
Builtin -> Builtin -> Builtin -> [Builtin]
(Builtin -> Builtin)
-> (Builtin -> Builtin)
-> (Int -> Builtin)
-> (Builtin -> Int)
-> (Builtin -> [Builtin])
-> (Builtin -> Builtin -> [Builtin])
-> (Builtin -> Builtin -> [Builtin])
-> (Builtin -> Builtin -> Builtin -> [Builtin])
-> Enum Builtin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Builtin -> Builtin
succ :: Builtin -> Builtin
$cpred :: Builtin -> Builtin
pred :: Builtin -> Builtin
$ctoEnum :: Int -> Builtin
toEnum :: Int -> Builtin
$cfromEnum :: Builtin -> Int
fromEnum :: Builtin -> Int
$cenumFrom :: Builtin -> [Builtin]
enumFrom :: Builtin -> [Builtin]
$cenumFromThen :: Builtin -> Builtin -> [Builtin]
enumFromThen :: Builtin -> Builtin -> [Builtin]
$cenumFromTo :: Builtin -> Builtin -> [Builtin]
enumFromTo :: Builtin -> Builtin -> [Builtin]
$cenumFromThenTo :: Builtin -> Builtin -> Builtin -> [Builtin]
enumFromThenTo :: Builtin -> Builtin -> Builtin -> [Builtin]
Enum, Builtin
Builtin -> Builtin -> Bounded Builtin
forall a. a -> a -> Bounded a
$cminBound :: Builtin
minBound :: Builtin
$cmaxBound :: Builtin
maxBound :: Builtin
Bounded)
getBuiltin :: Builtin -> GlyphRanges
getBuiltin :: Builtin -> GlyphRanges
getBuiltin = \case
Builtin
Latin -> GlyphRanges
getGlyphRangesDefault
Builtin
Korean -> GlyphRanges
getGlyphRangesKorean
Builtin
Japanese -> GlyphRanges
getGlyphRangesJapanese
Builtin
ChineseFull -> GlyphRanges
getGlyphRangesChineseFull
Builtin
ChineseSimplifiedCommon -> GlyphRanges
getGlyphRangesChineseSimplifiedCommon
Builtin
Cyrillic -> GlyphRanges
getGlyphRangesCyrillic
Builtin
Thai -> GlyphRanges
getGlyphRangesThai
Builtin
Vietnamese -> GlyphRanges
getGlyphRangesVietnamese
builtinSetup :: Builtin -> Maybe GlyphRanges
builtinSetup :: Builtin -> Maybe GlyphRanges
builtinSetup = \case
Builtin
Latin -> Maybe GlyphRanges
forall a. Maybe a
Nothing
Builtin
others -> GlyphRanges -> Maybe GlyphRanges
forall a. a -> Maybe a
Just (Builtin -> GlyphRanges
getBuiltin Builtin
others)
getGlyphRangesDefault :: GlyphRanges
getGlyphRangesDefault :: GlyphRanges
getGlyphRangesDefault = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesDefault();
}
|]
getGlyphRangesKorean :: GlyphRanges
getGlyphRangesKorean :: GlyphRanges
getGlyphRangesKorean = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesKorean();
}
|]
getGlyphRangesJapanese :: GlyphRanges
getGlyphRangesJapanese :: GlyphRanges
getGlyphRangesJapanese = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesJapanese();
}
|]
getGlyphRangesChineseFull :: GlyphRanges
getGlyphRangesChineseFull :: GlyphRanges
getGlyphRangesChineseFull = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesChineseFull();
}
|]
getGlyphRangesChineseSimplifiedCommon :: GlyphRanges
getGlyphRangesChineseSimplifiedCommon :: GlyphRanges
getGlyphRangesChineseSimplifiedCommon = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesChineseSimplifiedCommon();
}
|]
getGlyphRangesCyrillic :: GlyphRanges
getGlyphRangesCyrillic :: GlyphRanges
getGlyphRangesCyrillic = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesCyrillic();
}
|]
getGlyphRangesThai :: GlyphRanges
getGlyphRangesThai :: GlyphRanges
getGlyphRangesThai = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesThai();
}
|]
getGlyphRangesVietnamese :: GlyphRanges
getGlyphRangesVietnamese :: GlyphRanges
getGlyphRangesVietnamese = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImWchar)
[C.block|
const ImWchar* {
return GetIO().Fonts->GetGlyphRangesVietnamese();
}
|]
newtype GlyphRangesBuilder = GlyphRangesBuilder (Ptr ImFontGlyphRangesBuilder)
newtype GlyphRangesVector = GlyphRangesVector (Ptr ())
new :: MonadIO m => m GlyphRangesBuilder
new :: forall (m :: * -> *). MonadIO m => m GlyphRangesBuilder
new = IO GlyphRangesBuilder -> m GlyphRangesBuilder
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
Ptr ImFontGlyphRangesBuilder -> GlyphRangesBuilder
GlyphRangesBuilder (Ptr ImFontGlyphRangesBuilder -> GlyphRangesBuilder)
-> IO (Ptr ImFontGlyphRangesBuilder) -> IO GlyphRangesBuilder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImFontGlyphRangesBuilder)
[C.block|
ImFontGlyphRangesBuilder* {
return IM_NEW(ImFontGlyphRangesBuilder);
}
|]
destroy :: MonadIO m => GlyphRangesBuilder -> m ()
destroy :: forall (m :: * -> *). MonadIO m => GlyphRangesBuilder -> m ()
destroy (GlyphRangesBuilder Ptr ImFontGlyphRangesBuilder
builder) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
[C.block|
void {
IM_DELETE($(ImFontGlyphRangesBuilder* builder));
}
|]
addChar :: MonadIO m => GlyphRangesBuilder -> ImWchar -> m ()
addChar :: forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> ImWchar -> m ()
addChar (GlyphRangesBuilder Ptr ImFontGlyphRangesBuilder
builder) ImWchar
wChar = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
[C.block|
void {
$(ImFontGlyphRangesBuilder* builder)->AddChar($(ImWchar wChar));
}
|]
addText :: MonadIO m => GlyphRangesBuilder -> CString -> m ()
addText :: forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> CString -> m ()
addText (GlyphRangesBuilder Ptr ImFontGlyphRangesBuilder
builder) CString
string = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
[C.block|
void {
$(ImFontGlyphRangesBuilder* builder)->AddText($(char* string));
}
|]
addRanges :: MonadIO m => GlyphRangesBuilder -> GlyphRanges -> m()
addRanges :: forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> GlyphRanges -> m ()
addRanges (GlyphRangesBuilder Ptr ImFontGlyphRangesBuilder
builder) (GlyphRanges Ptr ImWchar
ranges) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
[C.block|
void {
$(ImFontGlyphRangesBuilder* builder)->AddRanges($(ImWchar* ranges));
}
|]
buildRangesVector :: MonadIO m => GlyphRangesBuilder -> m (GlyphRangesVector)
buildRangesVector :: forall (m :: * -> *).
MonadIO m =>
GlyphRangesBuilder -> m GlyphRangesVector
buildRangesVector (GlyphRangesBuilder Ptr ImFontGlyphRangesBuilder
builder) = IO GlyphRangesVector -> m GlyphRangesVector
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
Ptr () -> GlyphRangesVector
GlyphRangesVector (Ptr () -> GlyphRangesVector)
-> IO (Ptr ()) -> IO GlyphRangesVector
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block|
void* {
ImVector<ImWchar>* ranges = IM_NEW(ImVector<ImWchar>);
$(ImFontGlyphRangesBuilder* builder)->BuildRanges(ranges);
return ranges;
}
|]
fromRangesVector :: GlyphRangesVector -> GlyphRanges
fromRangesVector :: GlyphRangesVector -> GlyphRanges
fromRangesVector (GlyphRangesVector Ptr ()
vecPtr) = IO GlyphRanges -> GlyphRanges
forall a. IO a -> a
unsafePerformIO do
Ptr ImWchar -> GlyphRanges
GlyphRanges (Ptr ImWchar -> GlyphRanges) -> IO (Ptr ImWchar) -> IO GlyphRanges
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block|
ImWchar* {
return ((ImVector<ImWchar>*) $(void* vecPtr))->Data;
}
|]
destroyRangesVector :: MonadIO m => GlyphRangesVector -> m ()
destroyRangesVector :: forall (m :: * -> *). MonadIO m => GlyphRangesVector -> m ()
destroyRangesVector (GlyphRangesVector Ptr ()
vecPtr) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
[C.block|
void {
IM_DELETE(((ImVector<ImWchar>*) $(void* vecPtr)));
}
|]