{-# 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 :: forall (m :: * -> *). MonadIO m => m Font
addFontDefault = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Ptr ImFont -> Font
Font (Ptr ImFont -> Font) -> IO (Ptr ImFont) -> IO Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 :: forall (m :: * -> *).
MonadIO m =>
CString -> CFloat -> FontConfig -> GlyphRanges -> m Font
addFontFromFileTTF CString
filenamePtr CFloat
sizePixels (FontConfig Ptr ImFontConfig
fontConfig) (GlyphRanges Ptr ImWchar
glyphRanges) = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Ptr ImFont -> Font
Font (Ptr ImFont -> Font) -> IO (Ptr ImFont) -> IO Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 :: forall (m :: * -> *).
MonadIO m =>
CStringLen -> CFloat -> FontConfig -> GlyphRanges -> m Font
addFontFromMemoryTTF (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
fontDataPtr, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
fontSize) CFloat
sizePixels (FontConfig Ptr ImFontConfig
fontConfig) (GlyphRanges Ptr ImWchar
glyphRanges) = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Ptr ImFont -> Font
Font (Ptr ImFont -> Font) -> IO (Ptr ImFont) -> IO Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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 :: forall (m :: * -> *). MonadIO m => Font -> m ()
pushFont (Font Ptr ImFont
font) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 :: forall (m :: * -> *). MonadIO m => m ()
popFont = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.exp| void { PopFont(); } |]

-- | Explicitly build pixels data for the atlas.
buildFontAtlas :: MonadIO m => m ()
buildFontAtlas :: forall (m :: * -> *). MonadIO m => m ()
buildFontAtlas = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      GetIO().Fonts->Build();
    }
  |]

-- | Clear all font atlas input and output data
clearFontAtlas :: MonadIO m => m ()
clearFontAtlas :: forall (m :: * -> *). MonadIO m => m ()
clearFontAtlas = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      GetIO().Fonts->Clear();
    }
  |]