mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2025-07-04 20:18:47 +02:00
Compare commits
36 Commits
Author | SHA1 | Date | |
---|---|---|---|
3087a99044 | |||
f74cd218c5 | |||
48c8ae0379 | |||
a2c0c0658e | |||
21ce5cabd8 | |||
8db9ddec2f | |||
4ecf62ac9e | |||
8ee82476dc | |||
b4bc36ca89 | |||
76ce7bb569 | |||
259ffbff48 | |||
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 |
47
ChangeLog.md
Normal file
47
ChangeLog.md
Normal file
@ -0,0 +1,47 @@
|
||||
# Changelog for dear-imgui
|
||||
|
||||
## [1.2.2]
|
||||
|
||||
- `imgui` updated to 1.85.
|
||||
|
||||
## [1.2.1]
|
||||
|
||||
- Added `DearImGui.Raw.IO` with attribute setters.
|
||||
|
||||
## [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
|
||||
[1.3.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.0
|
38
Main.hs
38
Main.hs
@ -7,6 +7,7 @@ module Main (main) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.IORef
|
||||
import qualified Data.Vector as Vector
|
||||
import DearImGui
|
||||
import DearImGui.OpenGL3
|
||||
import DearImGui.SDL
|
||||
@ -38,8 +39,6 @@ main = do
|
||||
tab2 <- newIORef True
|
||||
loop w checked color slider r pos size' selected tab1 tab2
|
||||
|
||||
openGL3Shutdown
|
||||
|
||||
|
||||
loop
|
||||
:: Window
|
||||
@ -53,11 +52,11 @@ loop
|
||||
-> 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
|
||||
@ -122,7 +121,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"
|
||||
@ -133,6 +132,21 @@ loop w checked color slider r pos size' selected tab1Ref tab2Ref = do
|
||||
|
||||
endChild
|
||||
|
||||
text "ListClipper"
|
||||
withChildOpen "##fixed" (ImVec2 0 200) True ImGuiWindowFlags_None do
|
||||
let lotsOfItems = Vector.generate 50 (mappend "Item " . show)
|
||||
withListClipper Nothing lotsOfItems text
|
||||
|
||||
text "ListClipper, Haskell-powered"
|
||||
withChildOpen "##infinite" (ImVec2 0 200) True ImGuiWindowFlags_None do
|
||||
let infiniteItems = map (mappend "Item " . show) [0 :: Int ..]
|
||||
withListClipper Nothing infiniteItems text
|
||||
|
||||
text "Ethereal ListClipper"
|
||||
withChildOpen "##ethereal" (ImVec2 0 200) True ImGuiWindowFlags_None do
|
||||
withListClipper Nothing (ClipRange (0 :: Int) 1000) $
|
||||
text . mappend "Item " . show
|
||||
|
||||
plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ]
|
||||
|
||||
colorPicker3 "Test" color
|
||||
@ -164,13 +178,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 +196,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 ()
|
||||
|
38
README.md
38
README.md
@ -25,7 +25,7 @@ OpenGL:
|
||||
|
||||
```
|
||||
package dear-imgui
|
||||
flags: +sdl +opengl
|
||||
flags: +sdl +opengl3
|
||||
```
|
||||
|
||||
With this done, the following module is the "Hello, World!" of ImGui:
|
||||
@ -54,38 +54,35 @@ 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
|
||||
-- Process the event loop
|
||||
untilNothingM pollEventWithImGui
|
||||
|
||||
mainLoop window = unlessQuit do
|
||||
-- Tell ImGui we're starting a new frame
|
||||
openGL2NewFrame
|
||||
sdl2NewFrame w
|
||||
sdl2NewFrame
|
||||
newFrame
|
||||
|
||||
-- Build the GUI
|
||||
bracket_ (begin "Hello, ImGui!") end do
|
||||
withWindowOpen "Hello, ImGui!" do
|
||||
-- Add a text widget
|
||||
text "Hello, ImGui!"
|
||||
|
||||
@ -103,12 +100,25 @@ mainLoop w = do
|
||||
render
|
||||
openGL2RenderDrawData =<< getDrawData
|
||||
|
||||
glSwapWindow w
|
||||
glSwapWindow window
|
||||
|
||||
mainLoop w
|
||||
mainLoop window
|
||||
|
||||
where
|
||||
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
|
||||
-- Process the event loop
|
||||
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
|
||||
```
|
||||
|
||||
# Hacking
|
||||
|
@ -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
|
||||
|
100
dear-imgui.cabal
100
dear-imgui.cabal
@ -1,9 +1,67 @@
|
||||
cabal-version: 3.0
|
||||
|
||||
name: dear-imgui
|
||||
version: 1.0.0
|
||||
version: 1.2.2
|
||||
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
|
||||
data-files:
|
||||
imgui/imgui.h
|
||||
extra-source-files:
|
||||
README.md,
|
||||
ChangeLog.md
|
||||
|
||||
extra-source-files:
|
||||
imgui/*.h,
|
||||
imgui/backends/*.h,
|
||||
imgui/backends/*.mm,
|
||||
imgui/imconfig.h,
|
||||
imgui/LICENSE.txt
|
||||
|
||||
common build-flags
|
||||
if flag(debug)
|
||||
if os(linux)
|
||||
ghc-options: -Wall -g -rtsopts -dcore-lint -debug
|
||||
cc-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer
|
||||
cxx-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer -std=c++11
|
||||
if os(darwin)
|
||||
ghc-options: -Wall -g -rtsopts -dcore-lint -debug
|
||||
cc-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer
|
||||
cxx-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer -std=c++11
|
||||
if os(windows)
|
||||
ghc-options: -Wall -g -rtsopts -dcore-lint -debug
|
||||
cc-options: -g -O0
|
||||
cxx-options: -g -O0 -std=c++11
|
||||
else
|
||||
if os(linux)
|
||||
ghc-options: -Wall -O2
|
||||
cc-options: -O2
|
||||
cxx-options: -std=c++11 -O2
|
||||
if os(darwin)
|
||||
ghc-options: -Wall -O2
|
||||
cc-options: -O2
|
||||
if os(windows)
|
||||
ghc-options: -Wall -O2
|
||||
cc-options: -O2
|
||||
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/haskell-game/dear-imgui.hs
|
||||
|
||||
flag debug
|
||||
description:
|
||||
Enable debug mode.
|
||||
default:
|
||||
False
|
||||
manual:
|
||||
True
|
||||
|
||||
flag opengl2
|
||||
description:
|
||||
@ -59,8 +117,6 @@ common common
|
||||
>= 4.12 && < 4.17
|
||||
default-language:
|
||||
Haskell2010
|
||||
ghc-options:
|
||||
-Wall
|
||||
|
||||
library
|
||||
import: common
|
||||
@ -69,18 +125,20 @@ library
|
||||
exposed-modules:
|
||||
DearImGui
|
||||
DearImGui.Raw
|
||||
DearImGui.Raw.DrawList
|
||||
DearImGui.Raw.ListClipper
|
||||
DearImGui.Raw.IO
|
||||
other-modules:
|
||||
DearImGui.Context
|
||||
DearImGui.Enums
|
||||
DearImGui.Structs
|
||||
cxx-options: -std=c++11
|
||||
cxx-sources:
|
||||
imgui/imgui.cpp
|
||||
imgui/imgui_demo.cpp
|
||||
imgui/imgui_draw.cpp
|
||||
imgui/imgui_tables.cpp
|
||||
imgui/imgui_widgets.cpp
|
||||
cxx-options:
|
||||
-std=c++11
|
||||
extra-libraries:
|
||||
stdc++
|
||||
include-dirs:
|
||||
@ -93,6 +151,7 @@ library
|
||||
, inline-c-cpp
|
||||
, StateVar
|
||||
, unliftio
|
||||
, vector
|
||||
|
||||
if flag(opengl2)
|
||||
exposed-modules:
|
||||
@ -158,7 +217,8 @@ library
|
||||
exposed-modules:
|
||||
DearImGui.GLFW
|
||||
build-depends:
|
||||
GLFW-b
|
||||
GLFW-b,
|
||||
bindings-GLFW
|
||||
cxx-sources:
|
||||
imgui/backends/imgui_impl_glfw.cpp
|
||||
|
||||
@ -194,9 +254,9 @@ library dear-imgui-generator
|
||||
, inline-c
|
||||
>= 0.9.0.0 && < 0.10
|
||||
, megaparsec
|
||||
>= 9.0 && < 9.1
|
||||
>= 9.0 && < 9.3
|
||||
, parser-combinators
|
||||
>= 1.2.0 && < 1.3
|
||||
>= 1.2.0 && < 1.4
|
||||
, scientific
|
||||
>= 0.3.6.2 && < 0.3.8
|
||||
, text
|
||||
@ -209,40 +269,46 @@ library dear-imgui-generator
|
||||
>= 0.2.11 && < 0.2.15
|
||||
|
||||
executable test
|
||||
import: common
|
||||
import: common, build-flags
|
||||
main-is: Main.hs
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
|
||||
buildable: False
|
||||
else
|
||||
build-depends: base, sdl2, gl, dear-imgui
|
||||
build-depends: base, sdl2, gl, dear-imgui, vector
|
||||
|
||||
executable glfw
|
||||
import: common, build-flags
|
||||
main-is: Main.hs
|
||||
hs-source-dirs: examples/glfw
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
if (!flag(examples) || !flag(glfw) || !flag(opengl2))
|
||||
buildable: False
|
||||
else
|
||||
build-depends: base, GLFW-b, gl, dear-imgui, managed
|
||||
|
||||
executable readme
|
||||
import: common
|
||||
import: common, build-flags
|
||||
main-is: Readme.hs
|
||||
hs-source-dirs: examples
|
||||
build-depends: sdl2, gl, dear-imgui, managed
|
||||
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
|
||||
buildable: False
|
||||
|
||||
executable image
|
||||
import: common, build-flags
|
||||
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
|
||||
import: common, build-flags
|
||||
main-is: Main.hs
|
||||
other-modules: Attachments, Backend, Input, Util
|
||||
hs-source-dirs: examples/vulkan
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
if (!flag(examples) || !flag(sdl) || !flag(vulkan))
|
||||
buildable: False
|
||||
else
|
||||
|
@ -4,12 +4,12 @@ haskellNix ? (import (import ./nix/sources.nix)."haskell.nix" { })
|
||||
# haskell.nix provides access to the nixpkgs pins which are used by our CI,
|
||||
# hence you will be more likely to get cache hits when using these.
|
||||
# But you can also just use your own, e.g. '<nixpkgs>'.
|
||||
, nixpkgsSrc ? haskellNix.sources.nixpkgs-2009
|
||||
, nixpkgsSrc ? haskellNix.sources.nixpkgs-2105
|
||||
|
||||
# haskell.nix provides some arguments to be passed to nixpkgs, including some
|
||||
# patches and also the haskell.nix functionality itself as an overlay.
|
||||
, nixpkgsArgs ? haskellNix.nixpkgsArgs
|
||||
, compiler-nix-name ? "ghc884"
|
||||
, compiler-nix-name ? "ghc8107"
|
||||
}:
|
||||
let
|
||||
pkgs = import nixpkgsSrc nixpkgsArgs;
|
||||
|
@ -24,34 +24,31 @@ 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
|
||||
-- Process the event loop
|
||||
untilNothingM pollEventWithImGui
|
||||
|
||||
mainLoop window = unlessQuit do
|
||||
-- Tell ImGui we're starting a new frame
|
||||
openGL2NewFrame
|
||||
sdl2NewFrame w
|
||||
sdl2NewFrame
|
||||
newFrame
|
||||
|
||||
-- Build the GUI
|
||||
@ -73,9 +70,22 @@ mainLoop w = do
|
||||
render
|
||||
openGL2RenderDrawData =<< getDrawData
|
||||
|
||||
glSwapWindow w
|
||||
glSwapWindow window
|
||||
|
||||
mainLoop w
|
||||
mainLoop window
|
||||
|
||||
where
|
||||
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
|
||||
-- Process the event loop
|
||||
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
|
||||
|
195
examples/sdl/Image.hs
Normal file
195
examples/sdl/Image.hs
Normal file
@ -0,0 +1,195 @@
|
||||
{-# 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 qualified DearImGui.Raw.DrawList as DrawList
|
||||
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
|
||||
|
||||
let texture = if flag then fst textures else snd textures
|
||||
-- Drawing images require some backend-specific code.
|
||||
-- Meanwhile, we have to deal with raw bindings.
|
||||
let openGLtextureID = intPtrToPtr $ fromIntegral $ textureID texture
|
||||
|
||||
-- Build the GUI
|
||||
clicked <- withWindow "Image example" \open ->
|
||||
if open then do
|
||||
text "That's an image, click it"
|
||||
newLine
|
||||
|
||||
-- Using imageButton
|
||||
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
|
||||
|
||||
-- Using DrawList
|
||||
bg <- getBackgroundDrawList
|
||||
Foreign.with (ImVec2 100 100) \pMin ->
|
||||
Foreign.with (ImVec2 200 200) \pMax ->
|
||||
Foreign.with (ImVec2 0.25 0.25) \uvMin ->
|
||||
Foreign.with (ImVec2 0.75 0.75) \uvMax ->
|
||||
DrawList.addImageRounded
|
||||
bg
|
||||
openGLtextureID
|
||||
pMin pMax uvMin uvMax
|
||||
(Raw.imCol32 0 255 0 0xFF) -- Extract green channel
|
||||
32 ImDrawFlags_RoundCornersBottom
|
||||
|
||||
-- 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
|
||||
|
@ -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
|
||||
|
||||
@ -161,7 +158,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
|
||||
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...55d35d8387
@ -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": {
|
||||
|
124
nix/sources.nix
124
nix/sources.nix
@ -6,52 +6,63 @@ let
|
||||
# The fetchers. fetch_<type> fetches specs of type <type>.
|
||||
#
|
||||
|
||||
fetch_file = pkgs: spec:
|
||||
fetch_file = pkgs: name: spec:
|
||||
let
|
||||
name' = sanitizeName name + "-src";
|
||||
in
|
||||
if spec.builtin or true then
|
||||
builtins_fetchurl { inherit (spec) url sha256; }
|
||||
builtins_fetchurl { inherit (spec) url sha256; name = name'; }
|
||||
else
|
||||
pkgs.fetchurl { inherit (spec) url sha256; };
|
||||
pkgs.fetchurl { inherit (spec) url sha256; name = name'; };
|
||||
|
||||
fetch_tarball = pkgs: spec:
|
||||
fetch_tarball = pkgs: name: spec:
|
||||
let
|
||||
name' = sanitizeName name + "-src";
|
||||
in
|
||||
if spec.builtin or true then
|
||||
builtins_fetchTarball { inherit (spec) url sha256; }
|
||||
builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
|
||||
else
|
||||
pkgs.fetchzip { inherit (spec) url sha256; };
|
||||
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); }
|
||||
|
371
src/DearImGui.hs
371
src/DearImGui.hs
@ -1,7 +1,9 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
@ -19,6 +21,8 @@ module DearImGui
|
||||
Raw.Context(..)
|
||||
, Raw.createContext
|
||||
, Raw.destroyContext
|
||||
, Raw.getCurrentContext
|
||||
, Raw.setCurrentContext
|
||||
|
||||
-- * Main
|
||||
, Raw.newFrame
|
||||
@ -48,6 +52,16 @@ module DearImGui
|
||||
|
||||
, begin
|
||||
, Raw.end
|
||||
|
||||
-- ** Utilities
|
||||
|
||||
, Raw.getWindowDrawList
|
||||
, Raw.getWindowPos
|
||||
, Raw.getWindowSize
|
||||
, Raw.getWindowWidth
|
||||
, Raw.getWindowHeight
|
||||
|
||||
-- ** Manipulation
|
||||
, setNextWindowPos
|
||||
, setNextWindowSize
|
||||
, Raw.setNextWindowFullscreen
|
||||
@ -56,15 +70,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 +92,13 @@ module DearImGui
|
||||
, Raw.newLine
|
||||
, Raw.spacing
|
||||
, dummy
|
||||
|
||||
, withIndent
|
||||
, indent
|
||||
, unindent
|
||||
|
||||
, setNextItemWidth
|
||||
, withItemWidth
|
||||
, pushItemWidth
|
||||
, Raw.popItemWidth
|
||||
|
||||
@ -87,6 +109,10 @@ module DearImGui
|
||||
, setCursorPos
|
||||
, Raw.alignTextToFramePadding
|
||||
|
||||
-- * ID stack
|
||||
, withID
|
||||
, ToID(..)
|
||||
|
||||
-- * Widgets
|
||||
-- ** Text
|
||||
, text
|
||||
@ -99,7 +125,9 @@ module DearImGui
|
||||
-- ** Main
|
||||
, button
|
||||
, smallButton
|
||||
, invisibleButton
|
||||
, arrowButton
|
||||
, Raw.image
|
||||
, checkbox
|
||||
, progressBar
|
||||
, Raw.bullet
|
||||
@ -143,12 +171,14 @@ module DearImGui
|
||||
|
||||
-- ** Text Input
|
||||
, inputText
|
||||
, inputTextMultiline
|
||||
, inputTextWithHint
|
||||
|
||||
-- * Color Editor/Picker
|
||||
-- ** Color Editor/Picker
|
||||
, colorPicker3
|
||||
, colorButton
|
||||
|
||||
-- * Trees
|
||||
-- ** Trees
|
||||
, treeNode
|
||||
, treePush
|
||||
, Raw.treePop
|
||||
@ -159,7 +189,7 @@ module DearImGui
|
||||
-- ** List Boxes
|
||||
, listBox
|
||||
|
||||
-- * Data Plotting
|
||||
-- ** Data Plotting
|
||||
, plotHistogram
|
||||
|
||||
-- ** Menus
|
||||
@ -193,7 +223,7 @@ module DearImGui
|
||||
, tabItemButton
|
||||
, setTabItemClosed
|
||||
|
||||
-- * Tooltips
|
||||
-- ** Tooltips
|
||||
, withTooltip
|
||||
, Raw.beginTooltip
|
||||
, Raw.endTooltip
|
||||
@ -217,6 +247,25 @@ module DearImGui
|
||||
, Raw.wantCaptureMouse
|
||||
, Raw.wantCaptureKeyboard
|
||||
|
||||
-- * Fonts
|
||||
, Raw.Font
|
||||
, addFontFromFileTTF
|
||||
, Raw.addFontDefault
|
||||
, Raw.buildFontAtlas
|
||||
, Raw.clearFontAtlas
|
||||
|
||||
-- * Utilities
|
||||
|
||||
-- ** ListClipper
|
||||
, withListClipper
|
||||
, ClipItems(..)
|
||||
, ClipRange(..)
|
||||
|
||||
-- ** Miscellaneous
|
||||
, Raw.getBackgroundDrawList
|
||||
, Raw.getForegroundDrawList
|
||||
, Raw.imCol32
|
||||
|
||||
-- * Types
|
||||
, module DearImGui.Enums
|
||||
, module DearImGui.Structs
|
||||
@ -231,6 +280,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
|
||||
@ -252,7 +304,12 @@ import UnliftIO (MonadUnliftIO)
|
||||
import UnliftIO.Exception (bracket, bracket_)
|
||||
|
||||
import qualified DearImGui.Raw as Raw
|
||||
import qualified DearImGui.Raw.ListClipper as Raw.ListClipper
|
||||
|
||||
-- vector
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Vector.Storable as VS
|
||||
import qualified Data.Vector.Unboxed as VU
|
||||
|
||||
-- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for
|
||||
-- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@).
|
||||
@ -271,7 +328,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 +360,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 +378,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 +479,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 +1150,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 +1505,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 +1563,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 +1591,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 +1615,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 +1669,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 +1684,111 @@ 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
|
||||
|
||||
-- | Clips a large list of items
|
||||
--
|
||||
-- The requirements on @a@ are that they are all of the same height.
|
||||
withListClipper :: (ClipItems t a, MonadUnliftIO m) => Maybe Float -> t a -> (a -> m ()) -> m ()
|
||||
withListClipper itemHeight items action =
|
||||
bracket
|
||||
(liftIO $ throwIfNull "withListClipper: ListClipper allocation failed" Raw.ListClipper.new)
|
||||
Raw.ListClipper.delete
|
||||
step
|
||||
where
|
||||
itemHeight' = maybe (-1.0) CFloat itemHeight
|
||||
itemCount' = maybe maxBound fromIntegral (itemCount items)
|
||||
|
||||
step clipper = do
|
||||
Raw.ListClipper.begin clipper itemCount' itemHeight'
|
||||
go clipper
|
||||
|
||||
go clipper = do
|
||||
doStep <- Raw.ListClipper.step clipper
|
||||
when doStep do
|
||||
let
|
||||
startIndex = fromIntegral $ Raw.ListClipper.displayStart clipper
|
||||
endIndex = fromIntegral $ Raw.ListClipper.displayEnd clipper
|
||||
stepItems action $
|
||||
clipItems startIndex endIndex items
|
||||
|
||||
go clipper
|
||||
|
||||
-- | Containers usable with 'ListClipper'.
|
||||
class ClipItems t a where
|
||||
itemCount :: t a -> Maybe Int
|
||||
clipItems :: Int -> Int -> t a -> t a
|
||||
stepItems :: Monad m => (a -> m ()) -> t a -> m ()
|
||||
|
||||
-- | Unbounded stream of items.
|
||||
instance ClipItems [] a where
|
||||
itemCount = const Nothing
|
||||
|
||||
clipItems displayStart displayEnd =
|
||||
take (displayEnd - displayStart) . drop displayStart
|
||||
|
||||
stepItems = mapM_
|
||||
|
||||
instance ClipItems V.Vector a where
|
||||
itemCount = Just . V.length
|
||||
|
||||
clipItems displayStart displayEnd =
|
||||
V.slice displayStart (displayEnd - displayStart)
|
||||
|
||||
stepItems = V.mapM_
|
||||
|
||||
instance Storable a => ClipItems VS.Vector a where
|
||||
itemCount = Just . VS.length
|
||||
|
||||
clipItems displayStart displayEnd =
|
||||
VS.slice displayStart (displayEnd - displayStart)
|
||||
|
||||
stepItems = VS.mapM_
|
||||
|
||||
instance VU.Unbox a => ClipItems VU.Vector a where
|
||||
itemCount = Just . VU.length
|
||||
|
||||
clipItems displayStart displayEnd =
|
||||
VU.slice displayStart (displayEnd - displayStart)
|
||||
|
||||
stepItems = VU.mapM_
|
||||
|
||||
-- | ClipList helper for arbitrary unmaterialized ranges.
|
||||
data ClipRange a = ClipRange a a
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance (Ord a, Enum a, Num a) => ClipItems ClipRange a where
|
||||
itemCount (ClipRange _begin end) =
|
||||
Just $ fromEnum end
|
||||
|
||||
clipItems clipBegin clipEnd (ClipRange oldBegin oldEnd) =
|
||||
ClipRange
|
||||
(toEnum $ max clipBegin $ fromEnum oldBegin)
|
||||
(toEnum $ min clipEnd $ fromEnum oldEnd)
|
||||
|
||||
stepItems action (ClipRange start end) =
|
||||
mapM_ action [start .. end - 1]
|
||||
|
@ -33,5 +33,10 @@ imguiContext = mempty
|
||||
[ ( TypeName "ImVec2", [t| ImVec2 |] )
|
||||
, ( TypeName "ImVec3", [t| ImVec3 |] )
|
||||
, ( TypeName "ImVec4", [t| ImVec4 |] )
|
||||
, ( TypeName "ImU32", [t| ImU32 |] )
|
||||
, ( TypeName "ImDrawList", [t| ImDrawList |] )
|
||||
, ( TypeName "ImGuiContext", [t| ImGuiContext |] )
|
||||
, ( TypeName "ImFont", [t| ImFont |] )
|
||||
, ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] )
|
||||
]
|
||||
}
|
||||
|
@ -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(); } |]
|
||||
|
||||
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,17 @@ module DearImGui.Raw
|
||||
-- * Windows
|
||||
, begin
|
||||
, end
|
||||
|
||||
-- ** Utilities
|
||||
|
||||
, getWindowDrawList
|
||||
, getWindowPos
|
||||
, getWindowSize
|
||||
, getWindowWidth
|
||||
, getWindowHeight
|
||||
|
||||
-- ** Manipulation
|
||||
|
||||
, setNextWindowPos
|
||||
, setNextWindowSize
|
||||
, setNextWindowFullscreen
|
||||
@ -51,8 +65,9 @@ module DearImGui.Raw
|
||||
, setNextWindowCollapsed
|
||||
, setNextWindowBgAlpha
|
||||
|
||||
-- * Child Windows
|
||||
-- ** Child Windows
|
||||
, beginChild
|
||||
, beginChildContext
|
||||
, endChild
|
||||
|
||||
-- * Parameter stacks
|
||||
@ -75,6 +90,7 @@ module DearImGui.Raw
|
||||
, beginGroup
|
||||
, endGroup
|
||||
, setCursorPos
|
||||
, getCursorScreenPos
|
||||
, alignTextToFramePadding
|
||||
|
||||
-- * Widgets
|
||||
@ -89,7 +105,10 @@ module DearImGui.Raw
|
||||
-- ** Main
|
||||
, button
|
||||
, smallButton
|
||||
, invisibleButton
|
||||
, arrowButton
|
||||
, image
|
||||
, imageButton
|
||||
, checkbox
|
||||
, progressBar
|
||||
, bullet
|
||||
@ -131,6 +150,8 @@ module DearImGui.Raw
|
||||
|
||||
-- ** Text Input
|
||||
, inputText
|
||||
, inputTextMultiline
|
||||
, inputTextWithHint
|
||||
|
||||
-- * Color Editor/Picker
|
||||
, colorPicker3
|
||||
@ -178,11 +199,33 @@ 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
|
||||
|
||||
-- * Utilities
|
||||
|
||||
-- ** Miscellaneous
|
||||
, getBackgroundDrawList
|
||||
, getForegroundDrawList
|
||||
, imCol32
|
||||
|
||||
-- * Types
|
||||
, module DearImGui.Enums
|
||||
, module DearImGui.Structs
|
||||
@ -194,12 +237,15 @@ import Control.Monad.IO.Class
|
||||
( MonadIO, liftIO )
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
import System.IO.Unsafe
|
||||
( unsafePerformIO )
|
||||
|
||||
-- dear-imgui
|
||||
import DearImGui.Context
|
||||
( imguiContext )
|
||||
import DearImGui.Enums
|
||||
import DearImGui.Structs
|
||||
import DearImGui.Raw.DrawList (DrawList(..))
|
||||
|
||||
-- inline-c
|
||||
import qualified Language.C.Inline as C
|
||||
@ -213,19 +259,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 +396,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 +413,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 +484,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 +554,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 +580,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 +1011,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()@.
|
||||
@ -1076,12 +1277,52 @@ isItemHovered = liftIO do
|
||||
(0 /=) <$> [C.exp| bool { IsItemHovered() } |]
|
||||
|
||||
|
||||
-- | Get draw list associated to the current window.
|
||||
getWindowDrawList :: (MonadIO m) => m DrawList
|
||||
getWindowDrawList = liftIO do
|
||||
DrawList <$> [C.exp|
|
||||
ImDrawList* {
|
||||
GetWindowDrawList()
|
||||
}
|
||||
|]
|
||||
|
||||
-- | Get current window position in screen space.
|
||||
--
|
||||
-- Useful if you want to do your own drawing via the "DrawList" API.
|
||||
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`
|
||||
@ -1229,6 +1470,21 @@ setCursorPos :: (MonadIO m) => Ptr ImVec2 -> m ()
|
||||
setCursorPos posPtr = liftIO do
|
||||
[C.exp| void { SetCursorPos(*$(ImVec2* posPtr)) } |]
|
||||
|
||||
-- | Cursor position in absolute coordinates.
|
||||
--
|
||||
-- Useful to work with 'DrawList' API.
|
||||
--
|
||||
-- Generally top-left == @GetMainViewport()->Pos == (0,0)@ in single viewport mode,
|
||||
-- and bottom-right == @GetMainViewport()->Pos+Size == io.DisplaySize@ in single-viewport mode.
|
||||
getCursorScreenPos :: (MonadIO m) => m ImVec2
|
||||
getCursorScreenPos = liftIO do
|
||||
C.withPtr_ \ptr ->
|
||||
[C.block|
|
||||
void {
|
||||
*$(ImVec2 * ptr) = GetCursorScreenPos();
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
-- | Modify a style color by pushing to the shared stack. always use this if you modify the style after `newFrame`
|
||||
--
|
||||
@ -1261,6 +1517,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 +1562,93 @@ 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();
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
-- | This draw list will be the first rendering one.
|
||||
--
|
||||
-- Useful to quickly draw shapes/text behind dear imgui contents.
|
||||
getBackgroundDrawList :: (MonadIO m) => m DrawList
|
||||
getBackgroundDrawList = liftIO do
|
||||
DrawList <$> [C.exp|
|
||||
ImDrawList* {
|
||||
GetBackgroundDrawList()
|
||||
}
|
||||
|]
|
||||
|
||||
-- | This draw list will be the last rendered one.
|
||||
--
|
||||
-- Useful to quickly draw shapes/text over dear imgui contents.
|
||||
getForegroundDrawList :: (MonadIO m) => m DrawList
|
||||
getForegroundDrawList = liftIO do
|
||||
DrawList <$> [C.exp|
|
||||
ImDrawList* {
|
||||
GetForegroundDrawList()
|
||||
}
|
||||
|]
|
||||
|
||||
-- | Generate 32-bit encoded colors using DearImgui macros.
|
||||
--
|
||||
-- Follows @IMGUI_USE_BGRA_PACKED_COLOR@ define to put bytes in appropriate positions.
|
||||
imCol32 :: CUChar -> CUChar -> CUChar -> CUChar -> ImU32
|
||||
imCol32 r g b a = unsafePerformIO
|
||||
[C.exp|
|
||||
ImU32 {
|
||||
IM_COL32(
|
||||
$(unsigned char r),
|
||||
$(unsigned char g),
|
||||
$(unsigned char b),
|
||||
$(unsigned char a)
|
||||
)
|
||||
}
|
||||
|]
|
||||
|
742
src/DearImGui/Raw/DrawList.hs
Normal file
742
src/DearImGui/Raw/DrawList.hs
Normal file
@ -0,0 +1,742 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-| Draw command list
|
||||
|
||||
This is the low-level list of polygons that ImGui functions are filling.
|
||||
|
||||
At the end of the frame, all command lists are passed to your @ImGuiIO::RenderDrawListFn@ function for rendering.
|
||||
|
||||
Each dear imgui window contains its own ImDrawList.
|
||||
|
||||
You can use 'getWindowDrawList' to access the current window draw list and draw custom primitives.
|
||||
|
||||
You can interleave normal ImGui calls and adding primitives to the current draw list.
|
||||
|
||||
In single viewport mode, top-left is == @GetMainViewport()->Pos@ (generally @0,0@),
|
||||
bottom-right is == @GetMainViewport()->Pos+Size@ (generally io.DisplaySize).
|
||||
|
||||
You are totally free to apply whatever transformation matrix to want to the data
|
||||
(depending on the use of the transformation you may want to apply it to ClipRect as well!).
|
||||
|
||||
__Important__: Primitives are always added to the list and not culled (culling is done at higher-level by ImGui functions),
|
||||
if you use this API a lot consider coarse culling your drawn objects.
|
||||
-}
|
||||
|
||||
module DearImGui.Raw.DrawList
|
||||
( DrawList(..)
|
||||
, new
|
||||
, destroy
|
||||
|
||||
-- * Primitives
|
||||
|
||||
-- $primitives
|
||||
, addLine
|
||||
|
||||
, addRect
|
||||
, addRectFilled
|
||||
, addRectFilledMultiColor
|
||||
|
||||
, addQuad
|
||||
, addQuadFilled
|
||||
|
||||
, addTriangle
|
||||
, addTriangleFilled
|
||||
|
||||
, addCircle
|
||||
, addCircleFilled
|
||||
|
||||
, addNgon
|
||||
, addNgonFilled
|
||||
|
||||
, addText_
|
||||
, addText
|
||||
|
||||
, addPolyLine
|
||||
, addConvexPolyFilled
|
||||
|
||||
, addBezierCubic
|
||||
, addBezierQuadratic
|
||||
|
||||
-- ** Image primitives
|
||||
|
||||
-- $image
|
||||
, addImage
|
||||
, addImageQuad
|
||||
, addImageRounded
|
||||
|
||||
-- * Stateful path API
|
||||
|
||||
-- $stateful
|
||||
, pathClear
|
||||
, pathLineTo
|
||||
, pathLineToMergeDuplicate
|
||||
, pathFillConvex
|
||||
, pathStroke
|
||||
|
||||
, pathArcTo
|
||||
, pathArcToFast
|
||||
|
||||
, pathBezierCubicCurveTo
|
||||
, pathBezierQuadraticCurveTo
|
||||
|
||||
, pathRect
|
||||
|
||||
-- * Advanced
|
||||
|
||||
-- , addCallback
|
||||
, addDrawCmd
|
||||
, cloneOutput
|
||||
|
||||
-- * Internal state
|
||||
|
||||
, pushClipRect
|
||||
, pushClipRectFullScreen
|
||||
, popClipRect
|
||||
, getClipRectMin
|
||||
, getClipRectMax
|
||||
|
||||
, pushTextureID
|
||||
, popTextureID
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
( MonadIO, liftIO )
|
||||
import Foreign hiding (new)
|
||||
import Foreign.C
|
||||
|
||||
-- dear-imgui
|
||||
import DearImGui.Context
|
||||
( imguiContext )
|
||||
import DearImGui.Enums
|
||||
import DearImGui.Structs
|
||||
|
||||
-- inline-c
|
||||
import qualified Language.C.Inline as C
|
||||
|
||||
-- inline-c-cpp
|
||||
import qualified Language.C.Inline.Cpp as Cpp
|
||||
|
||||
C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext)
|
||||
C.include "imgui.h"
|
||||
Cpp.using "namespace ImGui"
|
||||
|
||||
-- | A single draw command list.
|
||||
-- Generally one per window, conceptually you may see this as a dynamic "mesh" builder.
|
||||
newtype DrawList = DrawList (Ptr ImDrawList)
|
||||
|
||||
new :: MonadIO m => m DrawList
|
||||
new = liftIO do
|
||||
DrawList <$> [C.block|
|
||||
ImDrawList* {
|
||||
return IM_NEW(ImDrawList(GetDrawListSharedData()));
|
||||
}
|
||||
|]
|
||||
|
||||
destroy :: MonadIO m => DrawList -> m ()
|
||||
destroy (DrawList drawList) = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
IM_DELETE($(ImDrawList* drawList));
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
pushClipRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CBool -> m ()
|
||||
pushClipRect (DrawList drawList) clip_rect_min clip_rect_max intersect_with_current_clip_rect = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PushClipRect(
|
||||
*$(ImVec2* clip_rect_min),
|
||||
*$(ImVec2* clip_rect_max),
|
||||
$(bool intersect_with_current_clip_rect)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
pushClipRectFullScreen :: MonadIO m => DrawList -> m ()
|
||||
pushClipRectFullScreen (DrawList drawList) = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PushClipRectFullScreen();
|
||||
}
|
||||
|]
|
||||
|
||||
popClipRect :: MonadIO m => DrawList -> m ()
|
||||
popClipRect (DrawList drawList) = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PopClipRect();
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
getClipRectMin :: MonadIO m => DrawList -> m ImVec2
|
||||
getClipRectMin (DrawList drawList) = liftIO do
|
||||
C.withPtr_ \ptr ->
|
||||
[C.block|
|
||||
void {
|
||||
*$(ImVec2 * ptr) = $(ImDrawList* drawList)->GetClipRectMin();
|
||||
}
|
||||
|]
|
||||
|
||||
getClipRectMax :: MonadIO m => DrawList -> m ImVec2
|
||||
getClipRectMax (DrawList drawList) = liftIO do
|
||||
C.withPtr_ \ptr ->
|
||||
[C.block|
|
||||
void {
|
||||
*$(ImVec2 * ptr) = $(ImDrawList* drawList)->GetClipRectMax();
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
pushTextureID :: MonadIO m => DrawList -> Ptr () -> m ()
|
||||
pushTextureID (DrawList drawList) userTextureIDPtr = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PushTextureID(
|
||||
$(void* userTextureIDPtr)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
popTextureID :: MonadIO m => DrawList -> m ()
|
||||
popTextureID (DrawList drawList) = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PopTextureID();
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
{- $primitives
|
||||
- For rectangular primitives, @p_min@ and @p_max@ represent the upper-left and lower-right corners.
|
||||
- For circle primitives, use @num_segments == 0@ to automatically calculate tessellation (preferred).
|
||||
In older versions (until Dear ImGui 1.77) the 'addCircle' functions defaulted to num_segments == 12.
|
||||
In future versions we will use textures to provide cheaper and higher-quality circles.
|
||||
Use 'addNgon' and 'addNgonFilled' functions if you need to guaranteed a specific number of sides.
|
||||
-}
|
||||
|
||||
addLine :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
|
||||
addLine (DrawList drawList) p1 p2 col thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddLine(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
$(ImU32 col),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> ImDrawFlags -> CFloat -> m ()
|
||||
addRect (DrawList drawList) p_min p_max col rounding flags thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddRect(
|
||||
*$(ImVec2* p_min),
|
||||
*$(ImVec2* p_max),
|
||||
$(ImU32 col),
|
||||
$(float rounding),
|
||||
$(ImDrawFlags flags),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addRectFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> ImDrawFlags -> m ()
|
||||
addRectFilled (DrawList drawList) p_min p_max col rounding flags = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddRectFilled(
|
||||
*$(ImVec2* p_min),
|
||||
*$(ImVec2* p_max),
|
||||
$(ImU32 col),
|
||||
$(float rounding),
|
||||
$(ImDrawFlags flags)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addRectFilledMultiColor :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> ImU32 -> ImU32 -> ImU32 -> m ()
|
||||
addRectFilledMultiColor (DrawList drawList) p_min p_max col_upr_left col_upr_right col_bot_right col_bot_left = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddRectFilledMultiColor(
|
||||
*$(ImVec2* p_min),
|
||||
*$(ImVec2* p_max),
|
||||
$(ImU32 col_upr_left),
|
||||
$(ImU32 col_upr_right),
|
||||
$(ImU32 col_bot_right),
|
||||
$(ImU32 col_bot_left)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addQuad :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
|
||||
addQuad (DrawList drawList) p1 p2 p3 p4 col thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddQuad(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
*$(ImVec2* p4),
|
||||
$(ImU32 col),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addQuadFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m ()
|
||||
addQuadFilled (DrawList drawList) p1 p2 p3 p4 col = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddQuadFilled(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
*$(ImVec2* p4),
|
||||
$(ImU32 col)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addTriangle :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
|
||||
addTriangle (DrawList drawList) p1 p2 p3 col thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddTriangle(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
$(ImU32 col),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addTriangleFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m ()
|
||||
addTriangleFilled (DrawList drawList) p1 p2 p3 col = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddTriangleFilled(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
$(ImU32 col)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addCircle :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m ()
|
||||
addCircle (DrawList drawList) center radius col num_segments thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddCircle(
|
||||
*$(ImVec2* center),
|
||||
$(float radius),
|
||||
$(ImU32 col),
|
||||
$(int num_segments),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addCircleFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m ()
|
||||
addCircleFilled (DrawList drawList) center radius col num_segments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddCircleFilled(
|
||||
*$(ImVec2* center),
|
||||
$(float radius),
|
||||
$(ImU32 col),
|
||||
$(int num_segments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addNgon :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m ()
|
||||
addNgon (DrawList drawList) center radius col num_segments thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddNgon(
|
||||
*$(ImVec2* center),
|
||||
$(float radius),
|
||||
$(ImU32 col),
|
||||
$(int num_segments),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addNgonFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m ()
|
||||
addNgonFilled (DrawList drawList) center radius col num_segments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddNgonFilled(
|
||||
*$(ImVec2* center),
|
||||
$(float radius),
|
||||
$(ImU32 col),
|
||||
$(int num_segments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addText_ :: MonadIO m => DrawList -> Ptr ImVec2 -> ImU32 -> CString -> CString -> m ()
|
||||
addText_ (DrawList drawList) pos col text_begin text_end = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddText(
|
||||
*$(ImVec2* pos),
|
||||
$(ImU32 col),
|
||||
$(char* text_begin),
|
||||
$(char* text_end)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addText :: MonadIO m => DrawList -> Ptr ImFont -> CFloat -> Ptr ImVec2 -> ImU32 -> CString -> CString -> CFloat -> Ptr ImVec4 -> m ()
|
||||
addText (DrawList drawList) fontPtr font_size pos col text_begin text_end wrap_width cpu_fine_clip_rect = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddText(
|
||||
$(ImFont* fontPtr),
|
||||
$(float font_size),
|
||||
*$(ImVec2* pos),
|
||||
$(ImU32 col),
|
||||
$(char* text_begin),
|
||||
$(char* text_end),
|
||||
$(float wrap_width),
|
||||
$(ImVec4* cpu_fine_clip_rect)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addPolyLine :: MonadIO m => DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> ImDrawFlags -> CFloat -> m ()
|
||||
addPolyLine (DrawList drawList) points num_points col flags thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddPolyline(
|
||||
$(ImVec2* points),
|
||||
$(int num_points),
|
||||
$(ImU32 col),
|
||||
$(ImDrawFlags flags),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addConvexPolyFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> m ()
|
||||
addConvexPolyFilled (DrawList drawList) points num_points col = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddConvexPolyFilled(
|
||||
$(ImVec2* points),
|
||||
$(int num_points),
|
||||
$(ImU32 col)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
addBezierCubic
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions (control points)
|
||||
-> ImU32
|
||||
-> CFloat
|
||||
-> CInt
|
||||
-> m ()
|
||||
addBezierCubic (DrawList drawList) p1 p2 p3 p4 col thickness numSegments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddBezierCubic(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
*$(ImVec2* p4),
|
||||
$(ImU32 col),
|
||||
$(float thickness),
|
||||
$(int numSegments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addBezierQuadratic
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions (control points)
|
||||
-> ImU32
|
||||
-> CFloat
|
||||
-> CInt
|
||||
-> m ()
|
||||
addBezierQuadratic (DrawList drawList) p1 p2 p3 col thickness numSegments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddBezierQuadratic(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
$(ImU32 col),
|
||||
$(float thickness),
|
||||
$(int numSegments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
{- $image
|
||||
* Read FAQ to understand what @ImTextureID@ is.
|
||||
* @p_min@ and @p_max@ represent the upper-left and lower-right corners of the rectangle.
|
||||
* @uv_min@ and @uv_max@ represent the normalized texture coordinates to use for those corners.
|
||||
Using @(0,0)->(1,1)@ texture coordinates will generally display the entire texture.
|
||||
-}
|
||||
|
||||
addImage
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ()
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -- Positions
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -- UVs
|
||||
-> ImU32
|
||||
-> m ()
|
||||
addImage (DrawList drawList) userTextureIDPtr p_min p_max uv_min uv_max col = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddImage(
|
||||
$(void* userTextureIDPtr),
|
||||
*$(ImVec2* p_min),
|
||||
*$(ImVec2* p_max),
|
||||
*$(ImVec2* uv_min),
|
||||
*$(ImVec2* uv_max),
|
||||
$(ImU32 col)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addImageQuad
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ()
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
|
||||
-> ImU32
|
||||
-> m ()
|
||||
addImageQuad (DrawList drawList) userTextureIDPtr p1 p2 p3 p4 uv1 uv2 uv3 uv4 col = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddImageQuad(
|
||||
$(void* userTextureIDPtr),
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
*$(ImVec2* p4),
|
||||
*$(ImVec2* uv1),
|
||||
*$(ImVec2* uv2),
|
||||
*$(ImVec2* uv3),
|
||||
*$(ImVec2* uv4),
|
||||
$(ImU32 col)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
addImageRounded
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ()
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -- Positions
|
||||
-> Ptr ImVec2 -> Ptr ImVec2 -- UVs
|
||||
-> ImU32
|
||||
-> CFloat
|
||||
-> ImDrawFlags
|
||||
-> m ()
|
||||
addImageRounded (DrawList drawList) userTextureIDPtr p_min p_max uv_min uv_max col rounding flags = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddImageRounded(
|
||||
$(void* userTextureIDPtr),
|
||||
*$(ImVec2* p_min),
|
||||
*$(ImVec2* p_max),
|
||||
*$(ImVec2* uv_min),
|
||||
*$(ImVec2* uv_max),
|
||||
$(ImU32 col),
|
||||
$(float rounding),
|
||||
$(ImDrawFlags flags)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
{- $stateful
|
||||
Add points then finish with 'pathFillConvex' or 'pathStroke'.
|
||||
-}
|
||||
|
||||
pathClear :: MonadIO m => DrawList -> m ()
|
||||
pathClear (DrawList drawList) = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathClear();
|
||||
}
|
||||
|]
|
||||
|
||||
pathLineTo :: MonadIO m => DrawList -> Ptr ImVec2 -> m ()
|
||||
pathLineTo (DrawList drawList) pos = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathLineTo(
|
||||
*$(ImVec2* pos)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
pathLineToMergeDuplicate :: MonadIO m => DrawList -> Ptr ImVec2 -> m ()
|
||||
pathLineToMergeDuplicate (DrawList drawList) pos = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathLineToMergeDuplicate(
|
||||
*$(ImVec2* pos)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
-- | Note: Anti-aliased filling requires points to be in clockwise order.
|
||||
pathFillConvex :: MonadIO m => DrawList -> ImU32 -> m ()
|
||||
pathFillConvex (DrawList drawList) col = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathFillConvex(
|
||||
$(ImU32 col)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
pathStroke :: MonadIO m => DrawList -> ImU32 -> ImDrawFlags -> CFloat -> m ()
|
||||
pathStroke (DrawList drawList) col flags thickness = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathStroke(
|
||||
$(ImU32 col),
|
||||
$(ImDrawFlags flags),
|
||||
$(float thickness)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
pathArcTo :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> CFloat -> CFloat -> CInt -> m ()
|
||||
pathArcTo (DrawList drawList) center radius a_min a_max num_segments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathArcTo(
|
||||
*$(ImVec2* center),
|
||||
$(float radius),
|
||||
$(float a_min),
|
||||
$(float a_max),
|
||||
$(int num_segments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
-- | Use precomputed angles for a 12 steps circle.
|
||||
pathArcToFast :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> CInt -> CInt -> m ()
|
||||
pathArcToFast (DrawList drawList) center radius a_min_of_12 a_max_of_12 = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathArcToFast(
|
||||
*$(ImVec2* center),
|
||||
$(float radius),
|
||||
$(int a_min_of_12),
|
||||
$(int a_max_of_12)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
pathBezierCubicCurveTo
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ImVec2
|
||||
-> Ptr ImVec2
|
||||
-> Ptr ImVec2
|
||||
-> CInt
|
||||
-> m ()
|
||||
pathBezierCubicCurveTo (DrawList drawList) p1 p2 p3 num_segments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathBezierCubicCurveTo(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
*$(ImVec2* p3),
|
||||
$(int num_segments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
pathBezierQuadraticCurveTo
|
||||
:: MonadIO m
|
||||
=> DrawList
|
||||
-> Ptr ImVec2
|
||||
-> Ptr ImVec2
|
||||
-> CInt
|
||||
-> m ()
|
||||
pathBezierQuadraticCurveTo (DrawList drawList) p1 p2 num_segments = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathBezierQuadraticCurveTo(
|
||||
*$(ImVec2* p1),
|
||||
*$(ImVec2* p2),
|
||||
$(int num_segments)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
pathRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CFloat -> ImDrawFlags -> m ()
|
||||
pathRect (DrawList drawList) rect_min rect_max rounding flags = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->PathRect(
|
||||
*$(ImVec2* rect_min),
|
||||
*$(ImVec2* rect_max),
|
||||
$(float rounding),
|
||||
$(ImDrawFlags flags)
|
||||
);
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
-- | This is useful if you need to forcefully create a new draw call (to allow for dependent rendering / blending).
|
||||
-- Otherwise primitives are merged into the same draw-call as much as possible.
|
||||
addDrawCmd :: MonadIO m => DrawList -> m ()
|
||||
addDrawCmd (DrawList drawList) = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImDrawList* drawList)->AddDrawCmd();
|
||||
}
|
||||
|]
|
||||
|
||||
-- | Create a clone of the CmdBuffer/IdxBuffer/VtxBuffer.
|
||||
cloneOutput :: MonadIO m => DrawList -> m DrawList
|
||||
cloneOutput (DrawList drawList) = liftIO do
|
||||
DrawList <$> [C.block|
|
||||
ImDrawList* {
|
||||
return $(ImDrawList* drawList)->CloneOutput();
|
||||
}
|
||||
|]
|
137
src/DearImGui/Raw/IO.hs
Normal file
137
src/DearImGui/Raw/IO.hs
Normal file
@ -0,0 +1,137 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-| Main configuration and I/O between your application and ImGui
|
||||
|
||||
-}
|
||||
|
||||
module DearImGui.Raw.IO
|
||||
( setIniFilename
|
||||
, setLogFilename
|
||||
|
||||
, setMouseDoubleClickMaxDist
|
||||
, setMouseDoubleClickTime
|
||||
, setMouseDragThreshold
|
||||
|
||||
, setKeyRepeatDelay
|
||||
, setKeyRepeatRate
|
||||
|
||||
, setUserData
|
||||
) where
|
||||
|
||||
-- TODO: add exports
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
( MonadIO, liftIO )
|
||||
import Foreign
|
||||
( Ptr )
|
||||
import Foreign.C
|
||||
( CFloat(..)
|
||||
, CString
|
||||
)
|
||||
|
||||
-- dear-imgui
|
||||
import DearImGui.Context
|
||||
( imguiContext )
|
||||
-- import DearImGui.Enums
|
||||
-- import DearImGui.Structs
|
||||
|
||||
-- inline-c
|
||||
import qualified Language.C.Inline as C
|
||||
|
||||
-- inline-c-cpp
|
||||
import qualified Language.C.Inline.Cpp as Cpp
|
||||
|
||||
C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext)
|
||||
C.include "imgui.h"
|
||||
Cpp.using "namespace ImGui"
|
||||
|
||||
setIniFilename :: MonadIO m => CString -> m ()
|
||||
setIniFilename ptr = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().IniFilename = $(char * ptr);
|
||||
}
|
||||
|]
|
||||
|
||||
setLogFilename :: MonadIO m => CString -> m ()
|
||||
setLogFilename ptr = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().LogFilename = $(char * ptr);
|
||||
}
|
||||
|]
|
||||
|
||||
setMouseDoubleClickTime :: MonadIO m => CFloat -> m ()
|
||||
setMouseDoubleClickTime seconds = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().MouseDoubleClickTime = $(float seconds);
|
||||
}
|
||||
|]
|
||||
|
||||
setMouseDoubleClickMaxDist :: MonadIO m => CFloat -> m ()
|
||||
setMouseDoubleClickMaxDist pixels = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().MouseDoubleClickMaxDist = $(float pixels);
|
||||
}
|
||||
|]
|
||||
|
||||
setMouseDragThreshold :: MonadIO m => CFloat -> m ()
|
||||
setMouseDragThreshold pixels = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().MouseDragThreshold = $(float pixels);
|
||||
}
|
||||
|]
|
||||
|
||||
setKeyRepeatDelay :: MonadIO m => CFloat -> m ()
|
||||
setKeyRepeatDelay seconds = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().KeyRepeatDelay = $(float seconds);
|
||||
}
|
||||
|]
|
||||
|
||||
setKeyRepeatRate :: MonadIO m => CFloat -> m ()
|
||||
setKeyRepeatRate pixels = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().KeyRepeatRate = $(float pixels);
|
||||
}
|
||||
|]
|
||||
|
||||
setUserData :: MonadIO m => Ptr () -> m ()
|
||||
setUserData ptr = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
GetIO().UserData = $(void* ptr);
|
||||
}
|
||||
|]
|
||||
|
||||
{- TODO:
|
||||
|
||||
bool WantCaptureMouse; // Set when Dear ImGui will use mouse inputs, in this case do not dispatch them to your main game/application (either way, always pass on mouse inputs to imgui). (e.g. unclicked mouse is hovering over an imgui window, widget is active, mouse was clicked over an imgui window, etc.).
|
||||
bool WantCaptureKeyboard; // Set when Dear ImGui will use keyboard inputs, in this case do not dispatch them to your main game/application (either way, always pass keyboard inputs to imgui). (e.g. InputText active, or an imgui window is focused and navigation is enabled, etc.).
|
||||
bool WantTextInput; // Mobile/console: when set, you may display an on-screen keyboard. This is set by Dear ImGui when it wants textual keyboard input to happen (e.g. when a InputText widget is active).
|
||||
bool WantSetMousePos; // MousePos has been altered, backend should reposition mouse on next frame. Rarely used! Set only when ImGuiConfigFlags_NavEnableSetMousePos flag is enabled.
|
||||
bool WantSaveIniSettings; // When manual .ini load/save is active (io.IniFilename == NULL), this will be set to notify your application that you can call SaveIniSettingsToMemory() and save yourself. Important: clear io.WantSaveIniSettings yourself after saving!
|
||||
bool NavActive; // Keyboard/Gamepad navigation is currently allowed (will handle ImGuiKey_NavXXX events) = a window is focused and it doesn't use the ImGuiWindowFlags_NoNavInputs flag.
|
||||
bool NavVisible; // Keyboard/Gamepad navigation is visible and allowed (will handle ImGuiKey_NavXXX events).
|
||||
float Framerate; // Rough estimate of application framerate, in frame per second. Solely for convenience. Rolling average estimation based on io.DeltaTime over 120 frames.
|
||||
int MetricsRenderVertices; // Vertices output during last call to Render()
|
||||
int MetricsRenderIndices; // Indices output during last call to Render() = number of triangles * 3
|
||||
int MetricsRenderWindows; // Number of visible windows
|
||||
int MetricsActiveWindows; // Number of active windows
|
||||
int MetricsActiveAllocations; // Number of active allocations, updated by MemAlloc/MemFree based on current context. May be off if you have multiple imgui contexts.
|
||||
ImVec2 MouseDelta;
|
||||
-}
|
149
src/DearImGui/Raw/ListClipper.hs
Normal file
149
src/DearImGui/Raw/ListClipper.hs
Normal file
@ -0,0 +1,149 @@
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
{-| Helper: Manually clip large list of items.
|
||||
|
||||
If you are submitting lots of evenly spaced items and you have a random access to the list,
|
||||
you can perform coarse clipping based on visibility to save yourself from processing those items at all.
|
||||
|
||||
The clipper calculates the range of visible items and advance the cursor to compensate for the non-visible items we have skipped.
|
||||
|
||||
Dear ImGui already clips items based on their bounds but it needs to measure text size to do so,
|
||||
whereas manual coarse clipping before submission makes this cost and your own data fetching/submission cost almost null.
|
||||
|
||||
Usage:
|
||||
|
||||
@
|
||||
clipper <- ListClipper.new
|
||||
ListClipper.begin clipper 1000 -- We have 1000 elements, evenly spaced.
|
||||
whileTrue (ListClipper.step clipper) $
|
||||
start <- ListClipper.displayStart clipper
|
||||
end <- ListClipper.displayEnd clipper
|
||||
for_ [start .. end] \ix ->
|
||||
ImGui.text $ "line number " <> show ix
|
||||
@
|
||||
|
||||
Generally what happens is:
|
||||
|
||||
* Clipper lets you process the first element (DisplayStart = 0, DisplayEnd = 1) regardless of it being visible or not.
|
||||
* User code submit one element.
|
||||
* Clipper can measure the height of the first element
|
||||
* Clipper calculate the actual range of elements to display based on the current clipping rectangle,
|
||||
position the cursor before the first visible element.
|
||||
* User code submit visible elements.
|
||||
-}
|
||||
|
||||
module DearImGui.Raw.ListClipper
|
||||
( ListClipper
|
||||
, new
|
||||
, delete
|
||||
, begin
|
||||
, displayStart
|
||||
, displayEnd
|
||||
, step
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
( MonadIO, liftIO )
|
||||
import Foreign hiding (new)
|
||||
import Foreign.C
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
-- dear-imgui
|
||||
import DearImGui.Context
|
||||
( imguiContext )
|
||||
import DearImGui.Structs
|
||||
( ImGuiListClipper )
|
||||
|
||||
-- inline-c
|
||||
import qualified Language.C.Inline as C
|
||||
|
||||
-- inline-c-cpp
|
||||
import qualified Language.C.Inline.Cpp as Cpp
|
||||
|
||||
C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext)
|
||||
C.include "imgui.h"
|
||||
Cpp.using "namespace ImGui"
|
||||
|
||||
|
||||
-- | @ImGuiListClipper@ object handle.
|
||||
type ListClipper = Ptr ImGuiListClipper
|
||||
|
||||
|
||||
-- | Create a new 'ListClipper' instance.
|
||||
new :: (MonadIO m) => m ListClipper
|
||||
new = liftIO do
|
||||
[C.block|
|
||||
ImGuiListClipper* {
|
||||
return IM_NEW(ImGuiListClipper);
|
||||
}
|
||||
|]
|
||||
|
||||
-- | Destroy 'ListClipper' instance.
|
||||
delete :: (MonadIO m) => ListClipper -> m ()
|
||||
delete clipper = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
IM_DELETE($(ImGuiListClipper* clipper));
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
-- | ListClipper setup
|
||||
--
|
||||
-- @items_count@: Use 'maxBound' if you don't know how many items you have
|
||||
-- (in which case the cursor won't be advanced in the final step).
|
||||
--
|
||||
-- @items_height@: Use -1.0f to be calculated automatically on first step.
|
||||
-- Otherwise pass in the distance between your items, typically
|
||||
-- 'getTextLineHeightWithSpacing' or 'getFrameHeightWithSpacing'.
|
||||
--
|
||||
-- Wraps @ListClipper::Begin()@.
|
||||
begin :: (MonadIO m) => ListClipper -> CInt -> CFloat -> m ()
|
||||
begin clipper items_count items_height = liftIO do
|
||||
[C.block|
|
||||
void {
|
||||
$(ImGuiListClipper* clipper)->Begin($(int items_count), $(float items_height));
|
||||
}
|
||||
|]
|
||||
|
||||
-- | An accessor for @ListClipper::Begin@
|
||||
displayStart :: ListClipper -> CInt
|
||||
displayStart clipper = unsafePerformIO do
|
||||
[C.exp|
|
||||
int {
|
||||
$(ImGuiListClipper* clipper)->DisplayStart
|
||||
}
|
||||
|]
|
||||
|
||||
-- | An accessor for @ListClipper::DisplayStart@
|
||||
displayEnd :: ListClipper -> CInt
|
||||
displayEnd clipper = unsafePerformIO
|
||||
[C.exp|
|
||||
int {
|
||||
$(ImGuiListClipper* clipper)->DisplayEnd
|
||||
}
|
||||
|]
|
||||
|
||||
|
||||
-- | Call until it returns 'False'.
|
||||
--
|
||||
-- The 'displayStart'/'displayEnd' fields will be set and you can process/draw those items.
|
||||
--
|
||||
-- Wraps @ListClipper::Step()@.
|
||||
step :: (MonadIO m) => ListClipper -> m Bool
|
||||
step clipper = liftIO do
|
||||
(0 /=) <$> [C.block|
|
||||
bool {
|
||||
return $(ImGuiListClipper* clipper)->Step();
|
||||
}
|
||||
|]
|
@ -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@.
|
||||
|
@ -4,11 +4,14 @@
|
||||
module DearImGui.Structs where
|
||||
|
||||
-- base
|
||||
import Data.Word
|
||||
( Word32 )
|
||||
import Foreign
|
||||
( Storable(..), castPtr, plusPtr )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
|
||||
deriving (Show)
|
||||
|
||||
|
||||
instance Storable ImVec2 where
|
||||
@ -27,6 +30,7 @@ instance Storable ImVec2 where
|
||||
|
||||
|
||||
data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
|
||||
deriving (Show)
|
||||
|
||||
|
||||
instance Storable ImVec3 where
|
||||
@ -47,6 +51,7 @@ instance Storable ImVec3 where
|
||||
|
||||
|
||||
data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
|
||||
deriving (Show)
|
||||
|
||||
|
||||
instance Storable ImVec4 where
|
||||
@ -66,3 +71,20 @@ 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
|
||||
|
||||
-- | Opaque DrawList handle.
|
||||
data ImDrawList
|
||||
|
||||
-- | 'DearImGui.Raw.ListClipper.ListClipper' pointer tag.
|
||||
data ImGuiListClipper
|
||||
|
||||
-- | 32-bit unsigned integer (often used to store packed colors).
|
||||
type ImU32 = Word32
|
||||
|
Reference in New Issue
Block a user