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