Enabling compatibility profile/support for immediate rendering mode?

[mniip]

I'm a big fan of using gloss for visualization because of just how straightforward it is: with a quick glance at the Picture datatype you can immediately get something on the screen. However gloss lacks any sort of way to do declarative composable UI, which is where monomer shines. A natural bridge between the two would be to have a monomer widget that renders a gloss Picture.

In my attempt to do this I realized that gloss in its infinite wisdom uses immediate rendering: glTranslate, glRotate, glBegin, glVertex, glEnd etc. These functions are an artifact of OpenGL 1/2 and have been deprecated in OpenGL 3. Monomer initializes the GL context using the "core" profile, which disables such deprecated functions, however it's possible to initialize the context using the "compatibility" profile, which even in OpenGL 3.2 allows using immediate rendering functions. The relevant diff is:

diff --git a/src/Monomer/Main/Platform.hs b/src/Monomer/Main/Platform.hs
index 7070d900..728b780c 100644
--- a/src/Monomer/Main/Platform.hs
+++ b/src/Monomer/Main/Platform.hs
@@ -133,7 +133,7 @@ initSDLWindow config = do
       SDL.glDepthPrecision = 24,
       SDL.glStencilPrecision = 8,
       --SDL.glProfile = SDL.Core SDL.Debug 3 2,
-      SDL.glProfile = SDL.Core SDL.Normal 3 2,
+      SDL.glProfile = SDL.Compatibility SDL.Normal 3 2,
       SDL.glMultisampleSamples = 1
     }
 

In the long term this is not a viable solution because eventually these functions will be removed, and gloss will thus need to be rewritten at some point to use the retained rendering pipeline. However in the short term, until we have such a rewrite, this change would allow easily integrating things like gloss in its current state (my widget ended up being like 50 lines of code).

[meejah]

@mniip have you put the code for your widget anywhere?

[mniip]

@meejah

{- cabal:
build-depends: base, data-default, OpenGL, GLUT, monomer, gloss-rendering
-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module GlossWidget (glossWidget) where

import Control.Exception
import Control.Monad
import Data.Default
import Data.Typeable
import qualified Graphics.Gloss.Rendering as Gloss
import qualified Graphics.Rendering.OpenGL.GL as GL
import qualified Graphics.UI.GLUT as GLUT
import Monomer
import Monomer.Widgets.Single
import System.IO.Unsafe

glossWidget :: ((Float, Float) -> Gloss.Picture) -> WidgetNode s e
glossWidget mkPicture = defaultWidgetNode "gloss" $ makeGlossWidget mkPicture $ GlossState Nothing

newtype GlossState = GlossState (Maybe Gloss.State)

globalGlossState :: Gloss.State
globalGlossState = unsafePerformIO $ do
  void $ GLUT.getArgsAndInitialize
  Gloss.initState
{-# NOINLINE globalGlossState #-}

newtype GlossInitialized = GlossInitialized Gloss.State

makeGlossWidget :: ((Float, Float) -> Gloss.Picture) -> GlossState -> Widget s e
makeGlossWidget mkPicture state = createSingle state def
  { singleInit = \_env node -> resultReqs node
    [ RunInRenderThread (_wniWidgetId $ _wnInfo node) (_wniPath $ _wnInfo node) $ do
      GlossInitialized <$> evaluate globalGlossState
    ]
  , singleMerge = \_env node _oldNode oldState -> resultNode node
    { _wnWidget = makeGlossWidget mkPicture oldState
    }
  , singleHandleMessage = \_env node _target msg -> if
    | Just (GlossInitialized gls) <- cast msg
    , node' <- node { _wnWidget = makeGlossWidget mkPicture $ GlossState $ Just gls }
    -> Just $ resultReqs node' [RenderOnce]
    | otherwise -> Nothing
  , singleGetSizeReq = \_env _node -> (expandSize 100 1, expandSize 100 1)
  , singleRender = \env node renderer -> case state of
    GlossState Nothing -> pure ()
    GlossState (Just gls) -> do
      let
        viewPort = _wniViewport $ _wnInfo node
        winSize = _weWindowSize env
        offset = _weOffset env
      forM_ (_weViewport env `intersectRects` viewPort) $ \scViewPort -> createRawTask renderer $ do
        GL.matrixMode GL.$= GL.Projection
        GL.loadIdentity
        GL.scissor GL.$= Just
          ( GL.Position (floor $ _rX scViewPort + _pX offset) (floor $ _sH winSize - _rY scViewPort - _pY offset - _rH scViewPort)
          , GL.Size (floor $ _rW scViewPort) (floor $ _rH scViewPort)
          )
        GL.ortho
          (realToFrac $ -(_pX offset) - _rX viewPort) (realToFrac $ _sW winSize - _pX offset - _rX viewPort)
          (realToFrac $ _pY offset + _rY viewPort + _rH viewPort - _sH winSize) (realToFrac $ _pY offset + _rY viewPort + _rH viewPort)
          0 100
        GL.matrixMode GL.$= GL.Modelview 0
        Gloss.renderPicture gls 1 $ mkPicture (realToFrac $ _rW viewPort, realToFrac $ _rH viewPort)
        GL.scissor GL.$= Nothing
  }

[YellowOnion]

NanoVG does vector graphics, it's what monomer uses under neath, I would consider moving to that or another library that isn't using 15 year old OpenGL, I ported my app to use GPipe when I hit performance bottlenecks in gloss one day.