Tidy up image example (#96)

dear-imgui.cabal

@@ -264,7 +264,7 @@ executable image
   import: common
   main-is: Image.hs
   hs-source-dirs: examples/sdl
-  build-depends: sdl2, gl, dear-imgui, managed, vector, hmatrix
+  build-depends: sdl2, gl, dear-imgui, managed, vector
   if (!flag(examples) || !flag(sdl) || !flag(opengl2))
     buildable: False
 

examples/sdl/Image.hs

@@ -2,11 +2,16 @@
 {-# language LambdaCase #-}
 {-# language OverloadedStrings #-}
 
+{- | Drawing an DearImGui image using OpenGL textures.
+
+https://github.com/ocornut/imgui/wiki/Image-Loading-and-Displaying-Examples
+-}
+
 module Main ( main ) where
 
 import Control.Exception
-import Control.Monad.IO.Class
+import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Managed
+import Control.Monad.Managed (managed, managed_, runManaged)
 import DearImGui
 import qualified DearImGui.Raw as Raw
 import DearImGui.OpenGL3
@@ -17,117 +22,143 @@ 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}
+data Texture = Texture
+  { textureID     :: GLuint
+  , textureWidth  :: GLsizei
+  , textureHeight :: GLsizei
+  }
 
--- |Creates a texture in memory
+textureSize :: Texture -> ImVec2
---
+textureSize texture =
--- Reserves space on the texture-memory for width*height
+  ImVec2
+    (fromIntegral $ textureWidth texture)
+    (fromIntegral $ textureHeight texture)
+
+-- | Create a texture pointer in GL memory.
 create2DTexture :: Int -> Int -> IO Texture
-create2DTexture width height = do
+create2DTexture width height =
-  alloca $ \ptr -> do
+  alloca \ptr -> do
     glGenTextures 1 ptr
     tID <- peek ptr
-    return Texture {textureID = tID, textureWidth = fromIntegral width, textureHeight = fromIntegral height}
+    return Texture
+      { textureID     = tID
+      , textureWidth  = fromIntegral width
+      , textureHeight = fromIntegral height
+      }
 
-
+bindTexture :: Texture -> Ptr GLubyte -> IO ()
---createDummyTexture :: IORef Texture -> M.Matrix (Float) -> IO ()
+bindTexture texture dataPtr = do
---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
+  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
-    glTexImage2D GL_TEXTURE_2D 0 GL_RGB width height 0 GL_RGB GL_UNSIGNED_BYTE (castPtr dataPtr)
+    GL_TEXTURE_2D
-    return()
+    0
-  glBindTexture GL_TEXTURE_2D 0
+    GL_RGB
-  return ()
+    (textureWidth texture)
-
+    (textureHeight texture)
-
+    0
-gui :: IO ()
+    GL_RGB
-gui = do
+    GL_UNSIGNED_BYTE
+    (castPtr dataPtr)
+
+fill :: Integral size => size -> size -> VS.Vector GLubyte
+fill width height =
+  VS.generate
+    (3 * fromIntegral width * fromIntegral height)
+    (\i ->
+        case i `mod` 3 of
+          0 -> 0x00
+          1 -> 0x7F
+          2 -> 0xFF
+          _ -> error "assert: 3-byte pitch"
+    )
 
 
+main :: IO ()
+main = 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
+    window <- 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
+    glContext <- managed $ bracket (SDL.glCreateContext window) SDL.glDeleteContext
 
     -- Create an ImGui context
-    _ <- managed $ bracket createContext destroyContext
+    _dearContext <- managed $ bracket createContext destroyContext
 
     -- Initialize ImGui's SDL2 backend
-    _ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown
+    managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
 
     -- Initialize ImGui's OpenGL backend
-    _ <- managed_ $ bracket_ openGL3Init (do 
+    managed_ $ bracket_ openGL3Init do
       putStrLn "ImguiOpenGL shut down"
-      openGL3Shutdown)
+      openGL3Shutdown
 
-
+    liftIO do
-    liftIO $ do 
+      let width = 320
-      txt <- create2DTexture 500 500 
+          height = 240
-      createDummyTexture txt
+      texture <- create2DTexture width height
+      VS.unsafeWith (fill width height) $
+        bindTexture texture
       err <- glGetError
       putStrLn $ "Error-code: " ++ show err
 
-    liftIO $ do
+      mainLoop window texture
-      mainLoop w 1 -- 1 is actually the Ptr address
-
-
-mainLoop :: SDL.Window ->  GLuint -> IO ()
-mainLoop w c = do
-  -- Process the event loop
-  untilNothingM pollEventWithImGui
 
+mainLoop :: SDL.Window -> Texture -> IO ()
+mainLoop window texture = unlessQuit do
   -- Tell ImGui we're starting a new frame
   openGL3NewFrame
   sdl2NewFrame
   newFrame
 
   -- Build the GUI
-  bracket_ (begin "GL") end $ do
+  withWindowOpen "Image example" $ runManaged do
---    image (intPtrToPtr $ fromIntegral c) (ImVec2 500 500)(ImVec2 0 0)(ImVec2 1 1)(ImVec4 1 1 1 1)(ImVec4 0 0 0 0)
+    -- Drawing images require some backend-specific code.
-    Foreign.with (ImVec2 500 500) \sizePtr ->
+    -- Meanwhile, we have to deal with raw binding.
-      Foreign.with (ImVec2 0 0) \uv0Ptr -> 
+    let openGLtextureID = intPtrToPtr $ fromIntegral $ textureID texture
-        Foreign.with (ImVec2 1 1) \uv1Ptr -> 
+    sizePtr <- managed $ Foreign.with (textureSize texture)
-          Foreign.with (ImVec4 1 1 1 1) \tintColPtr -> 
+    uv0Ptr <- managed $ Foreign.with (ImVec2 0 0)
-            Foreign.with (ImVec4 0 0 0 0) \borderColPtr -> do
+    uv1Ptr <- managed $ Foreign.with (ImVec2 1 1)
-              Raw.image (intPtrToPtr $ fromIntegral c) sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr
+    tintColPtr <- managed $ Foreign.with (ImVec4 1 1 1 1)
+    borderColPtr <- managed $ Foreign.with (ImVec4 0 1 0 0)
+    Raw.image openGLtextureID sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr
 
   -- Render
-  render
   glClear GL_COLOR_BUFFER_BIT
 
-  openGL3RenderDrawData =<< getDrawData
+  DearImGui.render
+  DearImGui.getDrawData >>= openGL3RenderDrawData
 
-  SDL.glSwapWindow w
+  SDL.glSwapWindow window
 
-  mainLoop w c
+  mainLoop window texture
 
   where
-    untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
+    unlessQuit action = do
+      shouldQuit <- checkEvents
+      if shouldQuit then pure () else action
 
-main = do gui
+    checkEvents = do
+      pollEventWithImGui >>= \case
+        Nothing ->
+          return False
+        Just event ->
+          (isQuit event ||) <$> checkEvents
+
+    isQuit event =
+      SDL.eventPayload event == SDL.QuitEvent

src/DearImGui/Raw.hs

@@ -559,17 +559,13 @@ arrowButton strIdPtr dir = liftIO do
   (0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(ImGuiDir dir)) } |]
 
 
--- | Image Area to draw a texture
+-- | Image Area to draw a texture.
 --
--- Wraps @ImGui::Image()
+-- For OpenGL: The @userTextureIDPtr@ points to the texture memory (eg. @0x0000000000000001@)
 --
--- For OpenGL: The userTextureIDPtr points to the texture memory (eg. 0x0x0000000000000001), it is the number from glBindTexture.
+-- See @examples/sdl/Image.hs@ for the whole process.
--- 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
+-- Wraps @ImGui::Image()@.
 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 {