-
Notifications
You must be signed in to change notification settings - Fork 31
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
2 changed files
with
66 additions
and
74 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,91 +1,87 @@ | ||
-- 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 | ||
import DearImGui.OpenGL2 | ||
import DearImGui.OpenGL3 | ||
import DearImGui.SDL | ||
import DearImGui.SDL.OpenGL | ||
|
||
import Graphics.GL | ||
import SDL | ||
|
||
import Control.Monad.Managed | ||
import Control.Monad.IO.Class () | ||
import Control.Monad (when, unless) | ||
import Control.Exception (bracket, bracket_) | ||
|
||
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. | ||
runManaged $ do | ||
-- Create a window using SDL; as we're using OpenGL, we enable OpenGL too | ||
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 window) glDeleteContext | ||
|
||
-- Create an ImGui context | ||
_ <- managed $ bracket createContext destroyContext | ||
|
||
-- Initialize ImGui's SDL2 backend | ||
_ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown | ||
|
||
managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown | ||
-- Initialize ImGui's OpenGL backend | ||
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown | ||
managed_ $ bracket_ openGL3Init openGL3Shutdown | ||
|
||
liftIO $ mainLoop window | ||
|
||
|
||
mainLoop :: Window -> IO () | ||
mainLoop window = unlessQuit do | ||
mainLoop window = unlessQuit $ do | ||
-- Tell ImGui we're starting a new frame | ||
openGL2NewFrame | ||
openGL3NewFrame | ||
sdl2NewFrame | ||
newFrame | ||
|
||
-- Build the GUI | ||
withWindowOpen "Hello, ImGui!" do | ||
withWindowOpen "Hello, ImGui!" $ do | ||
-- 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!" | ||
button "Clickety Click" >>= \clicked -> | ||
when clicked $ putStrLn "Ow!" | ||
|
||
-- Show the ImGui demo window | ||
showDemoWindow | ||
|
||
-- Render | ||
glClear GL_COLOR_BUFFER_BIT | ||
|
||
render | ||
openGL2RenderDrawData =<< getDrawData | ||
openGL3RenderDrawData =<< getDrawData | ||
|
||
glSwapWindow window | ||
|
||
mainLoop window | ||
|
||
where | ||
-- 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 | ||
-- Process the event loop | ||
unlessQuit action = do | ||
shouldQuit <- gotQuitEvent | ||
unless shouldQuit action | ||
|
||
gotQuitEvent = do | ||
ev <- pollEventWithImGui | ||
|
||
case ev of | ||
Nothing -> | ||
return False | ||
Just event -> | ||
(isQuit event ||) <$> gotQuitEvent | ||
|
||
isQuit event = | ||
eventPayload event == QuitEvent |