dear-imgui.hs/examples/sdl/Image.hs

{-# 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 qualified DearImGui.Raw as Raw
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 Foreign.Ptr
import qualified Numeric.LinearAlgebra as M
import Foreign.Marshal.Alloc
import Data.IORef
import qualified Data.Vector.Storable as VS

data Texture = Texture {textureID :: GLuint, textureWidth :: GLsizei, textureHeight :: GLsizei}

-- |Creates a texture in memory
--
-- Reserves space on the texture-memory for width*height
create2DTexture :: Int -> Int -> IO Texture
create2DTexture width height = do
  alloca $ \ptr -> do
    glGenTextures 1 ptr
    tID <- peek ptr
    return Texture {textureID = tID, textureWidth = fromIntegral width, textureHeight = fromIntegral height}
    

--createDummyTexture :: IORef Texture -> M.Matrix (Float) -> IO ()
--createDummyTexture texture matrix = do
createDummyTexture :: Texture -> IO ()
createDummyTexture texture = do
  let width = textureWidth texture
  let height = textureWidth texture
  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
  let dat = VS.generate (3*(fromIntegral width)*(fromIntegral height)) (\i -> fromIntegral $ 17 + (50 * (i `mod` 3)):: GLubyte) :: VS.Vector GLubyte -- some blueish
  VS.unsafeWith dat $ \dataPtr -> do
    glTexImage2D GL_TEXTURE_2D 0 GL_RGB width height 0 GL_RGB GL_UNSIGNED_BYTE (castPtr dataPtr)
    return()
  glBindTexture GL_TEXTURE_2D 0
  return ()


gui :: IO ()
gui = do


  -- Initialize SDL
  SDL.initializeAll



  runManaged do
    -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
    w <- 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 w) SDL.glDeleteContext

    -- Create an ImGui context
    _ <- managed $ bracket createContext destroyContext

    -- Initialize ImGui's SDL2 backend
    _ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown

    -- Initialize ImGui's OpenGL backend
    _ <- managed_ $ bracket_ openGL3Init (do 
      putStrLn "ImguiOpenGL shut down"
      openGL3Shutdown)


    liftIO $ do 
      txt <- create2DTexture 500 500 
      createDummyTexture txt
      err <- glGetError
      putStrLn $  "Error-code: " ++ show err
     
    liftIO $ do
      mainLoop w 1 -- 1 is actually the Ptr address


mainLoop :: SDL.Window ->  GLuint -> IO ()
mainLoop w c = do
  -- Process the event loop
  untilNothingM pollEventWithImGui

  -- Tell ImGui we're starting a new frame
  openGL3NewFrame
  sdl2NewFrame
  newFrame

  -- Build the GUI
  bracket_ (begin "GL") end $ do
--    image (intPtrToPtr $ fromIntegral c) (ImVec2 500 500)(ImVec2 0 0)(ImVec2 1 1)(ImVec4 1 1 1 1)(ImVec4 0 0 0 0)
    Foreign.with (ImVec2 500 500) \sizePtr ->
      Foreign.with (ImVec2 0 0) \uv0Ptr -> 
        Foreign.with (ImVec2 1 1) \uv1Ptr -> 
          Foreign.with (ImVec4 1 1 1 1) \tintColPtr -> 
            Foreign.with (ImVec4 0 0 0 0) \borderColPtr -> do
              Raw.image (intPtrToPtr $ fromIntegral c) sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr

  -- Render
  render
  glClear GL_COLOR_BUFFER_BIT

  openGL3RenderDrawData =<< getDrawData

  SDL.glSwapWindow w

  mainLoop w c

  where
    untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)

main = do gui