From f3b85899f20e222435749959fca95ac9901a69f8 Mon Sep 17 00:00:00 2001
From: jpwidera <30520224+jpwidera@users.noreply.github.com>
Date: Sun, 12 Sep 2021 12:35:03 +0200
Subject: [PATCH] Added image wrapper (#74)

Raw.image and sdl2/gl example "image"

Wrappers should be backend-specific due to different handling of `userTextureIDPtr`.
---
 dear-imgui.cabal      |   8 +++
 examples/sdl/Image.hs | 133 ++++++++++++++++++++++++++++++++++++++++++
 src/DearImGui.hs      |   1 +
 src/DearImGui/Raw.hs  |  26 +++++++++
 4 files changed, 168 insertions(+)
 create mode 100644 examples/sdl/Image.hs

diff --git a/dear-imgui.cabal b/dear-imgui.cabal
index 23b4c57..9043844 100644
--- a/dear-imgui.cabal
+++ b/dear-imgui.cabal
@@ -260,6 +260,14 @@ executable readme
   if (!flag(examples) || !flag(sdl) || !flag(opengl2))
     buildable: False
 
+executable image
+  import: common
+  main-is: Image.hs
+  hs-source-dirs: examples/sdl
+  build-depends: sdl2, gl, dear-imgui, managed, vector, hmatrix
+  if (!flag(examples) || !flag(sdl) || !flag(opengl2))
+    buildable: False
+
 executable vulkan
   import: common
   main-is: Main.hs
diff --git a/examples/sdl/Image.hs b/examples/sdl/Image.hs
new file mode 100644
index 0000000..de7fcbb
--- /dev/null
+++ b/examples/sdl/Image.hs
@@ -0,0 +1,133 @@
+{-# language BlockArguments #-}
+{-# language LambdaCase #-}
+{-# language OverloadedStrings #-}
+
+module Main ( main ) where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import Control.Monad.Managed
+import DearImGui
+import qualified DearImGui.Raw as Raw
+import DearImGui.OpenGL3
+import DearImGui.SDL
+import DearImGui.SDL.OpenGL
+import Graphics.GL
+import qualified SDL as SDL
+
+--  For the texture creation
+import Foreign
+import Foreign.Ptr
+import qualified Numeric.LinearAlgebra as M
+import Foreign.Marshal.Alloc
+import Data.IORef
+import qualified Data.Vector.Storable as VS
+
+data Texture = Texture {textureID :: GLuint, textureWidth :: GLsizei, textureHeight :: GLsizei}
+
+-- |Creates a texture in memory
+--
+-- Reserves space on the texture-memory for width*height
+create2DTexture :: Int -> Int -> IO Texture
+create2DTexture width height = do
+  alloca $ \ptr -> do
+    glGenTextures 1 ptr
+    tID <- peek ptr
+    return Texture {textureID = tID, textureWidth = fromIntegral width, textureHeight = fromIntegral height}
+    
+
+--createDummyTexture :: IORef Texture -> M.Matrix (Float) -> IO ()
+--createDummyTexture texture matrix = do
+createDummyTexture :: Texture -> IO ()
+createDummyTexture texture = do
+  let width = textureWidth texture
+  let height = textureWidth texture
+  glEnable GL_TEXTURE_2D
+  glBindTexture GL_TEXTURE_2D $ textureID texture
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT
+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT
+  let dat = VS.generate (3*(fromIntegral width)*(fromIntegral height)) (\i -> fromIntegral $ 17 + (50 * (i `mod` 3)):: GLubyte) :: VS.Vector GLubyte -- some blueish
+  VS.unsafeWith dat $ \dataPtr -> do
+    glTexImage2D GL_TEXTURE_2D 0 GL_RGB width height 0 GL_RGB GL_UNSIGNED_BYTE (castPtr dataPtr)
+    return()
+  glBindTexture GL_TEXTURE_2D 0
+  return ()
+
+
+gui :: IO ()
+gui = do
+
+
+  -- Initialize SDL
+  SDL.initializeAll
+
+
+
+  runManaged do
+    -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
+    w <- do
+      let title = "Hello, Dear ImGui!"
+      let config = SDL.defaultWindow { SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL, SDL.windowResizable = True }
+      managed $ bracket (SDL.createWindow title config) SDL.destroyWindow
+
+    -- Create an OpenGL context
+    glContext <- managed $ bracket (SDL.glCreateContext w) SDL.glDeleteContext
+
+    -- Create an ImGui context
+    _ <- managed $ bracket createContext destroyContext
+
+    -- Initialize ImGui's SDL2 backend
+    _ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown
+
+    -- Initialize ImGui's OpenGL backend
+    _ <- managed_ $ bracket_ openGL3Init (do 
+      putStrLn "ImguiOpenGL shut down"
+      openGL3Shutdown)
+
+
+    liftIO $ do 
+      txt <- create2DTexture 500 500 
+      createDummyTexture txt
+      err <- glGetError
+      putStrLn $  "Error-code: " ++ show err
+     
+    liftIO $ do
+      mainLoop w 1 -- 1 is actually the Ptr address
+
+
+mainLoop :: SDL.Window ->  GLuint -> IO ()
+mainLoop w c = do
+  -- Process the event loop
+  untilNothingM pollEventWithImGui
+
+  -- Tell ImGui we're starting a new frame
+  openGL3NewFrame
+  sdl2NewFrame
+  newFrame
+
+  -- Build the GUI
+  bracket_ (begin "GL") end $ do
+--    image (intPtrToPtr $ fromIntegral c) (ImVec2 500 500)(ImVec2 0 0)(ImVec2 1 1)(ImVec4 1 1 1 1)(ImVec4 0 0 0 0)
+    Foreign.with (ImVec2 500 500) \sizePtr ->
+      Foreign.with (ImVec2 0 0) \uv0Ptr -> 
+        Foreign.with (ImVec2 1 1) \uv1Ptr -> 
+          Foreign.with (ImVec4 1 1 1 1) \tintColPtr -> 
+            Foreign.with (ImVec4 0 0 0 0) \borderColPtr -> do
+              Raw.image (intPtrToPtr $ fromIntegral c) sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr
+
+  -- Render
+  render
+  glClear GL_COLOR_BUFFER_BIT
+
+  openGL3RenderDrawData =<< getDrawData
+
+  SDL.glSwapWindow w
+
+  mainLoop w c
+
+  where
+    untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
+
+main = do gui
diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index a96b3b6..feabc61 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -125,6 +125,7 @@ module DearImGui
   , smallButton
   , invisibleButton
   , arrowButton
+  , Raw.image
   , checkbox
   , progressBar
   , Raw.bullet
diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs
index 93e49e0..0969257 100644
--- a/src/DearImGui/Raw.hs
+++ b/src/DearImGui/Raw.hs
@@ -105,6 +105,7 @@ module DearImGui.Raw
   , smallButton
   , invisibleButton
   , arrowButton
+  , image
   , checkbox
   , progressBar
   , bullet
@@ -558,6 +559,31 @@ arrowButton strIdPtr dir = liftIO do
   (0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(ImGuiDir dir)) } |]
 
 
+-- | Image Area to draw a texture
+--
+-- Wraps @ImGui::Image()
+--
+-- For OpenGL: The userTextureIDPtr points to the texture memory (eg. 0x0x0000000000000001), it is the number from glBindTexture.
+-- Eg:
+-- glBindTexture GL_TEXTURE_2D $ textureID texture
+-- -- fill textureID
+-- image (intPtrToPtr $ fromIntegral textureID) (ImVec2 500 500)(ImVec2 0 0)(ImVec2 1 1)(ImVec4 1 1 1 1)(ImVec4 0 0 0 0)
+--
+-- See https://github.com/ocornut/imgui/wiki/Image-Loading-and-Displaying-Examples#About-texture-coordinates and under examples/sdl/Image.hs
+image :: (MonadIO m) => Ptr ()->  Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m()
+image userTextureIDPtr sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr = liftIO do
+  [C.exp| void { 
+    Image(
+      $(void* userTextureIDPtr), 
+      *$(ImVec2* sizePtr),
+      *$(ImVec2* uv0Ptr),
+      *$(ImVec2* uv1Ptr),
+      *$(ImVec4* tintColPtr),
+      *$(ImVec4* borderColPtr)
+    )
+  } |]
+
+
 -- | Wraps @ImGui::Checkbox()@.
 checkbox :: (MonadIO m) => CString -> Ptr CBool -> m Bool
 checkbox labelPtr boolPtr = liftIO do