25 Commits

Author SHA1 Message Date
97825e49f2 Prepare 1.2.0 (#98) 2021-09-12 19:46:05 +03:00
24345bb8f3 Add font utils (#56)
- clearFontAtlas
- addFontDefault
- addFontFromFileTTF
- addFontFromMemoryTTF (raw only)
- buildFontAtlas

Vulkan example updated to use on f the imgui-distributed ttf files.
2021-09-12 15:41:42 +00:00
e3f7fbfd6f Add imageButton (#97) 2021-09-12 13:20:47 +00:00
88326420b8 Tidy up image example (#96) 2021-09-12 11:56:43 +00:00
f3b85899f2 Added image wrapper (#74)
Raw.image and sdl2/gl example "image"

Wrappers should be backend-specific due to different handling of `userTextureIDPtr`.
2021-09-12 10:35:03 +00:00
c7a694bce8 Add remaining BeginChild arguments as required (#93)
Old behaviour with all default arguments is a special case to run
some action scoped to a different child window.

This now handled by `beginChildContext`/`withChildContext`.
2021-09-12 10:28:48 +00:00
c219f8eb4f Wrap GetCurrentContext and SetCurrentContext (#94) 2021-09-12 10:23:23 +00:00
24519778e6 Add inputTextMultiline, inputTextWithHint (#92)
- Experimental explicit encoding for CStrings.
- Fix potential buffer overruns in inputText.
2021-09-12 11:43:44 +03:00
4bfc7e7099 Add invisibleButton (#91) 2021-09-11 11:01:03 +00:00
efaaa5723a Add Show instances to structs and enums (#90) 2021-09-11 10:40:05 +00:00
be7aa1e9b1 Add functions for getting window position and size (#89)
- getWindowPos
- getWindowSize
- getWindowWidth
- getWindowHeight

Closes #88
2021-09-11 10:09:11 +00:00
08b3139477 Remove seg faults (#87)
* Removed double OpenGl3Shutdown, leading to a segmentation fault in Main.hs.
* Changed nullPtr passing with Maybe to use DearImGui default arguments.
2021-09-11 10:00:08 +00:00
cede825dff Bump haskell.nix (#86) 2021-09-08 16:19:57 +00:00
84a6b8a8fe Allow parser-combinators-1.4 (#85) 2021-09-08 13:10:39 +01:00
cb687b8f01 Prepare 1.1.0 (#83) 2021-09-01 18:05:18 +00:00
8d07a5a42b Add more withXXX wrappers (#82)
- withStyleColor
- withStyleVar
- withIndent
- withItemWidth

Closes #63
2021-09-01 17:23:59 +00:00
d3a0396623 Add GLFW callbacks (#81)
Closes #80
2021-09-01 19:22:55 +03:00
f49e81c739 Fix warnings (#79) 2021-08-30 17:08:23 +00:00
5699f64e95 Bump imgui to 1.84.2 (#78) 2021-08-30 19:57:00 +03:00
9e5b39850e Prepare 1.0.2 (#77) 2021-08-30 19:20:26 +03:00
d7dc999e8b Add withID (#75)
Raw versions are specialized to match overloaded C++ functions.
2021-08-28 15:52:04 +00:00
bde2030c25 Upgrade Haskell.nix and niv (#73) 2021-07-01 12:58:55 +00:00
1706b7e966 Fix changelog header and links (#72) 2021-06-30 22:44:31 +00:00
bfe8453891 Fix missing headers in source dist (#71)
Fixes #50 again
2021-06-30 22:33:00 +00:00
532eebd8ed Prepare Hackage release (#70) 2021-07-01 00:47:23 +03:00
18 changed files with 1118 additions and 155 deletions

38
ChangeLog.md Normal file
View 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
View File

@ -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 ()

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
View 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

View File

@ -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

View File

@ -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

Submodule imgui updated: ad5d1a8429...e3e1fbcf02

View File

@ -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": {

View File

@ -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); }

View File

@ -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

View File

@ -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 |] )
] ]
} }

View File

@ -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

View File

@ -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();
}
|]

View File

@ -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@.

View File

@ -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