This is a follow-up to Incredibly Magic Graphics User Interface. This post demonstrates how to implement a dear-imgui widget to manipulate arbitrary floating point values.
This document is a literate haskell file
-- Quality of life syntaxic sugar
{-# LANGUAGE OverloadedStrings, ImportQualifiedPost, NamedFieldPuns, BlockArguments, LambdaCase #-}
-- RankNTypes enables using Lens as function argument
{-# LANGUAGE RankNTypes #-}
-- To replace base with rio
{-# LANGUAGE NoImplicitPrelude #-}
import RIO
import Data.Text (pack)
import DearImGui qualified
import Data.StateVar qualified as StateVar
-- Necessary import to create the window and render the GUI
import Control.Monad.Managed (runManaged, managed, managed_)
import DearImGui.OpenGL3 qualified as DGL3
import DearImGui.SDL qualified as DSDL
import DearImGui.SDL.OpenGL qualified as DGL
import Graphics.GL qualified as GL
import SDL qualified
Context
The goal of this implementation is to manipulate and adjust dynamic values, such as a coordinate position which can be any of these values:
- 9001.0
- 0.001
- -2.0
It is not practical to use a regular slider or drag controller because we don’t know the range and we don’t want arbitrary bounds. Instead, we are going to use a Scientific representation to manipulate the exponent independently from the coefficient.
import Data.Scientific (Scientific)
import Data.Scientific qualified as Scientific
Scientific lens
Here are the lenses to pull appart our scientific value:
exp10L :: Lens' Scientific Int
exp10L = lens getv setv
where
getv :: Scientific -> Int
getv = Scientific.base10Exponent
setv :: Scientific -> Int -> Scientific
setv s c = Scientific.scientific (Scientific.coefficient s) c
coefL :: Lens' Scientific Int
coefL = lens getv setv
where
-- This should be Integer, but dear-imgui works with Int.
getv :: Scientific -> Int
getv = fromInteger . Scientific.coefficient
setv :: Scientific -> Int -> Scientific
setv s c = Scientific.scientific (toInteger c) (Scientific.base10Exponent s)
These lenses let us view and modify a scientific value:
example :: Scientific
example = 9001.42
demo :: [String]
demo = [
show (coefL `view` example), -- 900142
show (exp10L `view` example), -- -2
show ((coefL `set` 42) example), -- 0.42
show ((exp10L `set` 42) example) -- 9.00142e47
]
Note that
lens
,view
andset
are provided by rio. If you are not familiar with lens, checkout the lens-tutorial.
StateVar Lens
The dear-imgui Haskell bindings expects StateVar references, so that the GUI can read and write our value. We’ll use this helper function to create one StateVar for each of our lens:
-- note: this function definition requires the RankNTypes extension
makeStateLens :: TVar a -> Lens' a b -> StateVar.StateVar b
makeStateLens value valueLens = StateVar.makeStateVar getv setv
where
-- getv :: IO b
getv = view valueLens <$> readTVarIO value
-- setv :: b -> IO ()
setv = atomically . modifyTVar' value . set valueLens
Here is an example StateVar usage:
stateDemo :: IO String
stateDemo = do
-- create the coef StateVar
exampleVar <- newTVarIO example
let coefVar = makeStateLens exampleVar coefL
-- update the coef
coefVar StateVar.$= 42
-- Return "0.42"
show <$> readTVarIO exampleVar
The float controller
We’ll keep both the internal scientific reprensentation and the final floating output:
data FloatController = FloatController {
value :: TVar Scientific.Scientific,
output :: TVar Float
}
newFloatController :: Float -> STM FloatController
newFloatController initialValue =
FloatController
<$> newTVar (Scientific.fromFloatDigits initialValue)
<*> newTVar initialValue
And here is how we can draw the controller:
drawFloatController :: FloatController -> IO ()
drawFloatController FloatController{value, output} = do
let
coefVar = makeStateLens value coefL
expVar = makeStateLens value exp10L
-- we clamp the exponent between -38 and 38.
whenM (DearImGui.dragInt "exp" expVar 1 (-38) 38) updateOutput
whenM (DearImGui.dragInt "coef" coefVar 1 minBound maxBound) updateOutput
DearImGui.text . mappend "Final value: " =<< pack . show <$> readTVarIO output
where
-- on change, we convert the scientific value to the float output.
updateOutput = atomically do
scientificValue <- readTVar value
writeTVar output (Scientific.toRealFloat scientificValue)
… which looks like this:
In the next section we’ll improve this implementation so that changing the exponent does not affect the final value.
Dynamic float controller
We would like the exponent to only define the range, adjusting the coefficient automatically. Here is the final version:
drawFloatController' :: FloatController -> IO ()
drawFloatController' FloatController{value, output} = do
let
coefVar = makeStateLens value coefL
expVar = makeStateLens value exp10L
-- We pack all the elements tightly on a single line
DearImGui.setNextItemWidth 40
prevExp <- StateVar.get expVar
whenM (DearImGui.dragInt "##exp" expVar 1 (-38) 38) do
-- When the exponent value changes, we adjust the coefficient.
newExp <- StateVar.get expVar
let adjust coef
| -- The exp decrease, so we adjust the coef
newExp < prevExp = coef * 10
| -- The exp increase and the coef can be reduced
abs coef >= 10 = coef `div` 10
| -- otherwise, we don't touch the coef
otherwise = coef
coefVar StateVar.$~! adjust
DearImGui.sameLine
DearImGui.setNextItemWidth 140
whenM (DearImGui.dragInt "##coef" coefVar 1 minBound maxBound) $ atomically do
-- When the coefficient changes, we update the final float value.
scientificValue <- readTVar value
writeTVar output (Scientific.toRealFloat scientificValue)
DearImGui.sameLine
DearImGui.text . mappend "value: " =<< pack . show <$> readTVarIO output
… which looks like this:
Run the GUI
Finally, the initializing code borrowed from the dear-imgui README:
main :: IO ()
main = runSimpleApp do
-- print example
logInfo (displayShow demo)
logInfo . displayShow =<< liftIO stateDemo
floatController <- atomically (newFloatController 1)
-- For this demo we'll draw the interface fullscreen:
let doDrawGUI = DearImGui.withFullscreen (drawFloatController' floatController)
SDL.initializeAll
liftIO $ runManaged do
window <- do
let title = "Hello, Dear ImGui!"
let config = SDL.defaultWindow { SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL }
managed $ bracket (SDL.createWindow title config) SDL.destroyWindow
glContext <- managed $ bracket (SDL.glCreateContext window) SDL.glDeleteContext
_ <- managed $ bracket DearImGui.createContext DearImGui.destroyContext
_ <- managed_ $ bracket_ (DGL.sdl2InitForOpenGL window glContext) DSDL.sdl2Shutdown
_ <- managed_ $ bracket_ DGL3.openGL3Init DGL3.openGL3Shutdown
liftIO $ mainLoop window doDrawGUI
mainLoop :: SDL.Window -> IO () -> IO ()
mainLoop window doDrawGUI = unlessQuit do
DGL3.openGL3NewFrame
DSDL.sdl2NewFrame
DearImGui.newFrame
-- Build the GUI
doDrawGUI
GL.glClear GL.GL_COLOR_BUFFER_BIT
DearImGui.render
DGL3.openGL3RenderDrawData =<< DearImGui.getDrawData
SDL.glSwapWindow window
mainLoop window doDrawGUI
where
unlessQuit action = do
shouldQuit <- checkEvents
if shouldQuit then pure () else action
checkEvents = do
DSDL.pollEventWithImGui >>= \case
Nothing ->
return False
Just event ->
(isQuit event ||) <$> checkEvents
isQuit event =
SDL.eventPayload event == SDL.QuitEvent
To evaluate the file: nixGLIntel nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/da60f2dc9c95692804fa6575fa467e659de5031b.tar.gz -p ghcid -p ’haskellPackages.ghcWithPackages (p: [p.markdown-unlit (haskell.lib.overrideCabal p.dear-imgui { patches = [(fetchpatch {url = “https://patch-diff.githubusercontent.com/raw/TristanCacqueray/dear-imgui.hs/pull/1.patch"; sha256 = “sha256-SKiaS30dPe2xJZ1Th47upWlfxmONWaQnlm8v1DmOF8c=“;})];}) p.text p.rio p.OpenGLRaw])’ –command ‘ghcid -W –test=:main –command “ghci -pgmL markdown-unlit” float-controller.lhs’
Conclusion
Using the scientific and lens package we implemented a controller to manipulate floating values.