{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

{-|
Module: DearImGUI.SDL.OpenGL

Initialising the OpenGL backend for Dear ImGui using SDL2.
-}

module DearImGui.SDL.OpenGL
  ( sdl2InitForOpenGL )
  where

-- base
import Foreign.Ptr
  ( Ptr )
import Unsafe.Coerce
  ( unsafeCoerce )

-- inline-c
import qualified Language.C.Inline as C

-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp

-- sdl2
import SDL
  ( GLContext )
import SDL.Internal.Types
  ( Window(..) )

-- transformers
import Control.Monad.IO.Class
  ( MonadIO, liftIO )


C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_opengl2.h"
C.include "backends/imgui_impl_sdl2.h"
C.include "SDL.h"
C.include "SDL_opengl.h"
Cpp.using "namespace ImGui"


-- | Wraps @ImGui_ImplSDL2_InitForOpenGL@.
sdl2InitForOpenGL :: MonadIO m => Window -> GLContext -> m Bool
sdl2InitForOpenGL :: forall (m :: * -> *). MonadIO m => Window -> GLContext -> m Bool
sdl2InitForOpenGL (Window Window
windowPtr) GLContext
glContext = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ( CBool
0 CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= ) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| bool { ImGui_ImplSDL2_InitForOpenGL((SDL_Window*)$(void* windowPtr), $(void* glContextPtr)) } |]
  where
    glContextPtr :: Ptr ()
    glContextPtr :: Window
glContextPtr = GLContext -> Window
forall a b. a -> b
unsafeCoerce GLContext
glContext