mirror of
				https://github.com/Drezil/dear-imgui.hs.git
				synced 2025-11-04 07:01:06 +01:00 
			
		
		
		
	Add support for GLFW (#26)
Co-authored-by: Oliver Charles <ollie@ocharles.org.uk>
This commit is contained in:
		
							
								
								
									
										82
									
								
								examples/glfw/Main.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										82
									
								
								examples/glfw/Main.hs
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,82 @@
 | 
			
		||||
{-# language BlockArguments #-}
 | 
			
		||||
{-# language LambdaCase #-}
 | 
			
		||||
{-# language OverloadedStrings #-}
 | 
			
		||||
 | 
			
		||||
module Main ( main ) where
 | 
			
		||||
 | 
			
		||||
import Control.Exception
 | 
			
		||||
import Control.Monad
 | 
			
		||||
import Control.Monad.IO.Class
 | 
			
		||||
import Control.Monad.Managed
 | 
			
		||||
import DearImGui
 | 
			
		||||
import DearImGui.OpenGL
 | 
			
		||||
import DearImGui.GLFW
 | 
			
		||||
import DearImGui.GLFW.OpenGL
 | 
			
		||||
import Graphics.GL
 | 
			
		||||
import Graphics.UI.GLFW (Window)
 | 
			
		||||
import qualified Graphics.UI.GLFW as GLFW
 | 
			
		||||
 | 
			
		||||
main :: IO ()
 | 
			
		||||
main = do
 | 
			
		||||
  initialised <- GLFW.init
 | 
			
		||||
  unless initialised $ error "GLFW init failed"
 | 
			
		||||
 | 
			
		||||
  runManaged $ do
 | 
			
		||||
    mwin <- managed $ bracket
 | 
			
		||||
      (GLFW.createWindow 800 600 "Hello, Dear ImGui!" Nothing Nothing)
 | 
			
		||||
      (maybe (return ()) GLFW.destroyWindow)
 | 
			
		||||
    case mwin of
 | 
			
		||||
      Just win -> do
 | 
			
		||||
        liftIO $ do
 | 
			
		||||
          GLFW.makeContextCurrent (Just win)
 | 
			
		||||
          GLFW.swapInterval 1
 | 
			
		||||
 | 
			
		||||
        -- Create an ImGui context
 | 
			
		||||
        _ <- managed $ bracket createContext destroyContext
 | 
			
		||||
 | 
			
		||||
        -- Initialize ImGui's GLFW backend
 | 
			
		||||
        _ <- managed_ $ bracket_ (glfwInitForOpenGL win True) glfwShutdown
 | 
			
		||||
 | 
			
		||||
        -- Initialize ImGui's OpenGL backend
 | 
			
		||||
        _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
 | 
			
		||||
 | 
			
		||||
        liftIO $ mainLoop win
 | 
			
		||||
      Nothing -> do
 | 
			
		||||
        error "GLFW createWindow failed"
 | 
			
		||||
 | 
			
		||||
  GLFW.terminate
 | 
			
		||||
 | 
			
		||||
mainLoop :: Window -> IO ()
 | 
			
		||||
mainLoop win = do
 | 
			
		||||
  -- Process the event loop
 | 
			
		||||
  GLFW.pollEvents
 | 
			
		||||
  close <- GLFW.windowShouldClose win
 | 
			
		||||
  unless close do
 | 
			
		||||
 | 
			
		||||
    -- Tell ImGui we're starting a new frame
 | 
			
		||||
    openGL2NewFrame
 | 
			
		||||
    glfwNewFrame
 | 
			
		||||
    newFrame
 | 
			
		||||
 | 
			
		||||
    -- Build the GUI
 | 
			
		||||
    bracket_ (begin "Hello, ImGui!") end 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!"
 | 
			
		||||
 | 
			
		||||
    -- Show the ImGui demo window
 | 
			
		||||
    showDemoWindow
 | 
			
		||||
 | 
			
		||||
    -- Render
 | 
			
		||||
    glClear GL_COLOR_BUFFER_BIT
 | 
			
		||||
 | 
			
		||||
    render
 | 
			
		||||
    openGL2RenderDrawData =<< getDrawData
 | 
			
		||||
 | 
			
		||||
    GLFW.swapBuffers win
 | 
			
		||||
 | 
			
		||||
    mainLoop win
 | 
			
		||||
		Reference in New Issue
	
	Block a user