diff --git a/examples/sdl/Image.hs b/examples/sdl/Image.hs index 1aa1bcc..020fa19 100644 --- a/examples/sdl/Image.hs +++ b/examples/sdl/Image.hs @@ -29,6 +29,7 @@ data Texture = Texture , textureWidth :: GLsizei , textureHeight :: GLsizei } + deriving (Show) textureSize :: Texture -> ImVec2 textureSize texture = @@ -69,17 +70,20 @@ bindTexture texture dataPtr = do GL_UNSIGNED_BYTE (castPtr dataPtr) -fill :: Integral size => size -> size -> VS.Vector GLubyte -fill width height = +fill :: Texture -> (GLubyte, GLubyte, GLubyte) -> VS.Vector GLubyte +fill texture (r, g, b) = VS.generate - (3 * fromIntegral width * fromIntegral height) + (3 * width * height) (\i -> case i `mod` 3 of - 0 -> 0x00 - 1 -> 0x7F - 2 -> 0xFF + 0 -> r + 1 -> g + 2 -> b _ -> error "assert: 3-byte pitch" ) + where + width = fromIntegral (textureWidth texture) + height = fromIntegral (textureHeight texture) main :: IO () @@ -109,34 +113,47 @@ main = do openGL3Shutdown liftIO do - let width = 320 - height = 240 - texture <- create2DTexture width height - VS.unsafeWith (fill width height) $ - bindTexture texture + blueish <- create2DTexture 320 240 + VS.unsafeWith (fill blueish (0x00, 0x7F, 0xFF)) $ + bindTexture blueish + + pinkish <- create2DTexture 240 320 + VS.unsafeWith (fill pinkish (0xFF, 0x00, 0x7F)) $ + bindTexture pinkish + err <- glGetError putStrLn $ "Error-code: " ++ show err - mainLoop window texture + print (blueish, pinkish) + mainLoop window (blueish, pinkish) False -mainLoop :: SDL.Window -> Texture -> IO () -mainLoop window texture = unlessQuit do +mainLoop :: SDL.Window -> (Texture, Texture) -> Bool -> IO () +mainLoop window textures flag = unlessQuit do -- Tell ImGui we're starting a new frame openGL3NewFrame sdl2NewFrame newFrame -- Build the GUI - withWindowOpen "Image example" $ runManaged do - -- Drawing images require some backend-specific code. - -- Meanwhile, we have to deal with raw binding. - let openGLtextureID = intPtrToPtr $ fromIntegral $ textureID texture - sizePtr <- managed $ Foreign.with (textureSize texture) - uv0Ptr <- managed $ Foreign.with (ImVec2 0 0) - uv1Ptr <- managed $ Foreign.with (ImVec2 1 1) - 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 + clicked <- withWindow "Image example" \open -> + if open then do + text "That's an image, click it" + newLine + + let texture = if flag then fst textures else snd textures + + -- Drawing images require some backend-specific code. + -- Meanwhile, we have to deal with raw binding. + let openGLtextureID = intPtrToPtr $ fromIntegral $ textureID texture + + Foreign.with (textureSize texture) \sizePtr -> + Foreign.with (ImVec2 0 0) \uv0Ptr -> + Foreign.with (ImVec2 1 1) \uv1Ptr -> + Foreign.with (ImVec4 1 1 1 1) \tintColPtr -> + Foreign.with (ImVec4 1 1 1 1) \bgColPtr -> + Raw.imageButton openGLtextureID sizePtr uv0Ptr uv1Ptr (-1) bgColPtr tintColPtr + else + pure False -- Render glClear GL_COLOR_BUFFER_BIT @@ -146,7 +163,7 @@ mainLoop window texture = unlessQuit do SDL.glSwapWindow window - mainLoop window texture + mainLoop window textures (flag /= clicked) where unlessQuit action = do diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs index 4e3d853..c360c0b 100644 --- a/src/DearImGui/Raw.hs +++ b/src/DearImGui/Raw.hs @@ -106,6 +106,7 @@ module DearImGui.Raw , invisibleButton , arrowButton , image + , imageButton , checkbox , progressBar , bullet @@ -568,16 +569,39 @@ arrowButton strIdPtr dir = liftIO do -- 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 { - Image( - $(void* userTextureIDPtr), - *$(ImVec2* sizePtr), - *$(ImVec2* uv0Ptr), - *$(ImVec2* uv1Ptr), - *$(ImVec4* tintColPtr), - *$(ImVec4* borderColPtr) - ) - } |] + [C.exp| + void { + Image( + $(void* userTextureIDPtr), + *$(ImVec2* sizePtr), + *$(ImVec2* uv0Ptr), + *$(ImVec2* uv1Ptr), + *$(ImVec4* tintColPtr), + *$(ImVec4* borderColPtr) + ) + } + |] + +-- | Clickable Image Area. +-- +-- Negative @frame_padding@ uses default frame padding settings. Set to 0 for no padding. +-- +-- Wraps @ImGui::ImageButton()@. +imageButton :: (MonadIO m) => Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> CInt -> Ptr ImVec4 -> Ptr ImVec4 -> m Bool +imageButton userTextureIDPtr sizePtr uv0Ptr uv1Ptr framePadding bgColPtr tintColPtr = liftIO do + (0 /=) <$> [C.exp| + bool { + ImageButton( + $(void* userTextureIDPtr), + *$(ImVec2* sizePtr), + *$(ImVec2* uv0Ptr), + *$(ImVec2* uv1Ptr), + $(int framePadding), + *$(ImVec4* bgColPtr), + *$(ImVec4* tintColPtr) + ) + } + |] -- | Wraps @ImGui::Checkbox()@.