dear-imgui.hs/examples/Readme.hs

82 lines
1.9 KiB
Haskell
Raw Normal View History

2021-01-24 19:50:21 +00:00
-- NOTE: If this is file is edited, please also copy and paste it into
-- README.md.
{-# language BlockArguments #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
module Main ( main ) where
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Managed
import DearImGui
2021-02-06 14:44:58 +00:00
import DearImGui.OpenGL2
2021-01-24 19:50:21 +00:00
import DearImGui.SDL
import DearImGui.SDL.OpenGL
import Graphics.GL
import SDL
main :: IO ()
main = do
-- Initialize SDL
initializeAll
runManaged do
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
2021-08-30 17:08:23 +00:00
window <- do
2021-01-24 19:50:21 +00:00
let title = "Hello, Dear ImGui!"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
managed $ bracket (createWindow title config) destroyWindow
-- Create an OpenGL context
2021-08-30 17:08:23 +00:00
glContext <- managed $ bracket (glCreateContext window) glDeleteContext
2021-01-24 19:50:21 +00:00
-- Create an ImGui context
_ <- managed $ bracket createContext destroyContext
-- Initialize ImGui's SDL2 backend
2021-08-30 17:08:23 +00:00
_ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
2021-01-24 19:50:21 +00:00
-- Initialize ImGui's OpenGL backend
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
2021-08-30 17:08:23 +00:00
liftIO $ mainLoop window
2021-01-24 19:50:21 +00:00
mainLoop :: Window -> IO ()
2021-08-30 17:08:23 +00:00
mainLoop window = do
2021-01-24 19:50:21 +00:00
-- Process the event loop
untilNothingM pollEventWithImGui
-- Tell ImGui we're starting a new frame
openGL2NewFrame
2021-08-30 16:57:00 +00:00
sdl2NewFrame
2021-01-24 19:50:21 +00:00
newFrame
-- Build the GUI
withWindowOpen "Hello, ImGui!" do
2021-01-24 19:50:21 +00:00
-- Add a text widget
text "Hello, ImGui!"
-- Add a button widget, and call 'putStrLn' when it's clicked
button "Clickety Click" >>= \case
False -> return ()
True -> putStrLn "Ow!"
-- Show the ImGui demo window
showDemoWindow
2021-01-24 19:50:21 +00:00
-- Render
glClear GL_COLOR_BUFFER_BIT
render
openGL2RenderDrawData =<< getDrawData
2021-08-30 17:08:23 +00:00
glSwapWindow window
2021-01-24 19:50:21 +00:00
2021-08-30 17:08:23 +00:00
mainLoop window
2021-01-24 19:50:21 +00:00
where
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)