Main.hs

{-# 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 qualified DearImGui.Impl.OpenGL2 as ImplGL2
import qualified DearImGui.Impl.SDL2 as ImplSDL2
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_ $ ImplSDL2.withInitForOpenGL window glContext
    _ <- managed_ ImplGL2.withInit

    -- 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
            "./examples/fonts/NotoSansJP-Regular.otf"
            (Just 15)
            Nothing

        -- 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"
            (Just 15)
            Nothing
      }

    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 $
            pushFontLegacySize 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
    ImplGL2.newFrame
    ImplSDL2.newFrame
    newFrame

    frameAction

    glClear GL_COLOR_BUFFER_BIT
    render
    ImplGL2.renderDrawData =<< getDrawData
    glSwapWindow window

    loop

  unlessQuit action = do
    shouldQuit <- checkEvents
    if shouldQuit then pure () else action

  checkEvents = do
    ImplSDL2.pollEvent >>= \case
      Nothing ->
        return False
      Just event ->
        (isQuit event ||) <$> checkEvents

  isQuit event =
    SDL.eventPayload event == SDL.QuitEvent