mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2025-07-04 20:18:47 +02:00
Compare commits
25 Commits
Author | SHA1 | Date | |
---|---|---|---|
97825e49f2 | |||
24345bb8f3 | |||
e3f7fbfd6f | |||
88326420b8 | |||
f3b85899f2 | |||
c7a694bce8 | |||
c219f8eb4f | |||
24519778e6 | |||
4bfc7e7099 | |||
efaaa5723a | |||
be7aa1e9b1 | |||
08b3139477 | |||
cede825dff | |||
84a6b8a8fe | |||
cb687b8f01 | |||
8d07a5a42b | |||
d3a0396623 | |||
f49e81c739 | |||
5699f64e95 | |||
9e5b39850e | |||
d7dc999e8b | |||
bde2030c25 | |||
1706b7e966 | |||
bfe8453891 | |||
532eebd8ed |
38
ChangeLog.md
Normal file
38
ChangeLog.md
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
# Changelog for dear-imgui
|
||||||
|
|
||||||
|
## [1.2.0]
|
||||||
|
|
||||||
|
- Fixed `nullPtr` in place of default arguments.
|
||||||
|
- Added functions for getting window position and size.
|
||||||
|
- Added `invisibleButton`.
|
||||||
|
- Added `inputTextMultiline` and `inputTextWithHint`.
|
||||||
|
- Changed `beginChild` and related `withChild*` to use full arguments.
|
||||||
|
- Added `withChildContext` to run actions inside other child window.
|
||||||
|
- Added `getCurrentContext`, `setCurrentContext`.
|
||||||
|
- Added `image` and `imageButton`.
|
||||||
|
- Added font atlas utilities.
|
||||||
|
|
||||||
|
## [1.1.0]
|
||||||
|
|
||||||
|
- `imgui` updated to 1.84.2.
|
||||||
|
- Removed unused Window argument from SDL `newFrame` to match 1.84.
|
||||||
|
- Added GLFW backend callbacks.
|
||||||
|
- Added more withXXX wrappers.
|
||||||
|
|
||||||
|
## [1.0.2]
|
||||||
|
|
||||||
|
- Added `withID` and `ToID(..)` to make composable components possible.
|
||||||
|
|
||||||
|
## [1.0.1]
|
||||||
|
|
||||||
|
- Fixed missing headers in source dist.
|
||||||
|
|
||||||
|
## [1.0.0]
|
||||||
|
|
||||||
|
Initial Hackage release based on 1.83.
|
||||||
|
|
||||||
|
[1.0.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.0
|
||||||
|
[1.0.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.1
|
||||||
|
[1.0.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.2
|
||||||
|
[1.1.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.1.0
|
||||||
|
[1.2.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.2.0
|
40
Main.hs
40
Main.hs
@ -38,26 +38,24 @@ main = do
|
|||||||
tab2 <- newIORef True
|
tab2 <- newIORef True
|
||||||
loop w checked color slider r pos size' selected tab1 tab2
|
loop w checked color slider r pos size' selected tab1 tab2
|
||||||
|
|
||||||
openGL3Shutdown
|
|
||||||
|
|
||||||
|
loop
|
||||||
loop
|
:: Window
|
||||||
:: Window
|
-> IORef Bool
|
||||||
-> IORef Bool
|
-> IORef ImVec3
|
||||||
-> IORef ImVec3
|
-> IORef (Float, Float, Float)
|
||||||
-> IORef (Float, Float, Float)
|
-> IORef Int
|
||||||
-> IORef Int
|
|
||||||
-> IORef ImVec2
|
|
||||||
-> IORef ImVec2
|
-> IORef ImVec2
|
||||||
-> IORef Int
|
-> IORef ImVec2
|
||||||
|
-> IORef Int
|
||||||
-> IORef Bool
|
-> IORef Bool
|
||||||
-> IORef Bool
|
-> IORef Bool
|
||||||
-> IO ()
|
-> IO ()
|
||||||
loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||||
quit <- pollEvents
|
shouldQuit <- checkEvents
|
||||||
|
|
||||||
openGL3NewFrame
|
openGL3NewFrame
|
||||||
sdl2NewFrame w
|
sdl2NewFrame
|
||||||
newFrame
|
newFrame
|
||||||
|
|
||||||
-- showDemoWindow
|
-- showDemoWindow
|
||||||
@ -68,7 +66,7 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
|||||||
setNextWindowPos pos ImGuiCond_Once Nothing
|
setNextWindowPos pos ImGuiCond_Once Nothing
|
||||||
setNextWindowSize size' ImGuiCond_Once
|
setNextWindowSize size' ImGuiCond_Once
|
||||||
-- Works, but will make the window contents illegible without doing something more involved.
|
-- Works, but will make the window contents illegible without doing something more involved.
|
||||||
-- setNextWindowContentSize size'
|
-- setNextWindowContentSize size'
|
||||||
-- setNextWindowSizeConstraints size' size'
|
-- setNextWindowSizeConstraints size' size'
|
||||||
setNextWindowCollapsed False ImGuiCond_Once
|
setNextWindowCollapsed False ImGuiCond_Once
|
||||||
|
|
||||||
@ -122,7 +120,7 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
|||||||
|
|
||||||
progressBar 0.314 (Just "Pi")
|
progressBar 0.314 (Just "Pi")
|
||||||
|
|
||||||
beginChild "Child"
|
beginChild "Child" (ImVec2 0 0) True ImGuiWindowFlags_None
|
||||||
|
|
||||||
beginCombo "Label" "Preview" >>= whenTrue do
|
beginCombo "Label" "Preview" >>= whenTrue do
|
||||||
selectable "Testing 1"
|
selectable "Testing 1"
|
||||||
@ -164,13 +162,15 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
|||||||
glClear GL_COLOR_BUFFER_BIT
|
glClear GL_COLOR_BUFFER_BIT
|
||||||
openGL3RenderDrawData =<< getDrawData
|
openGL3RenderDrawData =<< getDrawData
|
||||||
|
|
||||||
glSwapWindow w
|
glSwapWindow window
|
||||||
|
|
||||||
if quit then return () else loop w checked color slider r pos size' selected tab1Ref tab2Ref
|
if shouldQuit
|
||||||
|
then return ()
|
||||||
|
else loop window checked color slider r pos size' selected tab1Ref tab2Ref
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
||||||
pollEvents = do
|
checkEvents = do
|
||||||
ev <- pollEventWithImGui
|
ev <- pollEventWithImGui
|
||||||
|
|
||||||
case ev of
|
case ev of
|
||||||
@ -180,9 +180,9 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
|||||||
QuitEvent -> True
|
QuitEvent -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
(isQuit ||) <$> pollEvents
|
(isQuit ||) <$> checkEvents
|
||||||
|
|
||||||
|
|
||||||
whenTrue :: IO () -> Bool -> IO ()
|
whenTrue :: IO () -> Bool -> IO ()
|
||||||
whenTrue io True = io
|
whenTrue io True = io
|
||||||
whenTrue io False = return ()
|
whenTrue _io False = return ()
|
||||||
|
@ -25,7 +25,7 @@ OpenGL:
|
|||||||
|
|
||||||
```
|
```
|
||||||
package dear-imgui
|
package dear-imgui
|
||||||
flags: +sdl +opengl
|
flags: +sdl +opengl3
|
||||||
```
|
```
|
||||||
|
|
||||||
With this done, the following module is the "Hello, World!" of ImGui:
|
With this done, the following module is the "Hello, World!" of ImGui:
|
||||||
@ -81,7 +81,7 @@ mainLoop w = do
|
|||||||
|
|
||||||
-- Tell ImGui we're starting a new frame
|
-- Tell ImGui we're starting a new frame
|
||||||
openGL2NewFrame
|
openGL2NewFrame
|
||||||
sdl2NewFrame w
|
sdl2NewFrame
|
||||||
newFrame
|
newFrame
|
||||||
|
|
||||||
-- Build the GUI
|
-- Build the GUI
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
packages: *.cabal
|
packages: *.cabal
|
||||||
package dear-imgui
|
package dear-imgui
|
||||||
flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
|
flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
|
||||||
|
ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind
|
||||||
|
@ -1,9 +1,32 @@
|
|||||||
cabal-version: 3.0
|
cabal-version: 3.0
|
||||||
|
|
||||||
name: dear-imgui
|
name: dear-imgui
|
||||||
version: 1.0.0
|
version: 1.2.0
|
||||||
|
author: Oliver Charles
|
||||||
|
maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
|
||||||
|
license: BSD-3-Clause
|
||||||
|
|
||||||
|
category: Graphics
|
||||||
|
synopsis: Haskell bindings for Dear ImGui.
|
||||||
|
description:
|
||||||
|
The package supports multiple rendering backends.
|
||||||
|
Set package flags according to your needs.
|
||||||
|
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
data-files:
|
extra-source-files:
|
||||||
imgui/imgui.h
|
README.md,
|
||||||
|
ChangeLog.md
|
||||||
|
|
||||||
|
extra-source-files:
|
||||||
|
imgui/*.h,
|
||||||
|
imgui/backends/*.h,
|
||||||
|
imgui/backends/*.mm,
|
||||||
|
imgui/imconfig.h,
|
||||||
|
imgui/LICENSE.txt
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: https://github.com/haskell-game/dear-imgui.hs
|
||||||
|
|
||||||
flag opengl2
|
flag opengl2
|
||||||
description:
|
description:
|
||||||
@ -158,7 +181,8 @@ library
|
|||||||
exposed-modules:
|
exposed-modules:
|
||||||
DearImGui.GLFW
|
DearImGui.GLFW
|
||||||
build-depends:
|
build-depends:
|
||||||
GLFW-b
|
GLFW-b,
|
||||||
|
bindings-GLFW
|
||||||
cxx-sources:
|
cxx-sources:
|
||||||
imgui/backends/imgui_impl_glfw.cpp
|
imgui/backends/imgui_impl_glfw.cpp
|
||||||
|
|
||||||
@ -196,7 +220,7 @@ library dear-imgui-generator
|
|||||||
, megaparsec
|
, megaparsec
|
||||||
>= 9.0 && < 9.1
|
>= 9.0 && < 9.1
|
||||||
, parser-combinators
|
, parser-combinators
|
||||||
>= 1.2.0 && < 1.3
|
>= 1.2.0 && < 1.4
|
||||||
, scientific
|
, scientific
|
||||||
>= 0.3.6.2 && < 0.3.8
|
>= 0.3.6.2 && < 0.3.8
|
||||||
, text
|
, text
|
||||||
@ -236,6 +260,14 @@ executable readme
|
|||||||
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
|
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
|
||||||
buildable: False
|
buildable: False
|
||||||
|
|
||||||
|
executable image
|
||||||
|
import: common
|
||||||
|
main-is: Image.hs
|
||||||
|
hs-source-dirs: examples/sdl
|
||||||
|
build-depends: sdl2, gl, dear-imgui, managed, vector
|
||||||
|
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
|
||||||
|
buildable: False
|
||||||
|
|
||||||
executable vulkan
|
executable vulkan
|
||||||
import: common
|
import: common
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
@ -24,34 +24,34 @@ main = do
|
|||||||
|
|
||||||
runManaged do
|
runManaged do
|
||||||
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
|
-- 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 title = "Hello, Dear ImGui!"
|
||||||
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
|
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
|
||||||
managed $ bracket (createWindow title config) destroyWindow
|
managed $ bracket (createWindow title config) destroyWindow
|
||||||
|
|
||||||
-- Create an OpenGL context
|
-- Create an OpenGL context
|
||||||
glContext <- managed $ bracket (glCreateContext w) glDeleteContext
|
glContext <- managed $ bracket (glCreateContext window) glDeleteContext
|
||||||
|
|
||||||
-- Create an ImGui context
|
-- Create an ImGui context
|
||||||
_ <- managed $ bracket createContext destroyContext
|
_ <- managed $ bracket createContext destroyContext
|
||||||
|
|
||||||
-- Initialize ImGui's SDL2 backend
|
-- Initialize ImGui's SDL2 backend
|
||||||
_ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown
|
_ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
|
||||||
|
|
||||||
-- Initialize ImGui's OpenGL backend
|
-- Initialize ImGui's OpenGL backend
|
||||||
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
|
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
|
||||||
|
|
||||||
liftIO $ mainLoop w
|
liftIO $ mainLoop window
|
||||||
|
|
||||||
|
|
||||||
mainLoop :: Window -> IO ()
|
mainLoop :: Window -> IO ()
|
||||||
mainLoop w = do
|
mainLoop window = do
|
||||||
-- Process the event loop
|
-- Process the event loop
|
||||||
untilNothingM pollEventWithImGui
|
untilNothingM pollEventWithImGui
|
||||||
|
|
||||||
-- Tell ImGui we're starting a new frame
|
-- Tell ImGui we're starting a new frame
|
||||||
openGL2NewFrame
|
openGL2NewFrame
|
||||||
sdl2NewFrame w
|
sdl2NewFrame
|
||||||
newFrame
|
newFrame
|
||||||
|
|
||||||
-- Build the GUI
|
-- Build the GUI
|
||||||
@ -73,9 +73,9 @@ mainLoop w = do
|
|||||||
render
|
render
|
||||||
openGL2RenderDrawData =<< getDrawData
|
openGL2RenderDrawData =<< getDrawData
|
||||||
|
|
||||||
glSwapWindow w
|
glSwapWindow window
|
||||||
|
|
||||||
mainLoop w
|
mainLoop window
|
||||||
|
|
||||||
where
|
where
|
||||||
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
|
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
|
||||||
|
181
examples/sdl/Image.hs
Normal file
181
examples/sdl/Image.hs
Normal file
@ -0,0 +1,181 @@
|
|||||||
|
{-# language BlockArguments #-}
|
||||||
|
{-# 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 (MonadIO(..))
|
||||||
|
import Control.Monad.Managed (managed, managed_, runManaged)
|
||||||
|
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 qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
|
data Texture = Texture
|
||||||
|
{ textureID :: GLuint
|
||||||
|
, textureWidth :: GLsizei
|
||||||
|
, textureHeight :: GLsizei
|
||||||
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
textureSize :: Texture -> ImVec2
|
||||||
|
textureSize texture =
|
||||||
|
ImVec2
|
||||||
|
(fromIntegral $ textureWidth texture)
|
||||||
|
(fromIntegral $ textureHeight texture)
|
||||||
|
|
||||||
|
-- | Create a texture pointer in GL memory.
|
||||||
|
create2DTexture :: Int -> Int -> IO Texture
|
||||||
|
create2DTexture width height =
|
||||||
|
alloca \ptr -> do
|
||||||
|
glGenTextures 1 ptr
|
||||||
|
tID <- peek ptr
|
||||||
|
return Texture
|
||||||
|
{ textureID = tID
|
||||||
|
, textureWidth = fromIntegral width
|
||||||
|
, textureHeight = fromIntegral height
|
||||||
|
}
|
||||||
|
|
||||||
|
bindTexture :: Texture -> Ptr GLubyte -> IO ()
|
||||||
|
bindTexture texture dataPtr = do
|
||||||
|
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
|
||||||
|
|
||||||
|
glTexImage2D
|
||||||
|
GL_TEXTURE_2D
|
||||||
|
0
|
||||||
|
GL_RGB
|
||||||
|
(textureWidth texture)
|
||||||
|
(textureHeight texture)
|
||||||
|
0
|
||||||
|
GL_RGB
|
||||||
|
GL_UNSIGNED_BYTE
|
||||||
|
(castPtr dataPtr)
|
||||||
|
|
||||||
|
fill :: Texture -> (GLubyte, GLubyte, GLubyte) -> VS.Vector GLubyte
|
||||||
|
fill texture (r, g, b) =
|
||||||
|
VS.generate
|
||||||
|
(3 * width * height)
|
||||||
|
(\i ->
|
||||||
|
case i `mod` 3 of
|
||||||
|
0 -> r
|
||||||
|
1 -> g
|
||||||
|
2 -> b
|
||||||
|
_ -> error "assert: 3-byte pitch"
|
||||||
|
)
|
||||||
|
where
|
||||||
|
width = fromIntegral (textureWidth texture)
|
||||||
|
height = fromIntegral (textureHeight texture)
|
||||||
|
|
||||||
|
|
||||||
|
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.
|
||||||
|
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 window) SDL.glDeleteContext
|
||||||
|
|
||||||
|
-- Create an ImGui context
|
||||||
|
_dearContext <- managed $ bracket createContext destroyContext
|
||||||
|
|
||||||
|
-- Initialize ImGui's SDL2 backend
|
||||||
|
managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
|
||||||
|
|
||||||
|
-- Initialize ImGui's OpenGL backend
|
||||||
|
managed_ $ bracket_ openGL3Init do
|
||||||
|
putStrLn "ImguiOpenGL shut down"
|
||||||
|
openGL3Shutdown
|
||||||
|
|
||||||
|
liftIO do
|
||||||
|
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
|
||||||
|
|
||||||
|
print (blueish, pinkish)
|
||||||
|
mainLoop window (blueish, pinkish) False
|
||||||
|
|
||||||
|
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
|
||||||
|
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
|
||||||
|
|
||||||
|
DearImGui.render
|
||||||
|
DearImGui.getDrawData >>= openGL3RenderDrawData
|
||||||
|
|
||||||
|
SDL.glSwapWindow window
|
||||||
|
|
||||||
|
mainLoop window textures (flag /= clicked)
|
||||||
|
|
||||||
|
where
|
||||||
|
unlessQuit action = do
|
||||||
|
shouldQuit <- checkEvents
|
||||||
|
if shouldQuit then pure () else action
|
||||||
|
|
||||||
|
checkEvents = do
|
||||||
|
pollEventWithImGui >>= \case
|
||||||
|
Nothing ->
|
||||||
|
return False
|
||||||
|
Just event ->
|
||||||
|
(isQuit event ||) <$> checkEvents
|
||||||
|
|
||||||
|
isQuit event =
|
||||||
|
SDL.eventPayload event == SDL.QuitEvent
|
@ -83,6 +83,20 @@ type Handler = LogMessage -> ResourceT IO ()
|
|||||||
deriving via ( ReaderT Handler (ResourceT IO) )
|
deriving via ( ReaderT Handler (ResourceT IO) )
|
||||||
instance MonadResource ( LoggingT LogMessage (ResourceT IO) )
|
instance MonadResource ( LoggingT LogMessage (ResourceT IO) )
|
||||||
|
|
||||||
|
gui :: MonadIO m => m ImGui.DrawData
|
||||||
|
gui = do
|
||||||
|
-- Prepare frame
|
||||||
|
ImGui.Vulkan.vulkanNewFrame
|
||||||
|
ImGui.SDL.sdl2NewFrame
|
||||||
|
ImGui.newFrame
|
||||||
|
|
||||||
|
-- Run your windows
|
||||||
|
ImGui.showDemoWindow
|
||||||
|
|
||||||
|
-- Process ImGui state into draw commands
|
||||||
|
ImGui.render
|
||||||
|
ImGui.getDrawData
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = runResourceT . ( `runLoggingT` logHandler ) $ app @( LoggingT LogMessage ( ResourceT IO ) )
|
main = runResourceT . ( `runLoggingT` logHandler ) $ app @( LoggingT LogMessage ( ResourceT IO ) )
|
||||||
|
|
||||||
@ -120,6 +134,12 @@ app = do
|
|||||||
ImGui.createContext
|
ImGui.createContext
|
||||||
ImGui.destroyContext
|
ImGui.destroyContext
|
||||||
|
|
||||||
|
logDebug "Adding fonts"
|
||||||
|
ImGui.clearFontAtlas
|
||||||
|
_default <- ImGui.addFontDefault
|
||||||
|
_custom <- ImGui.addFontFromFileTTF "imgui/misc/fonts/ProggyTiny.ttf" 10
|
||||||
|
ImGui.buildFontAtlas
|
||||||
|
|
||||||
let
|
let
|
||||||
preferredFormat :: Vulkan.SurfaceFormatKHR
|
preferredFormat :: Vulkan.SurfaceFormatKHR
|
||||||
preferredFormat =
|
preferredFormat =
|
||||||
@ -341,12 +361,6 @@ app = do
|
|||||||
pure ( True, False )
|
pure ( True, False )
|
||||||
else
|
else
|
||||||
handleJust vulkanException ( pure . reloadQuit ) do
|
handleJust vulkanException ( pure . reloadQuit ) do
|
||||||
ImGui.Vulkan.vulkanNewFrame
|
|
||||||
ImGui.SDL.sdl2NewFrame window
|
|
||||||
ImGui.newFrame
|
|
||||||
ImGui.showDemoWindow
|
|
||||||
ImGui.render
|
|
||||||
drawData <- ImGui.getDrawData
|
|
||||||
let
|
let
|
||||||
commandBuffer :: Vulkan.CommandBuffer
|
commandBuffer :: Vulkan.CommandBuffer
|
||||||
commandBuffer = commandBuffers Boxed.Vector.! fromIntegral nextImageIndex
|
commandBuffer = commandBuffers Boxed.Vector.! fromIntegral nextImageIndex
|
||||||
@ -355,7 +369,10 @@ app = do
|
|||||||
Vulkan.resetCommandBuffer commandBuffer Vulkan.zero
|
Vulkan.resetCommandBuffer commandBuffer Vulkan.zero
|
||||||
beginCommandBuffer commandBuffer
|
beginCommandBuffer commandBuffer
|
||||||
cmdBeginRenderPass commandBuffer imGuiRenderPass framebuffer clearValues swapchainExtent
|
cmdBeginRenderPass commandBuffer imGuiRenderPass framebuffer clearValues swapchainExtent
|
||||||
|
|
||||||
|
drawData <- gui
|
||||||
ImGui.Vulkan.vulkanRenderDrawData drawData commandBuffer Nothing
|
ImGui.Vulkan.vulkanRenderDrawData drawData commandBuffer Nothing
|
||||||
|
|
||||||
cmdEndRenderPass commandBuffer
|
cmdEndRenderPass commandBuffer
|
||||||
endCommandBuffer commandBuffer
|
endCommandBuffer commandBuffer
|
||||||
submitCommandBuffer
|
submitCommandBuffer
|
||||||
@ -370,7 +387,7 @@ app = do
|
|||||||
freeOldResources
|
freeOldResources
|
||||||
let
|
let
|
||||||
freeOldResources :: m ()
|
freeOldResources :: m ()
|
||||||
freeOldResources = pure ()
|
freeOldResources = pure ()
|
||||||
unless quit $ mainLoop ( AppState {..} )
|
unless quit $ mainLoop ( AppState {..} )
|
||||||
|
|
||||||
let
|
let
|
||||||
|
@ -12,8 +12,6 @@ module DearImGui.Generator
|
|||||||
-- base
|
-- base
|
||||||
import Control.Arrow
|
import Control.Arrow
|
||||||
( second )
|
( second )
|
||||||
import Data.Coerce
|
|
||||||
( coerce )
|
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
( Bits )
|
( Bits )
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
@ -54,7 +52,6 @@ import qualified Language.Haskell.TH.Syntax as TH
|
|||||||
|
|
||||||
-- text
|
-- text
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
( isInfixOf, null, unpack, unlines )
|
|
||||||
import qualified Data.Text.IO as Text
|
import qualified Data.Text.IO as Text
|
||||||
( readFile )
|
( readFile )
|
||||||
|
|
||||||
@ -128,9 +125,9 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
|
|||||||
classes :: [ TH.Q TH.Type ]
|
classes :: [ TH.Q TH.Type ]
|
||||||
classes
|
classes
|
||||||
| isFlagEnum
|
| isFlagEnum
|
||||||
= map TH.conT [ ''Eq, ''Ord, ''Storable, ''Bits ]
|
= map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable, ''Bits ]
|
||||||
| otherwise
|
| otherwise
|
||||||
= map TH.conT [ ''Eq, ''Ord, ''Storable ]
|
= map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable ]
|
||||||
derivClause :: TH.Q TH.DerivClause
|
derivClause :: TH.Q TH.DerivClause
|
||||||
derivClause = TH.derivClause ( Just TH.NewtypeStrategy ) classes
|
derivClause = TH.derivClause ( Just TH.NewtypeStrategy ) classes
|
||||||
|
|
||||||
@ -157,11 +154,11 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
|
|||||||
<$> TH.appT ( TH.conT countName ) ( TH.conT tyName )
|
<$> TH.appT ( TH.conT countName ) ( TH.conT tyName )
|
||||||
<*> TH.litT ( TH.numTyLit enumSize )
|
<*> TH.litT ( TH.numTyLit enumSize )
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
pure ( finiteEnumInst : )
|
pure ( finiteEnumInst : )
|
||||||
else pure id
|
else pure id
|
||||||
|
|
||||||
synonyms <- for patterns \ ( patternName, patternValue, CommentText patDoc ) -> do
|
synonyms <- for patterns \ ( patternName, patternValue, CommentText _patDoc ) -> do
|
||||||
let
|
let
|
||||||
patNameStr :: String
|
patNameStr :: String
|
||||||
patNameStr = Text.unpack patternName
|
patNameStr = Text.unpack patternName
|
||||||
@ -169,7 +166,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
|
|||||||
patSynSig <- TH.patSynSigD patName ( TH.conT tyName )
|
patSynSig <- TH.patSynSigD patName ( TH.conT tyName )
|
||||||
pat <-
|
pat <-
|
||||||
#if MIN_VERSION_template_haskell(2,18,0)
|
#if MIN_VERSION_template_haskell(2,18,0)
|
||||||
( if Text.null patDoc
|
( if Text.null _patDoc
|
||||||
then TH.patSynD
|
then TH.patSynD
|
||||||
else
|
else
|
||||||
\ nm args dir pat ->
|
\ nm args dir pat ->
|
||||||
|
2
imgui
2
imgui
Submodule imgui updated: ad5d1a8429...e3e1fbcf02
@ -5,10 +5,10 @@
|
|||||||
"homepage": "https://input-output-hk.github.io/haskell.nix",
|
"homepage": "https://input-output-hk.github.io/haskell.nix",
|
||||||
"owner": "input-output-hk",
|
"owner": "input-output-hk",
|
||||||
"repo": "haskell.nix",
|
"repo": "haskell.nix",
|
||||||
"rev": "ef4aef4ce2060dc1a41b2690df1f54f986e0f9ab",
|
"rev": "970c84ad19e84d4ae42075cfe283022394f6effa",
|
||||||
"sha256": "0537fbjh4mcnywa33h4hl135kw7i8c0j8qndyzv5i82j7mc8wjvs",
|
"sha256": "01afbcas324n7j2bpfib7b4fazg5y6k7b74803c0i9ayrs6sgav6",
|
||||||
"type": "tarball",
|
"type": "tarball",
|
||||||
"url": "https://github.com/input-output-hk/haskell.nix/archive/ef4aef4ce2060dc1a41b2690df1f54f986e0f9ab.tar.gz",
|
"url": "https://github.com/input-output-hk/haskell.nix/archive/970c84ad19e84d4ae42075cfe283022394f6effa.tar.gz",
|
||||||
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
},
|
},
|
||||||
"niv": {
|
"niv": {
|
||||||
@ -17,10 +17,10 @@
|
|||||||
"homepage": "https://github.com/nmattia/niv",
|
"homepage": "https://github.com/nmattia/niv",
|
||||||
"owner": "nmattia",
|
"owner": "nmattia",
|
||||||
"repo": "niv",
|
"repo": "niv",
|
||||||
"rev": "3cd7914b2c4cff48927e11c216dadfab7d903fe5",
|
"rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",
|
||||||
"sha256": "1agq4nvbhrylf2s77kb4xhh9k7xcwdwggq764k4jgsbs70py8cw3",
|
"sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",
|
||||||
"type": "tarball",
|
"type": "tarball",
|
||||||
"url": "https://github.com/nmattia/niv/archive/3cd7914b2c4cff48927e11c216dadfab7d903fe5.tar.gz",
|
"url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad42070.tar.gz",
|
||||||
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
},
|
},
|
||||||
"nixpkgs": {
|
"nixpkgs": {
|
||||||
|
132
nix/sources.nix
132
nix/sources.nix
@ -6,52 +6,63 @@ let
|
|||||||
# The fetchers. fetch_<type> fetches specs of type <type>.
|
# The fetchers. fetch_<type> fetches specs of type <type>.
|
||||||
#
|
#
|
||||||
|
|
||||||
fetch_file = pkgs: spec:
|
fetch_file = pkgs: name: spec:
|
||||||
if spec.builtin or true then
|
let
|
||||||
builtins_fetchurl { inherit (spec) url sha256; }
|
name' = sanitizeName name + "-src";
|
||||||
else
|
in
|
||||||
pkgs.fetchurl { inherit (spec) url sha256; };
|
if spec.builtin or true then
|
||||||
|
builtins_fetchurl { inherit (spec) url sha256; name = name'; }
|
||||||
|
else
|
||||||
|
pkgs.fetchurl { inherit (spec) url sha256; name = name'; };
|
||||||
|
|
||||||
fetch_tarball = pkgs: spec:
|
fetch_tarball = pkgs: name: spec:
|
||||||
if spec.builtin or true then
|
let
|
||||||
builtins_fetchTarball { inherit (spec) url sha256; }
|
name' = sanitizeName name + "-src";
|
||||||
else
|
in
|
||||||
pkgs.fetchzip { inherit (spec) url sha256; };
|
if spec.builtin or true then
|
||||||
|
builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
|
||||||
|
else
|
||||||
|
pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
|
||||||
|
|
||||||
fetch_git = spec:
|
fetch_git = name: spec:
|
||||||
builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
|
let
|
||||||
|
ref =
|
||||||
|
if spec ? ref then spec.ref else
|
||||||
|
if spec ? branch then "refs/heads/${spec.branch}" else
|
||||||
|
if spec ? tag then "refs/tags/${spec.tag}" else
|
||||||
|
abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";
|
||||||
|
in
|
||||||
|
builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; };
|
||||||
|
|
||||||
fetch_builtin-tarball = spec:
|
fetch_local = spec: spec.path;
|
||||||
builtins.trace
|
|
||||||
''
|
|
||||||
WARNING:
|
|
||||||
The niv type "builtin-tarball" will soon be deprecated. You should
|
|
||||||
instead use `builtin = true`.
|
|
||||||
|
|
||||||
$ niv modify <package> -a type=tarball -a builtin=true
|
fetch_builtin-tarball = name: throw
|
||||||
''
|
''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`.
|
||||||
builtins_fetchTarball { inherit (spec) url sha256; };
|
$ niv modify ${name} -a type=tarball -a builtin=true'';
|
||||||
|
|
||||||
fetch_builtin-url = spec:
|
fetch_builtin-url = name: throw
|
||||||
builtins.trace
|
''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`.
|
||||||
''
|
$ niv modify ${name} -a type=file -a builtin=true'';
|
||||||
WARNING:
|
|
||||||
The niv type "builtin-url" will soon be deprecated. You should
|
|
||||||
instead use `builtin = true`.
|
|
||||||
|
|
||||||
$ niv modify <package> -a type=file -a builtin=true
|
|
||||||
''
|
|
||||||
(builtins_fetchurl { inherit (spec) url sha256; });
|
|
||||||
|
|
||||||
#
|
#
|
||||||
# Various helpers
|
# Various helpers
|
||||||
#
|
#
|
||||||
|
|
||||||
|
# https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695
|
||||||
|
sanitizeName = name:
|
||||||
|
(
|
||||||
|
concatMapStrings (s: if builtins.isList s then "-" else s)
|
||||||
|
(
|
||||||
|
builtins.split "[^[:alnum:]+._?=-]+"
|
||||||
|
((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name)
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
# The set of packages used when specs are fetched using non-builtins.
|
# The set of packages used when specs are fetched using non-builtins.
|
||||||
mkPkgs = sources:
|
mkPkgs = sources: system:
|
||||||
let
|
let
|
||||||
sourcesNixpkgs =
|
sourcesNixpkgs =
|
||||||
import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) {};
|
import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; };
|
||||||
hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
|
hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
|
||||||
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
|
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
|
||||||
in
|
in
|
||||||
@ -71,14 +82,27 @@ let
|
|||||||
|
|
||||||
if ! builtins.hasAttr "type" spec then
|
if ! builtins.hasAttr "type" spec then
|
||||||
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
|
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
|
||||||
else if spec.type == "file" then fetch_file pkgs spec
|
else if spec.type == "file" then fetch_file pkgs name spec
|
||||||
else if spec.type == "tarball" then fetch_tarball pkgs spec
|
else if spec.type == "tarball" then fetch_tarball pkgs name spec
|
||||||
else if spec.type == "git" then fetch_git spec
|
else if spec.type == "git" then fetch_git name spec
|
||||||
else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec
|
else if spec.type == "local" then fetch_local spec
|
||||||
else if spec.type == "builtin-url" then fetch_builtin-url spec
|
else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
|
||||||
|
else if spec.type == "builtin-url" then fetch_builtin-url name
|
||||||
else
|
else
|
||||||
abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
|
abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
|
||||||
|
|
||||||
|
# If the environment variable NIV_OVERRIDE_${name} is set, then use
|
||||||
|
# the path directly as opposed to the fetched source.
|
||||||
|
replace = name: drv:
|
||||||
|
let
|
||||||
|
saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;
|
||||||
|
ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
|
||||||
|
in
|
||||||
|
if ersatz == "" then drv else
|
||||||
|
# this turns the string into an actual Nix path (for both absolute and
|
||||||
|
# relative paths)
|
||||||
|
if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}";
|
||||||
|
|
||||||
# Ports of functions for older nix versions
|
# Ports of functions for older nix versions
|
||||||
|
|
||||||
# a Nix version of mapAttrs if the built-in doesn't exist
|
# a Nix version of mapAttrs if the built-in doesn't exist
|
||||||
@ -87,23 +111,37 @@ let
|
|||||||
listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))
|
listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))
|
||||||
);
|
);
|
||||||
|
|
||||||
|
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295
|
||||||
|
range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1);
|
||||||
|
|
||||||
|
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257
|
||||||
|
stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1));
|
||||||
|
|
||||||
|
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
|
||||||
|
stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
|
||||||
|
concatMapStrings = f: list: concatStrings (map f list);
|
||||||
|
concatStrings = builtins.concatStringsSep "";
|
||||||
|
|
||||||
|
# https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331
|
||||||
|
optionalAttrs = cond: as: if cond then as else {};
|
||||||
|
|
||||||
# fetchTarball version that is compatible between all the versions of Nix
|
# fetchTarball version that is compatible between all the versions of Nix
|
||||||
builtins_fetchTarball = { url, sha256 }@attrs:
|
builtins_fetchTarball = { url, name ? null, sha256 }@attrs:
|
||||||
let
|
let
|
||||||
inherit (builtins) lessThan nixVersion fetchTarball;
|
inherit (builtins) lessThan nixVersion fetchTarball;
|
||||||
in
|
in
|
||||||
if lessThan nixVersion "1.12" then
|
if lessThan nixVersion "1.12" then
|
||||||
fetchTarball { inherit url; }
|
fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
|
||||||
else
|
else
|
||||||
fetchTarball attrs;
|
fetchTarball attrs;
|
||||||
|
|
||||||
# fetchurl version that is compatible between all the versions of Nix
|
# fetchurl version that is compatible between all the versions of Nix
|
||||||
builtins_fetchurl = { url, sha256 }@attrs:
|
builtins_fetchurl = { url, name ? null, sha256 }@attrs:
|
||||||
let
|
let
|
||||||
inherit (builtins) lessThan nixVersion fetchurl;
|
inherit (builtins) lessThan nixVersion fetchurl;
|
||||||
in
|
in
|
||||||
if lessThan nixVersion "1.12" then
|
if lessThan nixVersion "1.12" then
|
||||||
fetchurl { inherit url; }
|
fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
|
||||||
else
|
else
|
||||||
fetchurl attrs;
|
fetchurl attrs;
|
||||||
|
|
||||||
@ -115,14 +153,15 @@ let
|
|||||||
then abort
|
then abort
|
||||||
"The values in sources.json should not have an 'outPath' attribute"
|
"The values in sources.json should not have an 'outPath' attribute"
|
||||||
else
|
else
|
||||||
spec // { outPath = fetch config.pkgs name spec; }
|
spec // { outPath = replace name (fetch config.pkgs name spec); }
|
||||||
) config.sources;
|
) config.sources;
|
||||||
|
|
||||||
# The "config" used by the fetchers
|
# The "config" used by the fetchers
|
||||||
mkConfig =
|
mkConfig =
|
||||||
{ sourcesFile ? ./sources.json
|
{ sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
|
||||||
, sources ? builtins.fromJSON (builtins.readFile sourcesFile)
|
, sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
|
||||||
, pkgs ? mkPkgs sources
|
, system ? builtins.currentSystem
|
||||||
|
, pkgs ? mkPkgs sources system
|
||||||
}: rec {
|
}: rec {
|
||||||
# The sources, i.e. the attribute set of spec name to spec
|
# The sources, i.e. the attribute set of spec name to spec
|
||||||
inherit sources;
|
inherit sources;
|
||||||
@ -130,5 +169,6 @@ let
|
|||||||
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
|
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
|
||||||
inherit pkgs;
|
inherit pkgs;
|
||||||
};
|
};
|
||||||
|
|
||||||
in
|
in
|
||||||
mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }
|
mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }
|
||||||
|
261
src/DearImGui.hs
261
src/DearImGui.hs
@ -1,6 +1,7 @@
|
|||||||
{-# LANGUAGE BlockArguments #-}
|
{-# LANGUAGE BlockArguments #-}
|
||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
@ -19,6 +20,8 @@ module DearImGui
|
|||||||
Raw.Context(..)
|
Raw.Context(..)
|
||||||
, Raw.createContext
|
, Raw.createContext
|
||||||
, Raw.destroyContext
|
, Raw.destroyContext
|
||||||
|
, Raw.getCurrentContext
|
||||||
|
, Raw.setCurrentContext
|
||||||
|
|
||||||
-- * Main
|
-- * Main
|
||||||
, Raw.newFrame
|
, Raw.newFrame
|
||||||
@ -48,6 +51,15 @@ module DearImGui
|
|||||||
|
|
||||||
, begin
|
, begin
|
||||||
, Raw.end
|
, Raw.end
|
||||||
|
|
||||||
|
-- ** Utilities
|
||||||
|
|
||||||
|
, Raw.getWindowPos
|
||||||
|
, Raw.getWindowSize
|
||||||
|
, Raw.getWindowWidth
|
||||||
|
, Raw.getWindowHeight
|
||||||
|
|
||||||
|
-- ** Manipulation
|
||||||
, setNextWindowPos
|
, setNextWindowPos
|
||||||
, setNextWindowSize
|
, setNextWindowSize
|
||||||
, Raw.setNextWindowFullscreen
|
, Raw.setNextWindowFullscreen
|
||||||
@ -56,15 +68,19 @@ module DearImGui
|
|||||||
, setNextWindowCollapsed
|
, setNextWindowCollapsed
|
||||||
, setNextWindowBgAlpha
|
, setNextWindowBgAlpha
|
||||||
|
|
||||||
-- * Child Windows
|
-- ** Child Windows
|
||||||
, withChild
|
, withChild
|
||||||
, withChildOpen
|
, withChildOpen
|
||||||
|
, withChildContext
|
||||||
, beginChild
|
, beginChild
|
||||||
, Raw.endChild
|
, Raw.endChild
|
||||||
|
|
||||||
-- * Parameter stacks
|
-- * Parameter stacks
|
||||||
|
, withStyleColor
|
||||||
, pushStyleColor
|
, pushStyleColor
|
||||||
, Raw.popStyleColor
|
, Raw.popStyleColor
|
||||||
|
|
||||||
|
, withStyleVar
|
||||||
, pushStyleVar
|
, pushStyleVar
|
||||||
, popStyleVar
|
, popStyleVar
|
||||||
|
|
||||||
@ -74,9 +90,13 @@ module DearImGui
|
|||||||
, Raw.newLine
|
, Raw.newLine
|
||||||
, Raw.spacing
|
, Raw.spacing
|
||||||
, dummy
|
, dummy
|
||||||
|
|
||||||
|
, withIndent
|
||||||
, indent
|
, indent
|
||||||
, unindent
|
, unindent
|
||||||
|
|
||||||
, setNextItemWidth
|
, setNextItemWidth
|
||||||
|
, withItemWidth
|
||||||
, pushItemWidth
|
, pushItemWidth
|
||||||
, Raw.popItemWidth
|
, Raw.popItemWidth
|
||||||
|
|
||||||
@ -87,6 +107,10 @@ module DearImGui
|
|||||||
, setCursorPos
|
, setCursorPos
|
||||||
, Raw.alignTextToFramePadding
|
, Raw.alignTextToFramePadding
|
||||||
|
|
||||||
|
-- * ID stack
|
||||||
|
, withID
|
||||||
|
, ToID(..)
|
||||||
|
|
||||||
-- * Widgets
|
-- * Widgets
|
||||||
-- ** Text
|
-- ** Text
|
||||||
, text
|
, text
|
||||||
@ -99,7 +123,9 @@ module DearImGui
|
|||||||
-- ** Main
|
-- ** Main
|
||||||
, button
|
, button
|
||||||
, smallButton
|
, smallButton
|
||||||
|
, invisibleButton
|
||||||
, arrowButton
|
, arrowButton
|
||||||
|
, Raw.image
|
||||||
, checkbox
|
, checkbox
|
||||||
, progressBar
|
, progressBar
|
||||||
, Raw.bullet
|
, Raw.bullet
|
||||||
@ -143,6 +169,8 @@ module DearImGui
|
|||||||
|
|
||||||
-- ** Text Input
|
-- ** Text Input
|
||||||
, inputText
|
, inputText
|
||||||
|
, inputTextMultiline
|
||||||
|
, inputTextWithHint
|
||||||
|
|
||||||
-- * Color Editor/Picker
|
-- * Color Editor/Picker
|
||||||
, colorPicker3
|
, colorPicker3
|
||||||
@ -217,6 +245,13 @@ module DearImGui
|
|||||||
, Raw.wantCaptureMouse
|
, Raw.wantCaptureMouse
|
||||||
, Raw.wantCaptureKeyboard
|
, Raw.wantCaptureKeyboard
|
||||||
|
|
||||||
|
-- * Fonts
|
||||||
|
, Raw.Font
|
||||||
|
, addFontFromFileTTF
|
||||||
|
, Raw.addFontDefault
|
||||||
|
, Raw.buildFontAtlas
|
||||||
|
, Raw.clearFontAtlas
|
||||||
|
|
||||||
-- * Types
|
-- * Types
|
||||||
, module DearImGui.Enums
|
, module DearImGui.Enums
|
||||||
, module DearImGui.Structs
|
, module DearImGui.Structs
|
||||||
@ -231,6 +266,9 @@ import Data.Foldable
|
|||||||
( foldl' )
|
( foldl' )
|
||||||
import Foreign
|
import Foreign
|
||||||
import Foreign.C
|
import Foreign.C
|
||||||
|
import qualified GHC.Foreign as Foreign
|
||||||
|
import System.IO
|
||||||
|
( utf8 )
|
||||||
|
|
||||||
-- dear-imgui
|
-- dear-imgui
|
||||||
import DearImGui.Enums
|
import DearImGui.Enums
|
||||||
@ -271,7 +309,7 @@ getVersion = liftIO do
|
|||||||
begin :: MonadIO m => String -> m Bool
|
begin :: MonadIO m => String -> m Bool
|
||||||
begin name = liftIO do
|
begin name = liftIO do
|
||||||
withCString name \namePtr ->
|
withCString name \namePtr ->
|
||||||
Raw.begin namePtr nullPtr (ImGuiWindowFlags 0)
|
Raw.begin namePtr Nothing Nothing
|
||||||
|
|
||||||
-- | Append items to a window.
|
-- | Append items to a window.
|
||||||
--
|
--
|
||||||
@ -303,7 +341,7 @@ withFullscreen action = bracket open close (`when` action)
|
|||||||
open = liftIO do
|
open = liftIO do
|
||||||
Raw.setNextWindowFullscreen
|
Raw.setNextWindowFullscreen
|
||||||
withCString "FullScreen" \namePtr ->
|
withCString "FullScreen" \namePtr ->
|
||||||
Raw.begin namePtr nullPtr fullscreenFlags
|
Raw.begin namePtr (Just nullPtr) (Just fullscreenFlags)
|
||||||
|
|
||||||
close = liftIO . const Raw.end
|
close = liftIO . const Raw.end
|
||||||
|
|
||||||
@ -321,31 +359,58 @@ fullscreenFlags = foldl' (.|.) zeroBits
|
|||||||
, ImGuiWindowFlags_NoTitleBar
|
, ImGuiWindowFlags_NoTitleBar
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Wraps @ImGui::BeginChild()@.
|
|
||||||
beginChild :: MonadIO m => String -> m Bool
|
|
||||||
beginChild name = liftIO do
|
|
||||||
withCString name Raw.beginChild
|
|
||||||
|
|
||||||
-- | Child windows used for self-contained independent scrolling/clipping regions
|
-- | Begin a self-contained independent scrolling/clipping regions within a host window.
|
||||||
-- within a host window. Child windows can embed their own child.
|
--
|
||||||
|
-- Child windows can embed their own child.
|
||||||
|
--
|
||||||
|
-- For each independent axis of @size@:
|
||||||
|
-- * ==0.0f: use remaining host window size
|
||||||
|
-- * >0.0f: fixed size
|
||||||
|
-- * <0.0f: use remaining window size minus abs(size)
|
||||||
|
--
|
||||||
|
-- Each axis can use a different mode, e.g. @ImVec2 0 400@.
|
||||||
|
--
|
||||||
|
-- @BeginChild()@ returns `False` to indicate the window is collapsed or fully clipped, so you may early out and omit submitting anything to the window.
|
||||||
|
--
|
||||||
|
-- Always call a matching `endChild` for each `beginChild` call, regardless of its return value.
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::BeginChild()@.
|
||||||
|
beginChild :: MonadIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m Bool
|
||||||
|
beginChild name size border flags = liftIO do
|
||||||
|
withCString name \namePtr ->
|
||||||
|
with size \sizePtr ->
|
||||||
|
Raw.beginChild namePtr sizePtr (bool 0 1 border) flags
|
||||||
|
|
||||||
|
-- | Action wrapper for child windows.
|
||||||
--
|
--
|
||||||
-- Action will get 'False' if the child region is collapsed or fully clipped.
|
-- Action will get 'False' if the child region is collapsed or fully clipped.
|
||||||
withChild :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
|
withChild :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> (Bool -> m a) -> m a
|
||||||
withChild name = bracket (beginChild name) (const Raw.endChild)
|
withChild name size border flags = bracket (beginChild name size border flags) (const Raw.endChild)
|
||||||
|
|
||||||
-- | Child windows used for self-contained independent scrolling/clipping regions
|
-- | Action-skipping wrapper for child windows.
|
||||||
-- within a host window. Child windows can embed their own child.
|
|
||||||
--
|
--
|
||||||
-- Action will be skipped if the child region is collapsed or fully clipped.
|
-- Action will be skipped if the child region is collapsed or fully clipped.
|
||||||
withChildOpen :: MonadUnliftIO m => String -> m () -> m ()
|
withChildOpen :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m () -> m ()
|
||||||
withChildOpen name action =
|
withChildOpen name size border flags action =
|
||||||
withChild name (`when` action)
|
withChild name size border flags (`when` action)
|
||||||
|
|
||||||
|
-- | Action wrapper to run in a context of another child window addressed by its name.
|
||||||
|
--
|
||||||
|
-- Action will get 'False' if the child region is collapsed or fully clipped.
|
||||||
|
withChildContext :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
|
||||||
|
withChildContext name action =
|
||||||
|
bracket
|
||||||
|
(liftIO $ withCString name Raw.beginChildContext)
|
||||||
|
(const Raw.endChild)
|
||||||
|
action
|
||||||
|
|
||||||
|
|
||||||
-- | Plain text.
|
-- | Plain text.
|
||||||
text :: MonadIO m => String -> m ()
|
text :: MonadIO m => String -> m ()
|
||||||
text t = liftIO do
|
text t = liftIO do
|
||||||
withCString t \textPtr ->
|
withCString t \textPtr ->
|
||||||
Raw.textUnformatted textPtr nullPtr
|
Raw.textUnformatted textPtr Nothing
|
||||||
|
|
||||||
-- | Colored text.
|
-- | Colored text.
|
||||||
textColored :: (HasGetter ref ImVec4, MonadIO m) => ref -> String -> m ()
|
textColored :: (HasGetter ref ImVec4, MonadIO m) => ref -> String -> m ()
|
||||||
@ -395,6 +460,19 @@ smallButton label = liftIO do
|
|||||||
withCString label Raw.smallButton
|
withCString label Raw.smallButton
|
||||||
|
|
||||||
|
|
||||||
|
-- | Flexible button behavior without the visuals.
|
||||||
|
--
|
||||||
|
-- Frequently useful to build custom behaviors using the public api
|
||||||
|
-- (along with IsItemActive, IsItemHovered, etc).
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::InvisibleButton()@.
|
||||||
|
invisibleButton :: MonadIO m => String -> ImVec2 -> ImGuiButtonFlags -> m Bool
|
||||||
|
invisibleButton label size flags = liftIO do
|
||||||
|
withCString label \labelPtr ->
|
||||||
|
with size \sizePtr ->
|
||||||
|
Raw.invisibleButton labelPtr sizePtr flags
|
||||||
|
|
||||||
|
|
||||||
-- | Square button with an arrow shape.
|
-- | Square button with an arrow shape.
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::ArrowButton()@.
|
-- Wraps @ImGui::ArrowButton()@.
|
||||||
@ -1053,18 +1131,69 @@ vSliderScalar label size dataType ref refMin refMax format flags = liftIO do
|
|||||||
|
|
||||||
-- | Wraps @ImGui::InputText()@.
|
-- | Wraps @ImGui::InputText()@.
|
||||||
inputText :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> m Bool
|
inputText :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> m Bool
|
||||||
inputText desc ref refSize = liftIO do
|
inputText label ref bufSize =
|
||||||
|
withInputString ref bufSize \bufPtrLen ->
|
||||||
|
Foreign.withCString utf8 label \labelPtr ->
|
||||||
|
Raw.inputText
|
||||||
|
labelPtr
|
||||||
|
bufPtrLen
|
||||||
|
ImGuiInputTextFlags_None
|
||||||
|
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::InputTextMultiline()@.
|
||||||
|
inputTextMultiline :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> ImVec2 -> m Bool
|
||||||
|
inputTextMultiline label ref bufSize size =
|
||||||
|
withInputString ref bufSize \bufPtrLen ->
|
||||||
|
Foreign.withCString utf8 label \labelPtr ->
|
||||||
|
with size \sizePtr ->
|
||||||
|
Raw.inputTextMultiline
|
||||||
|
labelPtr
|
||||||
|
bufPtrLen
|
||||||
|
sizePtr
|
||||||
|
ImGuiInputTextFlags_None
|
||||||
|
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::InputTextWithHint()@.
|
||||||
|
inputTextWithHint :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> String -> ref -> Int -> m Bool
|
||||||
|
inputTextWithHint label hint ref bufSize =
|
||||||
|
withInputString ref bufSize \bufPtrLen ->
|
||||||
|
Foreign.withCString utf8 label \labelPtr ->
|
||||||
|
Foreign.withCString utf8 hint \hintPtr ->
|
||||||
|
Raw.inputTextWithHint
|
||||||
|
labelPtr
|
||||||
|
hintPtr
|
||||||
|
bufPtrLen
|
||||||
|
ImGuiInputTextFlags_None
|
||||||
|
|
||||||
|
|
||||||
|
-- | Internal helper to prepare appropriately sized and encoded input buffer.
|
||||||
|
withInputString
|
||||||
|
:: (MonadIO m, HasSetter ref String, HasGetter ref String)
|
||||||
|
=> ref
|
||||||
|
-> Int
|
||||||
|
-> (CStringLen -> IO Bool)
|
||||||
|
-> m Bool
|
||||||
|
withInputString ref bufSize action = liftIO do
|
||||||
input <- get ref
|
input <- get ref
|
||||||
withCString input \ refPtr -> do
|
Foreign.withCStringLen utf8 input \(refPtr, refSize) ->
|
||||||
withCString desc \ descPtr -> do
|
-- XXX: Allocate and zero buffer to receive imgui updates.
|
||||||
let refSize' :: CInt
|
bracket (mkBuf refSize) free \bufPtr -> do
|
||||||
refSize' = fromIntegral refSize
|
-- XXX: Copy the original input.
|
||||||
changed <- Raw.inputText descPtr refPtr refSize'
|
copyBytes bufPtr refPtr refSize
|
||||||
|
|
||||||
|
changed <- action (bufPtr, bufSize)
|
||||||
|
|
||||||
when changed do
|
when changed do
|
||||||
peekCString refPtr >>= ($=!) ref
|
-- XXX: Assuming Imgui wouldn't write over the bump stop so peekCString would finish.
|
||||||
|
newValue <- Foreign.peekCString utf8 bufPtr
|
||||||
|
ref $=! newValue
|
||||||
|
|
||||||
return changed
|
return changed
|
||||||
|
where
|
||||||
|
mkBuf refSize =
|
||||||
|
callocBytes $
|
||||||
|
max refSize bufSize +
|
||||||
|
5 -- XXX: max size of UTF8 code point + NUL terminator
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui::ColorPicker3()@.
|
-- | Wraps @ImGui::ColorPicker3()@.
|
||||||
@ -1357,9 +1486,9 @@ setNextWindowPos posRef cond pivotMaybe = liftIO do
|
|||||||
Just pivotRef -> do
|
Just pivotRef -> do
|
||||||
pivot <- get pivotRef
|
pivot <- get pivotRef
|
||||||
with pivot $ \pivotPtr ->
|
with pivot $ \pivotPtr ->
|
||||||
Raw.setNextWindowPos posPtr cond pivotPtr
|
Raw.setNextWindowPos posPtr cond (Just pivotPtr)
|
||||||
Nothing ->
|
Nothing ->
|
||||||
Raw.setNextWindowPos posPtr cond nullPtr
|
Raw.setNextWindowPos posPtr cond Nothing
|
||||||
|
|
||||||
-- | Set next window size. Call before `begin`
|
-- | Set next window size. Call before `begin`
|
||||||
--
|
--
|
||||||
@ -1415,6 +1544,9 @@ dummy sizeRef = liftIO do
|
|||||||
size' <- get sizeRef
|
size' <- get sizeRef
|
||||||
with size' Raw.dummy
|
with size' Raw.dummy
|
||||||
|
|
||||||
|
withIndent :: MonadUnliftIO m => Float -> m a -> m a
|
||||||
|
withIndent width =
|
||||||
|
bracket_ (indent width) (unindent width)
|
||||||
|
|
||||||
-- | Move content position toward the right, by indent_w, or style.IndentSpacing if indent_w <= 0
|
-- | Move content position toward the right, by indent_w, or style.IndentSpacing if indent_w <= 0
|
||||||
--
|
--
|
||||||
@ -1440,6 +1572,10 @@ setNextItemWidth itemWidth = liftIO do
|
|||||||
Raw.setNextItemWidth (CFloat itemWidth)
|
Raw.setNextItemWidth (CFloat itemWidth)
|
||||||
|
|
||||||
|
|
||||||
|
withItemWidth :: MonadUnliftIO m => Float -> m a -> m a
|
||||||
|
withItemWidth width =
|
||||||
|
bracket_ (pushItemWidth width) Raw.popItemWidth
|
||||||
|
|
||||||
-- Wraps @ImGui::PushItemWidth()@
|
-- Wraps @ImGui::PushItemWidth()@
|
||||||
pushItemWidth :: (MonadIO m) => Float -> m ()
|
pushItemWidth :: (MonadIO m) => Float -> m ()
|
||||||
pushItemWidth itemWidth = liftIO do
|
pushItemWidth itemWidth = liftIO do
|
||||||
@ -1460,8 +1596,52 @@ setCursorPos posRef = liftIO do
|
|||||||
pos <- get posRef
|
pos <- get posRef
|
||||||
with pos Raw.setCursorPos
|
with pos Raw.setCursorPos
|
||||||
|
|
||||||
|
-- | Add an element to a ID stack
|
||||||
|
--
|
||||||
|
-- Read the FAQ (http://dearimgui.org/faq) for more details
|
||||||
|
-- about how ID are handled in dear imgui.
|
||||||
|
--
|
||||||
|
-- Those questions are answered and impacted by understanding of the ID stack system:
|
||||||
|
-- * "Q: Why is my widget not reacting when I click on it?"
|
||||||
|
-- * "Q: How can I have widgets with an empty label?"
|
||||||
|
-- * "Q: How can I have multiple widgets with the same label?"
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::PushId@ and @ImGui::PopId@
|
||||||
|
withID :: (MonadUnliftIO m, ToID id) => id -> m a -> m a
|
||||||
|
withID i = bracket_ (liftIO $ pushID i) Raw.popID
|
||||||
|
|
||||||
-- | Modify a style color by pushing to the shared stack. always use this if you modify the style after `newFrame`
|
-- | A supplementary class to match overloaded functions in C++ the library.
|
||||||
|
class ToID a where
|
||||||
|
pushID :: MonadIO m => a -> m ()
|
||||||
|
|
||||||
|
instance ToID CInt where
|
||||||
|
pushID = Raw.pushIDInt
|
||||||
|
|
||||||
|
instance ToID Int where
|
||||||
|
pushID = Raw.pushIDInt . fromIntegral
|
||||||
|
|
||||||
|
instance ToID Integer where
|
||||||
|
pushID = Raw.pushIDInt . fromInteger
|
||||||
|
|
||||||
|
instance {-# OVERLAPPABLE #-} ToID (Ptr a) where
|
||||||
|
pushID = Raw.pushIDPtr
|
||||||
|
|
||||||
|
instance {-# OVERLAPPING #-} ToID (Ptr CChar) where
|
||||||
|
pushID = Raw.pushIDStr
|
||||||
|
|
||||||
|
instance ToID (Ptr CChar, Int) where
|
||||||
|
pushID = Raw.pushIDStrLen
|
||||||
|
|
||||||
|
instance ToID String where
|
||||||
|
pushID s = liftIO $ withCStringLen s pushID
|
||||||
|
|
||||||
|
withStyleColor :: (MonadUnliftIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m a -> m a
|
||||||
|
withStyleColor color ref =
|
||||||
|
bracket_ (pushStyleColor color ref) (Raw.popStyleColor 1)
|
||||||
|
|
||||||
|
-- | Modify a style color by pushing to the shared stack.
|
||||||
|
--
|
||||||
|
-- Always use this if you modify the style after `newFrame`.
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::PushStyleColor()@
|
-- Wraps @ImGui::PushStyleColor()@
|
||||||
pushStyleColor :: (MonadIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m ()
|
pushStyleColor :: (MonadIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m ()
|
||||||
@ -1470,8 +1650,13 @@ pushStyleColor col colorRef = liftIO do
|
|||||||
with color \colorPtr ->
|
with color \colorPtr ->
|
||||||
Raw.pushStyleColor col colorPtr
|
Raw.pushStyleColor col colorPtr
|
||||||
|
|
||||||
|
withStyleVar :: (MonadUnliftIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m a -> m a
|
||||||
|
withStyleVar style ref =
|
||||||
|
bracket_ (pushStyleVar style ref) (Raw.popStyleVar 1)
|
||||||
|
|
||||||
-- | Modify a style variable by pushing to the shared stack. always use this if you modify the style after `newFrame`
|
-- | Modify a style variable by pushing to the shared stack.
|
||||||
|
--
|
||||||
|
-- Always use this if you modify the style after `newFrame`.
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::PushStyleVar()@
|
-- Wraps @ImGui::PushStyleVar()@
|
||||||
pushStyleVar :: (MonadIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m ()
|
pushStyleVar :: (MonadIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m ()
|
||||||
@ -1480,10 +1665,28 @@ pushStyleVar style valRef = liftIO do
|
|||||||
with val \valPtr ->
|
with val \valPtr ->
|
||||||
Raw.pushStyleVar style valPtr
|
Raw.pushStyleVar style valPtr
|
||||||
|
|
||||||
|
|
||||||
-- | Remove style variable modifications from the shared stack
|
-- | Remove style variable modifications from the shared stack
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::PopStyleVar()@
|
-- Wraps @ImGui::PopStyleVar()@
|
||||||
popStyleVar :: (MonadIO m) => Int -> m ()
|
popStyleVar :: (MonadIO m) => Int -> m ()
|
||||||
popStyleVar n = liftIO do
|
popStyleVar n = liftIO do
|
||||||
Raw.popStyleVar (fromIntegral n)
|
Raw.popStyleVar (fromIntegral n)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Load a font from TTF file.
|
||||||
|
--
|
||||||
|
-- Specify font path and atlas glyph size.
|
||||||
|
--
|
||||||
|
-- Use 'addFontDefault' if you want to retain built-in font too.
|
||||||
|
--
|
||||||
|
-- Call 'buildFontAtlas' after adding all the fonts.
|
||||||
|
--
|
||||||
|
-- Call backend-specific `CreateFontsTexture` before using 'newFrame'.
|
||||||
|
addFontFromFileTTF :: MonadIO m => FilePath -> Float -> m (Maybe Raw.Font)
|
||||||
|
addFontFromFileTTF font size = liftIO do
|
||||||
|
res@(Raw.Font ptr) <- withCString font \fontPtr ->
|
||||||
|
Raw.addFontFromFileTTF fontPtr (CFloat size)
|
||||||
|
pure $
|
||||||
|
if castPtr ptr == nullPtr
|
||||||
|
then Nothing
|
||||||
|
else Just res
|
||||||
|
@ -33,5 +33,7 @@ imguiContext = mempty
|
|||||||
[ ( TypeName "ImVec2", [t| ImVec2 |] )
|
[ ( TypeName "ImVec2", [t| ImVec2 |] )
|
||||||
, ( TypeName "ImVec3", [t| ImVec3 |] )
|
, ( TypeName "ImVec3", [t| ImVec3 |] )
|
||||||
, ( TypeName "ImVec4", [t| ImVec4 |] )
|
, ( TypeName "ImVec4", [t| ImVec4 |] )
|
||||||
|
, ( TypeName "ImGuiContext", [t| ImGuiContext |] )
|
||||||
|
, ( TypeName "ImFont", [t| ImFont |] )
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
@ -19,9 +19,33 @@ module DearImGui.GLFW (
|
|||||||
-- ** GLFW
|
-- ** GLFW
|
||||||
glfwNewFrame
|
glfwNewFrame
|
||||||
, glfwShutdown
|
, glfwShutdown
|
||||||
|
|
||||||
|
-- $callbacks
|
||||||
|
, glfwWindowFocusCallback
|
||||||
|
, glfwCursorEnterCallback
|
||||||
|
, glfwMouseButtonCallback
|
||||||
|
, glfwScrollCallback
|
||||||
|
, glfwKeyCallback
|
||||||
|
, glfwCharCallback
|
||||||
|
, glfwMonitorCallback
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
import Foreign
|
||||||
|
( Ptr, castPtr )
|
||||||
|
import Foreign.C.Types
|
||||||
|
( CInt, CDouble, CUInt )
|
||||||
|
import Unsafe.Coerce (unsafeCoerce)
|
||||||
|
|
||||||
|
-- bindings-GLFW
|
||||||
|
import Bindings.GLFW
|
||||||
|
( C'GLFWmonitor, C'GLFWwindow )
|
||||||
|
|
||||||
|
-- GLFW-b
|
||||||
|
import Graphics.UI.GLFW
|
||||||
|
( Monitor, Window )
|
||||||
|
|
||||||
-- inline-c
|
-- inline-c
|
||||||
import qualified Language.C.Inline as C
|
import qualified Language.C.Inline as C
|
||||||
|
|
||||||
@ -44,8 +68,121 @@ glfwNewFrame :: MonadIO m => m ()
|
|||||||
glfwNewFrame = liftIO do
|
glfwNewFrame = liftIO do
|
||||||
[C.exp| void { ImGui_ImplGlfw_NewFrame(); } |]
|
[C.exp| void { ImGui_ImplGlfw_NewFrame(); } |]
|
||||||
|
|
||||||
|
-- $callbacks
|
||||||
|
-- == GLFW callbacks
|
||||||
|
-- * When calling Init with @install_callbacks=true@:
|
||||||
|
-- GLFW callbacks will be installed for you.
|
||||||
|
-- They will call user's previously installed callbacks, if any.
|
||||||
|
-- * When calling Init with @install_callbacks=false@:
|
||||||
|
-- GLFW callbacks won't be installed.
|
||||||
|
-- You will need to call those function yourself from your own GLFW callbacks.
|
||||||
|
|
||||||
-- | Wraps @ImGui_ImplGlfw_Shutdown@.
|
-- | Wraps @ImGui_ImplGlfw_Shutdown@.
|
||||||
glfwShutdown :: MonadIO m => m ()
|
glfwShutdown :: MonadIO m => m ()
|
||||||
glfwShutdown = liftIO do
|
glfwShutdown = liftIO do
|
||||||
[C.exp| void { ImGui_ImplGlfw_Shutdown(); } |]
|
[C.exp| void { ImGui_ImplGlfw_Shutdown(); } |]
|
||||||
|
|
||||||
|
glfwWindowFocusCallback :: MonadIO m => Window -> CInt -> m ()
|
||||||
|
glfwWindowFocusCallback window focused = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_WindowFocusCallback(
|
||||||
|
static_cast<GLFWwindow *>(
|
||||||
|
$(void * windowPtr)
|
||||||
|
),
|
||||||
|
$(int focused)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
windowPtr = castPtr $ unWindow window
|
||||||
|
|
||||||
|
glfwCursorEnterCallback :: MonadIO m => Window -> CInt -> m ()
|
||||||
|
glfwCursorEnterCallback window entered = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_CursorEnterCallback(
|
||||||
|
static_cast<GLFWwindow *>(
|
||||||
|
$(void * windowPtr)
|
||||||
|
),
|
||||||
|
$(int entered)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
windowPtr = castPtr $ unWindow window
|
||||||
|
|
||||||
|
glfwMouseButtonCallback :: MonadIO m => Window -> CInt -> CInt -> CInt -> m ()
|
||||||
|
glfwMouseButtonCallback window button action mods = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_MouseButtonCallback(
|
||||||
|
static_cast<GLFWwindow *>(
|
||||||
|
$(void * windowPtr)
|
||||||
|
),
|
||||||
|
$(int button),
|
||||||
|
$(int action),
|
||||||
|
$(int mods)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
windowPtr = castPtr $ unWindow window
|
||||||
|
|
||||||
|
glfwScrollCallback :: MonadIO m => Window -> CDouble -> CDouble -> m ()
|
||||||
|
glfwScrollCallback window xoffset yoffset = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_ScrollCallback(
|
||||||
|
static_cast<GLFWwindow *>(
|
||||||
|
$(void * windowPtr)
|
||||||
|
),
|
||||||
|
$(double xoffset),
|
||||||
|
$(double yoffset)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
windowPtr = castPtr $ unWindow window
|
||||||
|
|
||||||
|
glfwKeyCallback :: MonadIO m => Window -> CInt -> CInt -> CInt -> CInt -> m ()
|
||||||
|
glfwKeyCallback window key scancode action mods = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_KeyCallback(
|
||||||
|
static_cast<GLFWwindow *>(
|
||||||
|
$(void * windowPtr)
|
||||||
|
),
|
||||||
|
$(int key),
|
||||||
|
$(int scancode),
|
||||||
|
$(int action),
|
||||||
|
$(int mods)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
windowPtr = castPtr $ unWindow window
|
||||||
|
|
||||||
|
glfwCharCallback :: MonadIO m => Window -> CUInt -> m ()
|
||||||
|
glfwCharCallback window c = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_CharCallback(
|
||||||
|
static_cast<GLFWwindow *>(
|
||||||
|
$(void * windowPtr)
|
||||||
|
),
|
||||||
|
$(unsigned int c)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
windowPtr = castPtr $ unWindow window
|
||||||
|
|
||||||
|
glfwMonitorCallback :: MonadIO m => Monitor -> CInt -> m ()
|
||||||
|
glfwMonitorCallback monitor event = liftIO do
|
||||||
|
[C.exp| void {
|
||||||
|
ImGui_ImplGlfw_MonitorCallback(
|
||||||
|
static_cast<GLFWmonitor *>(
|
||||||
|
$(void * monitorPtr)
|
||||||
|
),
|
||||||
|
$(int event)
|
||||||
|
);
|
||||||
|
} |]
|
||||||
|
where
|
||||||
|
monitorPtr = castPtr $ unMonitor monitor
|
||||||
|
|
||||||
|
-- | Strip the unpublished newtype wrapper.
|
||||||
|
unWindow :: Window -> Ptr C'GLFWwindow
|
||||||
|
unWindow = unsafeCoerce
|
||||||
|
|
||||||
|
-- | Strip the unpublished newtype wrapper.
|
||||||
|
unMonitor :: Monitor -> Ptr C'GLFWmonitor
|
||||||
|
unMonitor = unsafeCoerce
|
||||||
|
@ -7,6 +7,7 @@
|
|||||||
{-# LANGUAGE PatternSynonyms #-}
|
{-# LANGUAGE PatternSynonyms #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
{-|
|
{-|
|
||||||
Module: DearImGui
|
Module: DearImGui
|
||||||
@ -19,6 +20,8 @@ module DearImGui.Raw
|
|||||||
Context(..)
|
Context(..)
|
||||||
, createContext
|
, createContext
|
||||||
, destroyContext
|
, destroyContext
|
||||||
|
, getCurrentContext
|
||||||
|
, setCurrentContext
|
||||||
|
|
||||||
-- * Main
|
-- * Main
|
||||||
, newFrame
|
, newFrame
|
||||||
@ -43,6 +46,16 @@ module DearImGui.Raw
|
|||||||
-- * Windows
|
-- * Windows
|
||||||
, begin
|
, begin
|
||||||
, end
|
, end
|
||||||
|
|
||||||
|
-- ** Utilities
|
||||||
|
|
||||||
|
, getWindowPos
|
||||||
|
, getWindowSize
|
||||||
|
, getWindowWidth
|
||||||
|
, getWindowHeight
|
||||||
|
|
||||||
|
-- ** Manipulation
|
||||||
|
|
||||||
, setNextWindowPos
|
, setNextWindowPos
|
||||||
, setNextWindowSize
|
, setNextWindowSize
|
||||||
, setNextWindowFullscreen
|
, setNextWindowFullscreen
|
||||||
@ -51,8 +64,9 @@ module DearImGui.Raw
|
|||||||
, setNextWindowCollapsed
|
, setNextWindowCollapsed
|
||||||
, setNextWindowBgAlpha
|
, setNextWindowBgAlpha
|
||||||
|
|
||||||
-- * Child Windows
|
-- ** Child Windows
|
||||||
, beginChild
|
, beginChild
|
||||||
|
, beginChildContext
|
||||||
, endChild
|
, endChild
|
||||||
|
|
||||||
-- * Parameter stacks
|
-- * Parameter stacks
|
||||||
@ -89,7 +103,10 @@ module DearImGui.Raw
|
|||||||
-- ** Main
|
-- ** Main
|
||||||
, button
|
, button
|
||||||
, smallButton
|
, smallButton
|
||||||
|
, invisibleButton
|
||||||
, arrowButton
|
, arrowButton
|
||||||
|
, image
|
||||||
|
, imageButton
|
||||||
, checkbox
|
, checkbox
|
||||||
, progressBar
|
, progressBar
|
||||||
, bullet
|
, bullet
|
||||||
@ -131,6 +148,8 @@ module DearImGui.Raw
|
|||||||
|
|
||||||
-- ** Text Input
|
-- ** Text Input
|
||||||
, inputText
|
, inputText
|
||||||
|
, inputTextMultiline
|
||||||
|
, inputTextWithHint
|
||||||
|
|
||||||
-- * Color Editor/Picker
|
-- * Color Editor/Picker
|
||||||
, colorPicker3
|
, colorPicker3
|
||||||
@ -178,11 +197,26 @@ module DearImGui.Raw
|
|||||||
, openPopup
|
, openPopup
|
||||||
, closeCurrentPopup
|
, closeCurrentPopup
|
||||||
|
|
||||||
|
-- * ID stack/scopes
|
||||||
|
, pushIDInt
|
||||||
|
, pushIDPtr
|
||||||
|
, pushIDStr
|
||||||
|
, pushIDStrLen
|
||||||
|
, popID
|
||||||
|
|
||||||
-- * Item/Widgets Utilities
|
-- * Item/Widgets Utilities
|
||||||
, isItemHovered
|
, isItemHovered
|
||||||
, wantCaptureMouse
|
, wantCaptureMouse
|
||||||
, wantCaptureKeyboard
|
, wantCaptureKeyboard
|
||||||
|
|
||||||
|
-- * Fonts in default font atlas
|
||||||
|
, Font(..)
|
||||||
|
, addFontDefault
|
||||||
|
, addFontFromFileTTF
|
||||||
|
, addFontFromMemoryTTF
|
||||||
|
, buildFontAtlas
|
||||||
|
, clearFontAtlas
|
||||||
|
|
||||||
-- * Types
|
-- * Types
|
||||||
, module DearImGui.Enums
|
, module DearImGui.Enums
|
||||||
, module DearImGui.Structs
|
, module DearImGui.Structs
|
||||||
@ -213,19 +247,30 @@ Cpp.using "namespace ImGui"
|
|||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGuiContext*@.
|
-- | Wraps @ImGuiContext*@.
|
||||||
newtype Context = Context (Ptr ())
|
newtype Context = Context (Ptr ImGuiContext)
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui::CreateContext()@.
|
-- | Wraps @ImGui::CreateContext()@.
|
||||||
createContext :: (MonadIO m) => m Context
|
createContext :: (MonadIO m) => m Context
|
||||||
createContext = liftIO do
|
createContext = liftIO do
|
||||||
Context <$> [C.exp| void* { CreateContext() } |]
|
Context <$> [C.exp| ImGuiContext* { CreateContext() } |]
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui::DestroyContext()@.
|
-- | Wraps @ImGui::DestroyContext()@.
|
||||||
destroyContext :: (MonadIO m) => Context -> m ()
|
destroyContext :: (MonadIO m) => Context -> m ()
|
||||||
destroyContext (Context contextPtr) = liftIO do
|
destroyContext (Context contextPtr) = liftIO do
|
||||||
[C.exp| void { DestroyContext((ImGuiContext*)$(void* contextPtr)); } |]
|
[C.exp| void { DestroyContext($(ImGuiContext* contextPtr)); } |]
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::GetCurrentContext()@.
|
||||||
|
getCurrentContext :: MonadIO m => m Context
|
||||||
|
getCurrentContext = liftIO do
|
||||||
|
Context <$> [C.exp| ImGuiContext* { GetCurrentContext() } |]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::SetCurrentContext()@.
|
||||||
|
setCurrentContext :: MonadIO m => Context -> m ()
|
||||||
|
setCurrentContext (Context contextPtr) = liftIO do
|
||||||
|
[C.exp| void { SetCurrentContext($(ImGuiContext* contextPtr)) } |]
|
||||||
|
|
||||||
|
|
||||||
-- | Start a new Dear ImGui frame, you can submit any command from this point
|
-- | Start a new Dear ImGui frame, you can submit any command from this point
|
||||||
@ -339,10 +384,14 @@ styleColorsClassic = liftIO do
|
|||||||
--
|
--
|
||||||
-- Passing non-null @Ptr CBool@ shows a window-closing widget in the upper-right corner of the window,
|
-- Passing non-null @Ptr CBool@ shows a window-closing widget in the upper-right corner of the window,
|
||||||
-- wich clicking will set the boolean to false when clicked.
|
-- wich clicking will set the boolean to false when clicked.
|
||||||
begin :: (MonadIO m) => CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool
|
begin :: (MonadIO m) => CString -> Maybe (Ptr CBool) -> Maybe (ImGuiWindowFlags) -> m Bool
|
||||||
begin namePtr openPtr flags = liftIO do
|
begin namePtr (Just openPtr) (Just flags) = liftIO do
|
||||||
(0 /=) <$> [C.exp| bool { Begin($(char* namePtr), $(bool* openPtr), $(ImGuiWindowFlags flags)) } |]
|
(0 /=) <$> [C.exp| bool { Begin($(char* namePtr), $(bool* openPtr), $(ImGuiWindowFlags flags)) } |]
|
||||||
|
begin namePtr (Just openPtr) Nothing = liftIO do
|
||||||
|
(0 /=) <$> [C.exp| bool { Begin($(char* namePtr), $(bool* openPtr)) } |]
|
||||||
|
begin namePtr Nothing Nothing = liftIO do
|
||||||
|
(0 /=) <$> [C.exp| bool { Begin($(char* namePtr)) } |]
|
||||||
|
begin _ Nothing _ = error "C++ default argument restriction."
|
||||||
|
|
||||||
-- | Pop window from the stack.
|
-- | Pop window from the stack.
|
||||||
--
|
--
|
||||||
@ -352,11 +401,47 @@ end = liftIO do
|
|||||||
[C.exp| void { End(); } |]
|
[C.exp| void { End(); } |]
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui::BeginChild()@.
|
-- | Begin a self-contained independent scrolling/clipping regions within a host window.
|
||||||
beginChild :: (MonadIO m) => CString -> m Bool
|
--
|
||||||
beginChild namePtr = liftIO do
|
-- Child windows can embed their own child.
|
||||||
(0 /=) <$> [C.exp| bool { BeginChild($(char* namePtr)) } |]
|
--
|
||||||
|
-- For each independent axis of @size@:
|
||||||
|
-- * ==0.0f: use remaining host window size
|
||||||
|
-- * >0.0f: fixed size
|
||||||
|
-- * <0.0f: use remaining window size minus abs(size)
|
||||||
|
--
|
||||||
|
-- Each axis can use a different mode, e.g. @ImVec2 0 400@.
|
||||||
|
--
|
||||||
|
-- @BeginChild()@ returns `False` to indicate the window is collapsed or fully clipped, so you may early out and omit submitting anything to the window.
|
||||||
|
--
|
||||||
|
-- Always call a matching `endChild` for each `beginChild` call, regardless of its return value.
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::BeginChild()@.
|
||||||
|
beginChild :: (MonadIO m) => CString -> Ptr ImVec2 -> CBool -> ImGuiWindowFlags -> m Bool
|
||||||
|
beginChild namePtr sizePtr border flags = liftIO do
|
||||||
|
(0 /=) <$> [C.exp|
|
||||||
|
bool {
|
||||||
|
BeginChild(
|
||||||
|
$(char* namePtr),
|
||||||
|
*$(ImVec2* sizePtr),
|
||||||
|
$(bool border),
|
||||||
|
$(ImGuiWindowFlags flags)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- | Switch context to another child window by its ID
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::BeginChild()@.
|
||||||
|
beginChildContext :: (MonadIO m) => CString -> m Bool
|
||||||
|
beginChildContext namePtr = liftIO do
|
||||||
|
(0 /=) <$> [C.exp|
|
||||||
|
bool {
|
||||||
|
BeginChild(
|
||||||
|
$(char* namePtr)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
-- | Wraps @ImGui::EndChild()@.
|
-- | Wraps @ImGui::EndChild()@.
|
||||||
endChild :: (MonadIO m) => m ()
|
endChild :: (MonadIO m) => m ()
|
||||||
@ -387,9 +472,11 @@ sameLine = liftIO do
|
|||||||
-- B) it's faster, no memory copy is done, no buffer size limits, recommended for long chunks of text.
|
-- B) it's faster, no memory copy is done, no buffer size limits, recommended for long chunks of text.
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::TextUnformatted()@.
|
-- Wraps @ImGui::TextUnformatted()@.
|
||||||
textUnformatted :: (MonadIO m) => CString -> CString -> m ()
|
textUnformatted :: (MonadIO m) => CString -> Maybe CString -> m ()
|
||||||
textUnformatted textPtr textEndPtr = liftIO do
|
textUnformatted textPtr (Just textEndPtr) = liftIO do
|
||||||
[C.exp| void { TextUnformatted($(char* textPtr), $(char* textEndPtr)) } |]
|
[C.exp| void { TextUnformatted($(char* textPtr), $(char* textEndPtr)) } |]
|
||||||
|
textUnformatted textPtr Nothing = liftIO do
|
||||||
|
[C.exp| void { TextUnformatted($(char* textPtr)) } |]
|
||||||
|
|
||||||
-- | Shortcut for @PushStyleColor(ImGuiCol_Text, col); Text(fmt, ...); PopStyleColor();@.
|
-- | Shortcut for @PushStyleColor(ImGuiCol_Text, col); Text(fmt, ...); PopStyleColor();@.
|
||||||
--
|
--
|
||||||
@ -455,6 +542,24 @@ smallButton labelPtr = liftIO do
|
|||||||
(0 /=) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |]
|
(0 /=) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Flexible button behavior without the visuals.
|
||||||
|
--
|
||||||
|
-- Frequently useful to build custom behaviors using the public api
|
||||||
|
-- (along with IsItemActive, IsItemHovered, etc).
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::InvisibleButton()@.
|
||||||
|
invisibleButton :: (MonadIO m) => CString -> Ptr ImVec2 -> ImGuiButtonFlags -> m Bool
|
||||||
|
invisibleButton labelPtr size flags = liftIO do
|
||||||
|
(0 /=) <$> [C.exp|
|
||||||
|
bool {
|
||||||
|
InvisibleButton(
|
||||||
|
$(char* labelPtr),
|
||||||
|
*$(ImVec2* size),
|
||||||
|
$(ImGuiButtonFlags flags)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
-- | Square button with an arrow shape.
|
-- | Square button with an arrow shape.
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::ArrowButton()@.
|
-- Wraps @ImGui::ArrowButton()@.
|
||||||
@ -463,6 +568,50 @@ arrowButton strIdPtr dir = liftIO do
|
|||||||
(0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(ImGuiDir dir)) } |]
|
(0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(ImGuiDir dir)) } |]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Image Area to draw a texture.
|
||||||
|
--
|
||||||
|
-- For OpenGL: The @userTextureIDPtr@ points to the texture memory (eg. @0x0000000000000001@)
|
||||||
|
--
|
||||||
|
-- See @examples/sdl/Image.hs@ for the whole process.
|
||||||
|
--
|
||||||
|
-- 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)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- | 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()@.
|
-- | Wraps @ImGui::Checkbox()@.
|
||||||
checkbox :: (MonadIO m) => CString -> Ptr CBool -> m Bool
|
checkbox :: (MonadIO m) => CString -> Ptr CBool -> m Bool
|
||||||
checkbox labelPtr boolPtr = liftIO do
|
checkbox labelPtr boolPtr = liftIO do
|
||||||
@ -850,10 +999,50 @@ vSliderScalar labelPtr sizePtr dataType dataPtr minPtr maxPtr formatPtr flags =
|
|||||||
minPtr_ = castPtr minPtr
|
minPtr_ = castPtr minPtr
|
||||||
maxPtr_ = castPtr maxPtr
|
maxPtr_ = castPtr maxPtr
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui::InputText()@.
|
-- | Wraps @ImGui::InputText()@.
|
||||||
inputText :: (MonadIO m) => CString -> CString -> CInt -> m Bool
|
inputText :: (MonadIO m) => CString -> CStringLen -> ImGuiInputTextFlags -> m Bool
|
||||||
inputText descPtr refPtr refSize = liftIO do
|
inputText labelPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do
|
||||||
(0 /= ) <$> [C.exp| bool { InputText( $(char* descPtr), $(char* refPtr), $(int refSize) ) } |]
|
(0 /= ) <$> [C.exp|
|
||||||
|
bool {
|
||||||
|
InputText(
|
||||||
|
$(char* labelPtr),
|
||||||
|
$(char* bufPtr),
|
||||||
|
$(int bufSize),
|
||||||
|
$(ImGuiInputTextFlags flags)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::InputTextMultiline()@.
|
||||||
|
inputTextMultiline :: (MonadIO m) => CString -> CStringLen -> Ptr ImVec2 -> ImGuiInputTextFlags -> m Bool
|
||||||
|
inputTextMultiline labelPtr (bufPtr, fromIntegral -> bufSize) sizePtr flags = liftIO do
|
||||||
|
(0 /= ) <$> [C.exp|
|
||||||
|
bool {
|
||||||
|
InputTextMultiline(
|
||||||
|
$(char* labelPtr),
|
||||||
|
$(char* bufPtr),
|
||||||
|
$(size_t bufSize),
|
||||||
|
*$(ImVec2* sizePtr),
|
||||||
|
$(ImGuiInputTextFlags flags)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::InputTextWithHint()@.
|
||||||
|
inputTextWithHint :: (MonadIO m) => CString -> CString -> CStringLen -> ImGuiInputTextFlags -> m Bool
|
||||||
|
inputTextWithHint labelPtr hintPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do
|
||||||
|
(0 /= ) <$> [C.exp|
|
||||||
|
bool {
|
||||||
|
InputTextWithHint(
|
||||||
|
$(char* labelPtr),
|
||||||
|
$(char* hintPtr),
|
||||||
|
$(char* bufPtr),
|
||||||
|
$(int bufSize),
|
||||||
|
$(ImGuiInputTextFlags flags)
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui::ColorPicker3()@.
|
-- | Wraps @ImGui::ColorPicker3()@.
|
||||||
@ -1075,13 +1264,40 @@ isItemHovered :: (MonadIO m) => m Bool
|
|||||||
isItemHovered = liftIO do
|
isItemHovered = liftIO do
|
||||||
(0 /=) <$> [C.exp| bool { IsItemHovered() } |]
|
(0 /=) <$> [C.exp| bool { IsItemHovered() } |]
|
||||||
|
|
||||||
|
getWindowPos :: (MonadIO m) => m ImVec2
|
||||||
|
getWindowPos = liftIO do
|
||||||
|
C.withPtr_ \ptr ->
|
||||||
|
[C.block|
|
||||||
|
void {
|
||||||
|
*$(ImVec2 * ptr) = GetWindowPos();
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
getWindowSize :: (MonadIO m) => m ImVec2
|
||||||
|
getWindowSize = liftIO do
|
||||||
|
C.withPtr_ \ptr ->
|
||||||
|
[C.block|
|
||||||
|
void {
|
||||||
|
*$(ImVec2 * ptr) = GetWindowSize();
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
getWindowWidth :: (MonadIO m) => m CFloat
|
||||||
|
getWindowWidth = liftIO do
|
||||||
|
[C.exp| float { GetWindowWidth() } |]
|
||||||
|
|
||||||
|
getWindowHeight :: (MonadIO m) => m CFloat
|
||||||
|
getWindowHeight = liftIO do
|
||||||
|
[C.exp| float { GetWindowHeight() } |]
|
||||||
|
|
||||||
-- | Set next window position. Call before `begin` Use pivot=(0.5,0.5) to center on given point, etc.
|
-- | Set next window position. Call before `begin` Use pivot=(0.5,0.5) to center on given point, etc.
|
||||||
--
|
--
|
||||||
-- Wraps @ImGui::SetNextWindowPos()@
|
-- Wraps @ImGui::SetNextWindowPos()@
|
||||||
setNextWindowPos :: (MonadIO m) => Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> m ()
|
setNextWindowPos :: (MonadIO m) => Ptr ImVec2 -> ImGuiCond -> Maybe (Ptr ImVec2) -> m ()
|
||||||
setNextWindowPos posPtr cond pivotPtr = liftIO do
|
setNextWindowPos posPtr cond (Just pivotPtr) = liftIO do
|
||||||
[C.exp| void { SetNextWindowPos(*$(ImVec2* posPtr), $(ImGuiCond cond), *$(ImVec2* pivotPtr)) } |]
|
[C.exp| void { SetNextWindowPos(*$(ImVec2* posPtr), $(ImGuiCond cond), *$(ImVec2* pivotPtr)) } |]
|
||||||
|
setNextWindowPos posPtr cond Nothing = liftIO do
|
||||||
|
[C.exp| void { SetNextWindowPos(*$(ImVec2* posPtr), $(ImGuiCond cond)) } |]
|
||||||
|
|
||||||
|
|
||||||
-- | Set next window size. Call before `begin`
|
-- | Set next window size. Call before `begin`
|
||||||
@ -1261,6 +1477,44 @@ popStyleVar :: (MonadIO m) => CInt -> m ()
|
|||||||
popStyleVar n = liftIO do
|
popStyleVar n = liftIO do
|
||||||
[C.exp| void { PopStyleVar($(int n)) } |]
|
[C.exp| void { PopStyleVar($(int n)) } |]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Push integer into the ID stack (will hash int).
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::PushId@
|
||||||
|
pushIDInt :: (MonadIO m) => CInt -> m ()
|
||||||
|
pushIDInt intId = liftIO do
|
||||||
|
[C.exp| void { PushID($(int intId)) } |]
|
||||||
|
|
||||||
|
-- | Push pointer into the ID stack (will hash pointer).
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::PushId@
|
||||||
|
pushIDPtr :: (MonadIO m) => Ptr a -> m ()
|
||||||
|
pushIDPtr ptr = liftIO do
|
||||||
|
[C.exp| void { PushID($(void * ptr_)) } |]
|
||||||
|
where
|
||||||
|
ptr_ = castPtr ptr
|
||||||
|
|
||||||
|
-- | Push string into the ID stack (will hash string).
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::PushId@
|
||||||
|
pushIDStr :: (MonadIO m) => CString -> m ()
|
||||||
|
pushIDStr strId = liftIO do
|
||||||
|
[C.exp| void { PushID($(char * strId)) } |]
|
||||||
|
|
||||||
|
-- | Push string into the ID stack (will hash string).
|
||||||
|
--
|
||||||
|
-- Wraps @ImGui::PushId@
|
||||||
|
pushIDStrLen :: (MonadIO m) => CStringLen -> m ()
|
||||||
|
pushIDStrLen (strBegin, strLen) = liftIO do
|
||||||
|
[C.exp| void { PushID($(char * strBegin), $(char * strEnd)) } |]
|
||||||
|
where
|
||||||
|
strEnd = plusPtr strBegin strLen
|
||||||
|
|
||||||
|
popID :: (MonadIO m) => m ()
|
||||||
|
popID = liftIO do
|
||||||
|
[C.exp| void { PopID() } |]
|
||||||
|
|
||||||
|
|
||||||
wantCaptureMouse :: MonadIO m => m Bool
|
wantCaptureMouse :: MonadIO m => m Bool
|
||||||
wantCaptureMouse = liftIO do
|
wantCaptureMouse = liftIO do
|
||||||
(0 /=) <$> [C.exp| bool { GetIO().WantCaptureMouse } |]
|
(0 /=) <$> [C.exp| bool { GetIO().WantCaptureMouse } |]
|
||||||
@ -1268,3 +1522,54 @@ wantCaptureMouse = liftIO do
|
|||||||
wantCaptureKeyboard :: MonadIO m => m Bool
|
wantCaptureKeyboard :: MonadIO m => m Bool
|
||||||
wantCaptureKeyboard = liftIO do
|
wantCaptureKeyboard = liftIO do
|
||||||
(0 /=) <$> [C.exp| bool { GetIO().WantCaptureKeyboard } |]
|
(0 /=) <$> [C.exp| bool { GetIO().WantCaptureKeyboard } |]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Wraps @ImFont*@.
|
||||||
|
newtype Font = Font (Ptr ImFont)
|
||||||
|
|
||||||
|
addFontDefault :: MonadIO m => m Font
|
||||||
|
addFontDefault = liftIO do
|
||||||
|
Font <$> [C.block|
|
||||||
|
ImFont* {
|
||||||
|
return GetIO().Fonts->AddFontDefault();
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
addFontFromFileTTF :: MonadIO m => CString -> CFloat -> m Font
|
||||||
|
addFontFromFileTTF filenamePtr sizePixels = liftIO do
|
||||||
|
Font <$> [C.block|
|
||||||
|
ImFont* {
|
||||||
|
return GetIO().Fonts->AddFontFromFileTTF(
|
||||||
|
$(char* filenamePtr),
|
||||||
|
$(float sizePixels));
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- | Transfer a buffer with TTF data to font atlas builder.
|
||||||
|
addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> m Font
|
||||||
|
addFontFromMemoryTTF (castPtr -> fontDataPtr, fromIntegral -> fontSize) sizePixels = liftIO do
|
||||||
|
Font <$> [C.block|
|
||||||
|
ImFont* {
|
||||||
|
return GetIO().Fonts->AddFontFromMemoryTTF(
|
||||||
|
$(void* fontDataPtr),
|
||||||
|
$(int fontSize),
|
||||||
|
$(float sizePixels)
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
buildFontAtlas :: MonadIO m => m ()
|
||||||
|
buildFontAtlas = liftIO do
|
||||||
|
[C.block|
|
||||||
|
void {
|
||||||
|
GetIO().Fonts->Build();
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
clearFontAtlas :: MonadIO m => m ()
|
||||||
|
clearFontAtlas = liftIO do
|
||||||
|
[C.block|
|
||||||
|
void {
|
||||||
|
GetIO().Fonts->Clear();
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
@ -40,7 +40,6 @@ import qualified Language.C.Inline.Cpp as Cpp
|
|||||||
|
|
||||||
-- sdl2
|
-- sdl2
|
||||||
import SDL
|
import SDL
|
||||||
import SDL.Internal.Types
|
|
||||||
import SDL.Raw.Enum as Raw
|
import SDL.Raw.Enum as Raw
|
||||||
import qualified SDL.Raw.Event as Raw
|
import qualified SDL.Raw.Event as Raw
|
||||||
|
|
||||||
@ -57,9 +56,9 @@ Cpp.using "namespace ImGui"
|
|||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui_ImplSDL2_NewFrame@.
|
-- | Wraps @ImGui_ImplSDL2_NewFrame@.
|
||||||
sdl2NewFrame :: MonadIO m => Window -> m ()
|
sdl2NewFrame :: MonadIO m => m ()
|
||||||
sdl2NewFrame (Window windowPtr) = liftIO do
|
sdl2NewFrame = liftIO do
|
||||||
[C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |]
|
[C.exp| void { ImGui_ImplSDL2_NewFrame(); } |]
|
||||||
|
|
||||||
|
|
||||||
-- | Wraps @ImGui_ImplSDL2_Shutdown@.
|
-- | Wraps @ImGui_ImplSDL2_Shutdown@.
|
||||||
|
@ -9,6 +9,7 @@ import Foreign
|
|||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
|
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
instance Storable ImVec2 where
|
instance Storable ImVec2 where
|
||||||
@ -27,6 +28,7 @@ instance Storable ImVec2 where
|
|||||||
|
|
||||||
|
|
||||||
data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
|
data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
instance Storable ImVec3 where
|
instance Storable ImVec3 where
|
||||||
@ -47,6 +49,7 @@ instance Storable ImVec3 where
|
|||||||
|
|
||||||
|
|
||||||
data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
|
data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
instance Storable ImVec4 where
|
instance Storable ImVec4 where
|
||||||
@ -66,3 +69,11 @@ instance Storable ImVec4 where
|
|||||||
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
|
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
|
||||||
w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
|
w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
|
||||||
return ImVec4{ x, y, z, w }
|
return ImVec4{ x, y, z, w }
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | DearImGui context handle.
|
||||||
|
data ImGuiContext
|
||||||
|
|
||||||
|
-- | Individual font handle.
|
||||||
|
data ImFont
|
||||||
|
Reference in New Issue
Block a user