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 |
35
ChangeLog.md
35
ChangeLog.md
@ -1,7 +1,38 @@
|
||||
# Changelog for dear-imgui
|
||||
|
||||
## [1.0.0] Initial Hackage release
|
||||
## [1.2.0]
|
||||
|
||||
Based on 1.83.
|
||||
- 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
|
||||
loop w checked color slider r pos size' selected tab1 tab2
|
||||
|
||||
openGL3Shutdown
|
||||
|
||||
|
||||
loop
|
||||
:: Window
|
||||
-> IORef Bool
|
||||
-> IORef ImVec3
|
||||
-> IORef (Float, Float, Float)
|
||||
-> IORef Int
|
||||
-> IORef ImVec2
|
||||
loop
|
||||
:: Window
|
||||
-> IORef Bool
|
||||
-> IORef ImVec3
|
||||
-> IORef (Float, Float, Float)
|
||||
-> IORef Int
|
||||
-> IORef ImVec2
|
||||
-> IORef Int
|
||||
-> IORef ImVec2
|
||||
-> IORef Int
|
||||
-> IORef Bool
|
||||
-> IORef Bool
|
||||
-> IO ()
|
||||
loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||
quit <- pollEvents
|
||||
loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||
shouldQuit <- checkEvents
|
||||
|
||||
openGL3NewFrame
|
||||
sdl2NewFrame w
|
||||
sdl2NewFrame
|
||||
newFrame
|
||||
|
||||
-- showDemoWindow
|
||||
@ -68,7 +66,7 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||
setNextWindowPos pos ImGuiCond_Once Nothing
|
||||
setNextWindowSize size' ImGuiCond_Once
|
||||
-- Works, but will make the window contents illegible without doing something more involved.
|
||||
-- setNextWindowContentSize size'
|
||||
-- setNextWindowContentSize size'
|
||||
-- setNextWindowSizeConstraints size' size'
|
||||
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")
|
||||
|
||||
beginChild "Child"
|
||||
beginChild "Child" (ImVec2 0 0) True ImGuiWindowFlags_None
|
||||
|
||||
beginCombo "Label" "Preview" >>= whenTrue do
|
||||
selectable "Testing 1"
|
||||
@ -164,13 +162,15 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||
glClear GL_COLOR_BUFFER_BIT
|
||||
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
|
||||
|
||||
pollEvents = do
|
||||
checkEvents = do
|
||||
ev <- pollEventWithImGui
|
||||
|
||||
case ev of
|
||||
@ -180,9 +180,9 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||
QuitEvent -> True
|
||||
_ -> False
|
||||
|
||||
(isQuit ||) <$> pollEvents
|
||||
(isQuit ||) <$> checkEvents
|
||||
|
||||
|
||||
whenTrue :: IO () -> Bool -> IO ()
|
||||
whenTrue io True = io
|
||||
whenTrue io False = return ()
|
||||
whenTrue _io False = return ()
|
||||
|
@ -81,7 +81,7 @@ mainLoop w = do
|
||||
|
||||
-- Tell ImGui we're starting a new frame
|
||||
openGL2NewFrame
|
||||
sdl2NewFrame w
|
||||
sdl2NewFrame
|
||||
newFrame
|
||||
|
||||
-- Build the GUI
|
||||
|
@ -1,3 +1,4 @@
|
||||
packages: *.cabal
|
||||
package dear-imgui
|
||||
flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
|
||||
ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind
|
||||
|
@ -1,7 +1,7 @@
|
||||
cabal-version: 3.0
|
||||
|
||||
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
|
||||
@ -15,8 +15,14 @@ description:
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md,
|
||||
ChangeLog.md,
|
||||
imgui/imgui.h
|
||||
ChangeLog.md
|
||||
|
||||
extra-source-files:
|
||||
imgui/*.h,
|
||||
imgui/backends/*.h,
|
||||
imgui/backends/*.mm,
|
||||
imgui/imconfig.h,
|
||||
imgui/LICENSE.txt
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -175,7 +181,8 @@ library
|
||||
exposed-modules:
|
||||
DearImGui.GLFW
|
||||
build-depends:
|
||||
GLFW-b
|
||||
GLFW-b,
|
||||
bindings-GLFW
|
||||
cxx-sources:
|
||||
imgui/backends/imgui_impl_glfw.cpp
|
||||
|
||||
@ -213,7 +220,7 @@ library dear-imgui-generator
|
||||
, megaparsec
|
||||
>= 9.0 && < 9.1
|
||||
, parser-combinators
|
||||
>= 1.2.0 && < 1.3
|
||||
>= 1.2.0 && < 1.4
|
||||
, scientific
|
||||
>= 0.3.6.2 && < 0.3.8
|
||||
, text
|
||||
@ -253,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
|
||||
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
|
||||
buildable: False
|
||||
|
||||
executable vulkan
|
||||
import: common
|
||||
main-is: Main.hs
|
||||
|
@ -24,34 +24,34 @@ main = do
|
||||
|
||||
runManaged do
|
||||
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
|
||||
w <- do
|
||||
window <- do
|
||||
let title = "Hello, Dear ImGui!"
|
||||
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
|
||||
managed $ bracket (createWindow title config) destroyWindow
|
||||
|
||||
-- Create an OpenGL context
|
||||
glContext <- managed $ bracket (glCreateContext w) glDeleteContext
|
||||
glContext <- managed $ bracket (glCreateContext window) glDeleteContext
|
||||
|
||||
-- Create an ImGui context
|
||||
_ <- managed $ bracket createContext destroyContext
|
||||
|
||||
-- Initialize ImGui's SDL2 backend
|
||||
_ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown
|
||||
_ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
|
||||
|
||||
-- Initialize ImGui's OpenGL backend
|
||||
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
|
||||
|
||||
liftIO $ mainLoop w
|
||||
liftIO $ mainLoop window
|
||||
|
||||
|
||||
mainLoop :: Window -> IO ()
|
||||
mainLoop w = do
|
||||
mainLoop window = do
|
||||
-- Process the event loop
|
||||
untilNothingM pollEventWithImGui
|
||||
|
||||
-- Tell ImGui we're starting a new frame
|
||||
openGL2NewFrame
|
||||
sdl2NewFrame w
|
||||
sdl2NewFrame
|
||||
newFrame
|
||||
|
||||
-- Build the GUI
|
||||
@ -73,9 +73,9 @@ mainLoop w = do
|
||||
render
|
||||
openGL2RenderDrawData =<< getDrawData
|
||||
|
||||
glSwapWindow w
|
||||
glSwapWindow window
|
||||
|
||||
mainLoop w
|
||||
mainLoop window
|
||||
|
||||
where
|
||||
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) )
|
||||
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 = runResourceT . ( `runLoggingT` logHandler ) $ app @( LoggingT LogMessage ( ResourceT IO ) )
|
||||
|
||||
@ -120,6 +134,12 @@ app = do
|
||||
ImGui.createContext
|
||||
ImGui.destroyContext
|
||||
|
||||
logDebug "Adding fonts"
|
||||
ImGui.clearFontAtlas
|
||||
_default <- ImGui.addFontDefault
|
||||
_custom <- ImGui.addFontFromFileTTF "imgui/misc/fonts/ProggyTiny.ttf" 10
|
||||
ImGui.buildFontAtlas
|
||||
|
||||
let
|
||||
preferredFormat :: Vulkan.SurfaceFormatKHR
|
||||
preferredFormat =
|
||||
@ -341,12 +361,6 @@ app = do
|
||||
pure ( True, False )
|
||||
else
|
||||
handleJust vulkanException ( pure . reloadQuit ) do
|
||||
ImGui.Vulkan.vulkanNewFrame
|
||||
ImGui.SDL.sdl2NewFrame window
|
||||
ImGui.newFrame
|
||||
ImGui.showDemoWindow
|
||||
ImGui.render
|
||||
drawData <- ImGui.getDrawData
|
||||
let
|
||||
commandBuffer :: Vulkan.CommandBuffer
|
||||
commandBuffer = commandBuffers Boxed.Vector.! fromIntegral nextImageIndex
|
||||
@ -355,7 +369,10 @@ app = do
|
||||
Vulkan.resetCommandBuffer commandBuffer Vulkan.zero
|
||||
beginCommandBuffer commandBuffer
|
||||
cmdBeginRenderPass commandBuffer imGuiRenderPass framebuffer clearValues swapchainExtent
|
||||
|
||||
drawData <- gui
|
||||
ImGui.Vulkan.vulkanRenderDrawData drawData commandBuffer Nothing
|
||||
|
||||
cmdEndRenderPass commandBuffer
|
||||
endCommandBuffer commandBuffer
|
||||
submitCommandBuffer
|
||||
@ -370,7 +387,7 @@ app = do
|
||||
freeOldResources
|
||||
let
|
||||
freeOldResources :: m ()
|
||||
freeOldResources = pure ()
|
||||
freeOldResources = pure ()
|
||||
unless quit $ mainLoop ( AppState {..} )
|
||||
|
||||
let
|
||||
|
@ -12,8 +12,6 @@ module DearImGui.Generator
|
||||
-- base
|
||||
import Control.Arrow
|
||||
( second )
|
||||
import Data.Coerce
|
||||
( coerce )
|
||||
import Data.Bits
|
||||
( Bits )
|
||||
import Data.Foldable
|
||||
@ -54,7 +52,6 @@ import qualified Language.Haskell.TH.Syntax as TH
|
||||
|
||||
-- text
|
||||
import qualified Data.Text as Text
|
||||
( isInfixOf, null, unpack, unlines )
|
||||
import qualified Data.Text.IO as Text
|
||||
( readFile )
|
||||
|
||||
@ -128,9 +125,9 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
|
||||
classes :: [ TH.Q TH.Type ]
|
||||
classes
|
||||
| isFlagEnum
|
||||
= map TH.conT [ ''Eq, ''Ord, ''Storable, ''Bits ]
|
||||
= map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable, ''Bits ]
|
||||
| otherwise
|
||||
= map TH.conT [ ''Eq, ''Ord, ''Storable ]
|
||||
= map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable ]
|
||||
derivClause :: TH.Q TH.DerivClause
|
||||
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.litT ( TH.numTyLit enumSize )
|
||||
)
|
||||
]
|
||||
]
|
||||
pure ( finiteEnumInst : )
|
||||
else pure id
|
||||
|
||||
synonyms <- for patterns \ ( patternName, patternValue, CommentText patDoc ) -> do
|
||||
synonyms <- for patterns \ ( patternName, patternValue, CommentText _patDoc ) -> do
|
||||
let
|
||||
patNameStr :: String
|
||||
patNameStr = Text.unpack patternName
|
||||
@ -169,7 +166,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
|
||||
patSynSig <- TH.patSynSigD patName ( TH.conT tyName )
|
||||
pat <-
|
||||
#if MIN_VERSION_template_haskell(2,18,0)
|
||||
( if Text.null patDoc
|
||||
( if Text.null _patDoc
|
||||
then TH.patSynD
|
||||
else
|
||||
\ 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",
|
||||
"owner": "input-output-hk",
|
||||
"repo": "haskell.nix",
|
||||
"rev": "ef4aef4ce2060dc1a41b2690df1f54f986e0f9ab",
|
||||
"sha256": "0537fbjh4mcnywa33h4hl135kw7i8c0j8qndyzv5i82j7mc8wjvs",
|
||||
"rev": "970c84ad19e84d4ae42075cfe283022394f6effa",
|
||||
"sha256": "01afbcas324n7j2bpfib7b4fazg5y6k7b74803c0i9ayrs6sgav6",
|
||||
"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"
|
||||
},
|
||||
"niv": {
|
||||
@ -17,10 +17,10 @@
|
||||
"homepage": "https://github.com/nmattia/niv",
|
||||
"owner": "nmattia",
|
||||
"repo": "niv",
|
||||
"rev": "3cd7914b2c4cff48927e11c216dadfab7d903fe5",
|
||||
"sha256": "1agq4nvbhrylf2s77kb4xhh9k7xcwdwggq764k4jgsbs70py8cw3",
|
||||
"rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070",
|
||||
"sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx",
|
||||
"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"
|
||||
},
|
||||
"nixpkgs": {
|
||||
|
132
nix/sources.nix
132
nix/sources.nix
@ -6,52 +6,63 @@ let
|
||||
# The fetchers. fetch_<type> fetches specs of type <type>.
|
||||
#
|
||||
|
||||
fetch_file = pkgs: spec:
|
||||
if spec.builtin or true then
|
||||
builtins_fetchurl { inherit (spec) url sha256; }
|
||||
else
|
||||
pkgs.fetchurl { inherit (spec) url sha256; };
|
||||
fetch_file = pkgs: name: spec:
|
||||
let
|
||||
name' = sanitizeName name + "-src";
|
||||
in
|
||||
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:
|
||||
if spec.builtin or true then
|
||||
builtins_fetchTarball { inherit (spec) url sha256; }
|
||||
else
|
||||
pkgs.fetchzip { inherit (spec) url sha256; };
|
||||
fetch_tarball = pkgs: name: spec:
|
||||
let
|
||||
name' = sanitizeName name + "-src";
|
||||
in
|
||||
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:
|
||||
builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
|
||||
fetch_git = name: spec:
|
||||
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:
|
||||
builtins.trace
|
||||
''
|
||||
WARNING:
|
||||
The niv type "builtin-tarball" will soon be deprecated. You should
|
||||
instead use `builtin = true`.
|
||||
fetch_local = spec: spec.path;
|
||||
|
||||
$ niv modify <package> -a type=tarball -a builtin=true
|
||||
''
|
||||
builtins_fetchTarball { inherit (spec) url sha256; };
|
||||
fetch_builtin-tarball = name: throw
|
||||
''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`.
|
||||
$ niv modify ${name} -a type=tarball -a builtin=true'';
|
||||
|
||||
fetch_builtin-url = spec:
|
||||
builtins.trace
|
||||
''
|
||||
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; });
|
||||
fetch_builtin-url = name: throw
|
||||
''[${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'';
|
||||
|
||||
#
|
||||
# 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.
|
||||
mkPkgs = sources:
|
||||
mkPkgs = sources: system:
|
||||
let
|
||||
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;
|
||||
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
|
||||
in
|
||||
@ -71,14 +82,27 @@ let
|
||||
|
||||
if ! builtins.hasAttr "type" spec then
|
||||
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 == "tarball" then fetch_tarball pkgs spec
|
||||
else if spec.type == "git" then fetch_git spec
|
||||
else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec
|
||||
else if spec.type == "builtin-url" then fetch_builtin-url spec
|
||||
else if spec.type == "file" then fetch_file pkgs name spec
|
||||
else if spec.type == "tarball" then fetch_tarball pkgs name spec
|
||||
else if spec.type == "git" then fetch_git name spec
|
||||
else if spec.type == "local" then fetch_local spec
|
||||
else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
|
||||
else if spec.type == "builtin-url" then fetch_builtin-url name
|
||||
else
|
||||
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
|
||||
|
||||
# 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))
|
||||
);
|
||||
|
||||
# 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
|
||||
builtins_fetchTarball = { url, sha256 }@attrs:
|
||||
builtins_fetchTarball = { url, name ? null, sha256 }@attrs:
|
||||
let
|
||||
inherit (builtins) lessThan nixVersion fetchTarball;
|
||||
in
|
||||
if lessThan nixVersion "1.12" then
|
||||
fetchTarball { inherit url; }
|
||||
fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
|
||||
else
|
||||
fetchTarball attrs;
|
||||
|
||||
# fetchurl version that is compatible between all the versions of Nix
|
||||
builtins_fetchurl = { url, sha256 }@attrs:
|
||||
builtins_fetchurl = { url, name ? null, sha256 }@attrs:
|
||||
let
|
||||
inherit (builtins) lessThan nixVersion fetchurl;
|
||||
in
|
||||
if lessThan nixVersion "1.12" then
|
||||
fetchurl { inherit url; }
|
||||
fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
|
||||
else
|
||||
fetchurl attrs;
|
||||
|
||||
@ -115,14 +153,15 @@ let
|
||||
then abort
|
||||
"The values in sources.json should not have an 'outPath' attribute"
|
||||
else
|
||||
spec // { outPath = fetch config.pkgs name spec; }
|
||||
spec // { outPath = replace name (fetch config.pkgs name spec); }
|
||||
) config.sources;
|
||||
|
||||
# The "config" used by the fetchers
|
||||
mkConfig =
|
||||
{ sourcesFile ? ./sources.json
|
||||
, sources ? builtins.fromJSON (builtins.readFile sourcesFile)
|
||||
, pkgs ? mkPkgs sources
|
||||
{ sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
|
||||
, sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
|
||||
, system ? builtins.currentSystem
|
||||
, pkgs ? mkPkgs sources system
|
||||
}: rec {
|
||||
# The sources, i.e. the attribute set of spec name to spec
|
||||
inherit sources;
|
||||
@ -130,5 +169,6 @@ let
|
||||
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
|
||||
inherit pkgs;
|
||||
};
|
||||
|
||||
in
|
||||
mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }
|
||||
|
261
src/DearImGui.hs
261
src/DearImGui.hs
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
@ -19,6 +20,8 @@ module DearImGui
|
||||
Raw.Context(..)
|
||||
, Raw.createContext
|
||||
, Raw.destroyContext
|
||||
, Raw.getCurrentContext
|
||||
, Raw.setCurrentContext
|
||||
|
||||
-- * Main
|
||||
, Raw.newFrame
|
||||
@ -48,6 +51,15 @@ module DearImGui
|
||||
|
||||
, begin
|
||||
, Raw.end
|
||||
|
||||
-- ** Utilities
|
||||
|
||||
, Raw.getWindowPos
|
||||
, Raw.getWindowSize
|
||||
, Raw.getWindowWidth
|
||||
, Raw.getWindowHeight
|
||||
|
||||
-- ** Manipulation
|
||||
, setNextWindowPos
|
||||
, setNextWindowSize
|
||||
, Raw.setNextWindowFullscreen
|
||||
@ -56,15 +68,19 @@ module DearImGui
|
||||
, setNextWindowCollapsed
|
||||
, setNextWindowBgAlpha
|
||||
|
||||
-- * Child Windows
|
||||
-- ** Child Windows
|
||||
, withChild
|
||||
, withChildOpen
|
||||
, withChildContext
|
||||
, beginChild
|
||||
, Raw.endChild
|
||||
|
||||
-- * Parameter stacks
|
||||
, withStyleColor
|
||||
, pushStyleColor
|
||||
, Raw.popStyleColor
|
||||
|
||||
, withStyleVar
|
||||
, pushStyleVar
|
||||
, popStyleVar
|
||||
|
||||
@ -74,9 +90,13 @@ module DearImGui
|
||||
, Raw.newLine
|
||||
, Raw.spacing
|
||||
, dummy
|
||||
|
||||
, withIndent
|
||||
, indent
|
||||
, unindent
|
||||
|
||||
, setNextItemWidth
|
||||
, withItemWidth
|
||||
, pushItemWidth
|
||||
, Raw.popItemWidth
|
||||
|
||||
@ -87,6 +107,10 @@ module DearImGui
|
||||
, setCursorPos
|
||||
, Raw.alignTextToFramePadding
|
||||
|
||||
-- * ID stack
|
||||
, withID
|
||||
, ToID(..)
|
||||
|
||||
-- * Widgets
|
||||
-- ** Text
|
||||
, text
|
||||
@ -99,7 +123,9 @@ module DearImGui
|
||||
-- ** Main
|
||||
, button
|
||||
, smallButton
|
||||
, invisibleButton
|
||||
, arrowButton
|
||||
, Raw.image
|
||||
, checkbox
|
||||
, progressBar
|
||||
, Raw.bullet
|
||||
@ -143,6 +169,8 @@ module DearImGui
|
||||
|
||||
-- ** Text Input
|
||||
, inputText
|
||||
, inputTextMultiline
|
||||
, inputTextWithHint
|
||||
|
||||
-- * Color Editor/Picker
|
||||
, colorPicker3
|
||||
@ -217,6 +245,13 @@ module DearImGui
|
||||
, Raw.wantCaptureMouse
|
||||
, Raw.wantCaptureKeyboard
|
||||
|
||||
-- * Fonts
|
||||
, Raw.Font
|
||||
, addFontFromFileTTF
|
||||
, Raw.addFontDefault
|
||||
, Raw.buildFontAtlas
|
||||
, Raw.clearFontAtlas
|
||||
|
||||
-- * Types
|
||||
, module DearImGui.Enums
|
||||
, module DearImGui.Structs
|
||||
@ -231,6 +266,9 @@ import Data.Foldable
|
||||
( foldl' )
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
import qualified GHC.Foreign as Foreign
|
||||
import System.IO
|
||||
( utf8 )
|
||||
|
||||
-- dear-imgui
|
||||
import DearImGui.Enums
|
||||
@ -271,7 +309,7 @@ getVersion = liftIO do
|
||||
begin :: MonadIO m => String -> m Bool
|
||||
begin name = liftIO do
|
||||
withCString name \namePtr ->
|
||||
Raw.begin namePtr nullPtr (ImGuiWindowFlags 0)
|
||||
Raw.begin namePtr Nothing Nothing
|
||||
|
||||
-- | Append items to a window.
|
||||
--
|
||||
@ -303,7 +341,7 @@ withFullscreen action = bracket open close (`when` action)
|
||||
open = liftIO do
|
||||
Raw.setNextWindowFullscreen
|
||||
withCString "FullScreen" \namePtr ->
|
||||
Raw.begin namePtr nullPtr fullscreenFlags
|
||||
Raw.begin namePtr (Just nullPtr) (Just fullscreenFlags)
|
||||
|
||||
close = liftIO . const Raw.end
|
||||
|
||||
@ -321,31 +359,58 @@ fullscreenFlags = foldl' (.|.) zeroBits
|
||||
, 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
|
||||
-- within a host window. Child windows can embed their own child.
|
||||
-- | Begin a self-contained independent scrolling/clipping regions within a host window.
|
||||
--
|
||||
-- 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.
|
||||
withChild :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
|
||||
withChild name = bracket (beginChild name) (const Raw.endChild)
|
||||
withChild :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> (Bool -> m a) -> m a
|
||||
withChild name size border flags = bracket (beginChild name size border flags) (const Raw.endChild)
|
||||
|
||||
-- | Child windows used for self-contained independent scrolling/clipping regions
|
||||
-- within a host window. Child windows can embed their own child.
|
||||
-- | Action-skipping wrapper for child windows.
|
||||
--
|
||||
-- Action will be skipped if the child region is collapsed or fully clipped.
|
||||
withChildOpen :: MonadUnliftIO m => String -> m () -> m ()
|
||||
withChildOpen name action =
|
||||
withChild name (`when` action)
|
||||
withChildOpen :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m () -> m ()
|
||||
withChildOpen name size border flags 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.
|
||||
text :: MonadIO m => String -> m ()
|
||||
text t = liftIO do
|
||||
withCString t \textPtr ->
|
||||
Raw.textUnformatted textPtr nullPtr
|
||||
Raw.textUnformatted textPtr Nothing
|
||||
|
||||
-- | Colored text.
|
||||
textColored :: (HasGetter ref ImVec4, MonadIO m) => ref -> String -> m ()
|
||||
@ -395,6 +460,19 @@ smallButton label = liftIO do
|
||||
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.
|
||||
--
|
||||
-- Wraps @ImGui::ArrowButton()@.
|
||||
@ -1053,18 +1131,69 @@ vSliderScalar label size dataType ref refMin refMax format flags = liftIO do
|
||||
|
||||
-- | Wraps @ImGui::InputText()@.
|
||||
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
|
||||
withCString input \ refPtr -> do
|
||||
withCString desc \ descPtr -> do
|
||||
let refSize' :: CInt
|
||||
refSize' = fromIntegral refSize
|
||||
changed <- Raw.inputText descPtr refPtr refSize'
|
||||
Foreign.withCStringLen utf8 input \(refPtr, refSize) ->
|
||||
-- XXX: Allocate and zero buffer to receive imgui updates.
|
||||
bracket (mkBuf refSize) free \bufPtr -> do
|
||||
-- XXX: Copy the original input.
|
||||
copyBytes bufPtr refPtr refSize
|
||||
|
||||
changed <- action (bufPtr, bufSize)
|
||||
|
||||
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
|
||||
where
|
||||
mkBuf refSize =
|
||||
callocBytes $
|
||||
max refSize bufSize +
|
||||
5 -- XXX: max size of UTF8 code point + NUL terminator
|
||||
|
||||
|
||||
-- | Wraps @ImGui::ColorPicker3()@.
|
||||
@ -1357,9 +1486,9 @@ setNextWindowPos posRef cond pivotMaybe = liftIO do
|
||||
Just pivotRef -> do
|
||||
pivot <- get pivotRef
|
||||
with pivot $ \pivotPtr ->
|
||||
Raw.setNextWindowPos posPtr cond pivotPtr
|
||||
Raw.setNextWindowPos posPtr cond (Just pivotPtr)
|
||||
Nothing ->
|
||||
Raw.setNextWindowPos posPtr cond nullPtr
|
||||
Raw.setNextWindowPos posPtr cond Nothing
|
||||
|
||||
-- | Set next window size. Call before `begin`
|
||||
--
|
||||
@ -1415,6 +1544,9 @@ dummy sizeRef = liftIO do
|
||||
size' <- get sizeRef
|
||||
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
|
||||
--
|
||||
@ -1440,6 +1572,10 @@ setNextItemWidth itemWidth = liftIO do
|
||||
Raw.setNextItemWidth (CFloat itemWidth)
|
||||
|
||||
|
||||
withItemWidth :: MonadUnliftIO m => Float -> m a -> m a
|
||||
withItemWidth width =
|
||||
bracket_ (pushItemWidth width) Raw.popItemWidth
|
||||
|
||||
-- Wraps @ImGui::PushItemWidth()@
|
||||
pushItemWidth :: (MonadIO m) => Float -> m ()
|
||||
pushItemWidth itemWidth = liftIO do
|
||||
@ -1460,8 +1596,52 @@ setCursorPos posRef = liftIO do
|
||||
pos <- get posRef
|
||||
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()@
|
||||
pushStyleColor :: (MonadIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m ()
|
||||
@ -1470,8 +1650,13 @@ pushStyleColor col colorRef = liftIO do
|
||||
with color \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()@
|
||||
pushStyleVar :: (MonadIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m ()
|
||||
@ -1480,10 +1665,28 @@ pushStyleVar style valRef = liftIO do
|
||||
with val \valPtr ->
|
||||
Raw.pushStyleVar style valPtr
|
||||
|
||||
|
||||
-- | Remove style variable modifications from the shared stack
|
||||
--
|
||||
-- Wraps @ImGui::PopStyleVar()@
|
||||
popStyleVar :: (MonadIO m) => Int -> m ()
|
||||
popStyleVar n = liftIO do
|
||||
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 "ImVec3", [t| ImVec3 |] )
|
||||
, ( TypeName "ImVec4", [t| ImVec4 |] )
|
||||
, ( TypeName "ImGuiContext", [t| ImGuiContext |] )
|
||||
, ( TypeName "ImFont", [t| ImFont |] )
|
||||
]
|
||||
}
|
||||
|
@ -19,9 +19,33 @@ module DearImGui.GLFW (
|
||||
-- ** GLFW
|
||||
glfwNewFrame
|
||||
, glfwShutdown
|
||||
|
||||
-- $callbacks
|
||||
, glfwWindowFocusCallback
|
||||
, glfwCursorEnterCallback
|
||||
, glfwMouseButtonCallback
|
||||
, glfwScrollCallback
|
||||
, glfwKeyCallback
|
||||
, glfwCharCallback
|
||||
, glfwMonitorCallback
|
||||
)
|
||||
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
|
||||
import qualified Language.C.Inline as C
|
||||
|
||||
@ -44,8 +68,121 @@ glfwNewFrame :: MonadIO m => m ()
|
||||
glfwNewFrame = liftIO do
|
||||
[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@.
|
||||
glfwShutdown :: MonadIO m => m ()
|
||||
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 QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-|
|
||||
Module: DearImGui
|
||||
@ -19,6 +20,8 @@ module DearImGui.Raw
|
||||
Context(..)
|
||||
, createContext
|
||||
, destroyContext
|
||||
, getCurrentContext
|
||||
, setCurrentContext
|
||||
|
||||
-- * Main
|
||||
, newFrame
|
||||
@ -43,6 +46,16 @@ module DearImGui.Raw
|
||||
-- * Windows
|
||||
, begin
|
||||
, end
|
||||
|
||||
-- ** Utilities
|
||||
|
||||
, getWindowPos
|
||||
, getWindowSize
|
||||
, getWindowWidth
|
||||
, getWindowHeight
|
||||
|
||||
-- ** Manipulation
|
||||
|
||||
, setNextWindowPos
|
||||
, setNextWindowSize
|
||||
, setNextWindowFullscreen
|
||||
@ -51,8 +64,9 @@ module DearImGui.Raw
|
||||
, setNextWindowCollapsed
|
||||
, setNextWindowBgAlpha
|
||||
|
||||
-- * Child Windows
|
||||
-- ** Child Windows
|
||||
, beginChild
|
||||
, beginChildContext
|
||||
, endChild
|
||||
|
||||
-- * Parameter stacks
|
||||
@ -89,7 +103,10 @@ module DearImGui.Raw
|
||||
-- ** Main
|
||||
, button
|
||||
, smallButton
|
||||
, invisibleButton
|
||||
, arrowButton
|
||||
, image
|
||||
, imageButton
|
||||
, checkbox
|
||||
, progressBar
|
||||
, bullet
|
||||
@ -131,6 +148,8 @@ module DearImGui.Raw
|
||||
|
||||
-- ** Text Input
|
||||
, inputText
|
||||
, inputTextMultiline
|
||||
, inputTextWithHint
|
||||
|
||||
-- * Color Editor/Picker
|
||||
, colorPicker3
|
||||
@ -178,11 +197,26 @@ module DearImGui.Raw
|
||||
, openPopup
|
||||
, closeCurrentPopup
|
||||
|
||||
-- * ID stack/scopes
|
||||
, pushIDInt
|
||||
, pushIDPtr
|
||||
, pushIDStr
|
||||
, pushIDStrLen
|
||||
, popID
|
||||
|
||||
-- * Item/Widgets Utilities
|
||||
, isItemHovered
|
||||
, wantCaptureMouse
|
||||
, wantCaptureKeyboard
|
||||
|
||||
-- * Fonts in default font atlas
|
||||
, Font(..)
|
||||
, addFontDefault
|
||||
, addFontFromFileTTF
|
||||
, addFontFromMemoryTTF
|
||||
, buildFontAtlas
|
||||
, clearFontAtlas
|
||||
|
||||
-- * Types
|
||||
, module DearImGui.Enums
|
||||
, module DearImGui.Structs
|
||||
@ -213,19 +247,30 @@ Cpp.using "namespace ImGui"
|
||||
|
||||
|
||||
-- | Wraps @ImGuiContext*@.
|
||||
newtype Context = Context (Ptr ())
|
||||
newtype Context = Context (Ptr ImGuiContext)
|
||||
|
||||
|
||||
-- | Wraps @ImGui::CreateContext()@.
|
||||
createContext :: (MonadIO m) => m Context
|
||||
createContext = liftIO do
|
||||
Context <$> [C.exp| void* { CreateContext() } |]
|
||||
Context <$> [C.exp| ImGuiContext* { CreateContext() } |]
|
||||
|
||||
|
||||
-- | Wraps @ImGui::DestroyContext()@.
|
||||
destroyContext :: (MonadIO m) => Context -> m ()
|
||||
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
|
||||
@ -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,
|
||||
-- wich clicking will set the boolean to false when clicked.
|
||||
begin :: (MonadIO m) => CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool
|
||||
begin namePtr openPtr flags = liftIO do
|
||||
begin :: (MonadIO m) => CString -> Maybe (Ptr CBool) -> Maybe (ImGuiWindowFlags) -> m Bool
|
||||
begin namePtr (Just openPtr) (Just flags) = liftIO do
|
||||
(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.
|
||||
--
|
||||
@ -352,11 +401,47 @@ end = liftIO do
|
||||
[C.exp| void { End(); } |]
|
||||
|
||||
|
||||
-- | Wraps @ImGui::BeginChild()@.
|
||||
beginChild :: (MonadIO m) => CString -> m Bool
|
||||
beginChild namePtr = liftIO do
|
||||
(0 /=) <$> [C.exp| bool { BeginChild($(char* namePtr)) } |]
|
||||
-- | Begin a self-contained independent scrolling/clipping regions within a host window.
|
||||
--
|
||||
-- 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) => 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()@.
|
||||
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.
|
||||
--
|
||||
-- Wraps @ImGui::TextUnformatted()@.
|
||||
textUnformatted :: (MonadIO m) => CString -> CString -> m ()
|
||||
textUnformatted textPtr textEndPtr = liftIO do
|
||||
textUnformatted :: (MonadIO m) => CString -> Maybe CString -> m ()
|
||||
textUnformatted textPtr (Just textEndPtr) = liftIO do
|
||||
[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();@.
|
||||
--
|
||||
@ -455,6 +542,24 @@ smallButton labelPtr = liftIO do
|
||||
(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.
|
||||
--
|
||||
-- Wraps @ImGui::ArrowButton()@.
|
||||
@ -463,6 +568,50 @@ arrowButton strIdPtr dir = liftIO do
|
||||
(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()@.
|
||||
checkbox :: (MonadIO m) => CString -> Ptr CBool -> m Bool
|
||||
checkbox labelPtr boolPtr = liftIO do
|
||||
@ -850,10 +999,50 @@ vSliderScalar labelPtr sizePtr dataType dataPtr minPtr maxPtr formatPtr flags =
|
||||
minPtr_ = castPtr minPtr
|
||||
maxPtr_ = castPtr maxPtr
|
||||
|
||||
|
||||
-- | Wraps @ImGui::InputText()@.
|
||||
inputText :: (MonadIO m) => CString -> CString -> CInt -> m Bool
|
||||
inputText descPtr refPtr refSize = liftIO do
|
||||
(0 /= ) <$> [C.exp| bool { InputText( $(char* descPtr), $(char* refPtr), $(int refSize) ) } |]
|
||||
inputText :: (MonadIO m) => CString -> CStringLen -> ImGuiInputTextFlags -> m Bool
|
||||
inputText labelPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do
|
||||
(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()@.
|
||||
@ -1075,13 +1264,40 @@ isItemHovered :: (MonadIO m) => m Bool
|
||||
isItemHovered = liftIO do
|
||||
(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.
|
||||
--
|
||||
-- Wraps @ImGui::SetNextWindowPos()@
|
||||
setNextWindowPos :: (MonadIO m) => Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> m ()
|
||||
setNextWindowPos posPtr cond pivotPtr = liftIO do
|
||||
setNextWindowPos :: (MonadIO m) => Ptr ImVec2 -> ImGuiCond -> Maybe (Ptr ImVec2) -> m ()
|
||||
setNextWindowPos posPtr cond (Just pivotPtr) = liftIO do
|
||||
[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`
|
||||
@ -1261,6 +1477,44 @@ popStyleVar :: (MonadIO m) => CInt -> m ()
|
||||
popStyleVar n = liftIO do
|
||||
[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 = liftIO do
|
||||
(0 /=) <$> [C.exp| bool { GetIO().WantCaptureMouse } |]
|
||||
@ -1268,3 +1522,54 @@ wantCaptureMouse = liftIO do
|
||||
wantCaptureKeyboard :: MonadIO m => m Bool
|
||||
wantCaptureKeyboard = liftIO do
|
||||
(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
|
||||
import SDL
|
||||
import SDL.Internal.Types
|
||||
import SDL.Raw.Enum as Raw
|
||||
import qualified SDL.Raw.Event as Raw
|
||||
|
||||
@ -57,9 +56,9 @@ Cpp.using "namespace ImGui"
|
||||
|
||||
|
||||
-- | Wraps @ImGui_ImplSDL2_NewFrame@.
|
||||
sdl2NewFrame :: MonadIO m => Window -> m ()
|
||||
sdl2NewFrame (Window windowPtr) = liftIO do
|
||||
[C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |]
|
||||
sdl2NewFrame :: MonadIO m => m ()
|
||||
sdl2NewFrame = liftIO do
|
||||
[C.exp| void { ImGui_ImplSDL2_NewFrame(); } |]
|
||||
|
||||
|
||||
-- | Wraps @ImGui_ImplSDL2_Shutdown@.
|
||||
|
@ -9,6 +9,7 @@ import Foreign
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
|
||||
deriving (Show)
|
||||
|
||||
|
||||
instance Storable ImVec2 where
|
||||
@ -27,6 +28,7 @@ instance Storable ImVec2 where
|
||||
|
||||
|
||||
data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
|
||||
deriving (Show)
|
||||
|
||||
|
||||
instance Storable ImVec3 where
|
||||
@ -47,6 +49,7 @@ instance Storable ImVec3 where
|
||||
|
||||
|
||||
data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
|
||||
deriving (Show)
|
||||
|
||||
|
||||
instance Storable ImVec4 where
|
||||
@ -66,3 +69,11 @@ instance Storable ImVec4 where
|
||||
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
|
||||
w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
|
||||
return ImVec4{ x, y, z, w }
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | DearImGui context handle.
|
||||
data ImGuiContext
|
||||
|
||||
-- | Individual font handle.
|
||||
data ImFont
|
||||
|
Reference in New Issue
Block a user