packages feed

nanovg-simple (empty) → 0.4.0.0

raw patch · 12 files changed

+727/−0 lines, 12 filesdep +GLFW-bdep +OpenGLdep +basesetup-changed

Dependencies added: GLFW-b, OpenGL, base, monad-loops, nanovg, nanovg-simple, safe-exceptions, text, time

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Cthulhu (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Cthulhu nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,30 @@+# nanovg-simple++Simple interface to creating window with associated NanoVG context. See+[nanovg.h](https://github.com/memononen/nanovg/blob/master/src/nanovg.h) for comprehensive listing of methods.++Refer to `Graphics.NanoVG.Simple` module for utilities to create NanoVG window. Simple example:++```haskell+import           Graphics.NanoVG.Simple+import qualified NanoVG as NVG++main :: IO ()+main = run 800 600 "Simple app" $ simpleWindow $+  NVG.circle ctx 10 10 10 *> NVG.fill ctx+```++Also provided is wrapper for rendering combination of composable picture pieces: see `Graphics.NanoVG.Picture`.++```haskell+import           Graphics.NanoVG.Picture+import           Graphics.NanoVG.Simple+import qualified NanoVG as NVG++main :: IO ()+main = run 800 600 "Simple app" $ asWindow $+  pure $ translateP 50 0 $ pictures+    [ fill (NVG.Color 1 1 1 1) $ circle (10, 10) 10+    , stroke (NVG.Color 1 1 1 1) $ circle (10, 10) 15+    ]+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Time.Clock.POSIX+import qualified Graphics.NanoVG.Simple as NS+import qualified Graphics.NanoVG.Picture as P+import qualified NanoVG as NVG++main :: IO ()+main = do+  start <- getPOSIXTime+  NS.run 800 600 "nanovg Playground" $+    NS.showFPS "Liberation Sans" $+    NS.loadFont "/usr/share/fonts/truetype/liberation/LiberationSans-Regular.ttf" "Liberation Sans" $+    P.asWindow $ getPOSIXTime >>= \time -> pure $+      P.rotateP (400, 300) (realToFrac $ time - start) $+      P.scaleP' (0, 0) 10 $+        P.pictures+          [ P.translateP (12 * (x+1)) (12 * (y+1)) myRing+          | x <- [0..4]+          , y <- [0..3]+          ]+  where+    myRing = P.fill (NVG.Color 1 0 0 1) $ P.shapes+      [ P.circle (0, 0) 4+      , P.hole $ P.circle (0, 0) 3+      ]
+ cbits/glew.c view
@@ -0,0 +1,19 @@+#if !defined(darwin_HOST_OS)+#include <GL/glew.h>+#include <stdio.h>+/* #include "nanovg.h" */+/* #include "math.h" */++void initGlew() {+  glewExperimental = GL_TRUE;+  if(glewInit() != GLEW_OK) {+    printf("Could not init glew.\n");+    /* return -1; */+  }+}++#else+void initGlew() {+  // This space intentionally left blank.+}+#endif
+ nanovg-simple.cabal view
@@ -0,0 +1,72 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.30.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 22f7fc580e230609358f61cb4760e5977eac5580c4ad6cc72bbee6ccda151a2b++name:           nanovg-simple+version:        0.4.0.0+synopsis:       Simple interface to rendering with NanoVG+description:    Please see the README on GitHub at <https://github.com/CthulhuDen/nanovg-simple#readme>+category:       Graphics+homepage:       https://github.com/CthulhuDen/nanovg-simple#readme+bug-reports:    https://github.com/CthulhuDen/nanovg-simple/issues+author:         Cthulhu+maintainer:     cthulhu.den@gmail.com+copyright:      Cthulhu (c) 2018+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/CthulhuDen/nanovg-simple++flag library-only+  manual: False+  default: True++library+  exposed-modules:+      Graphics.NanoVG.Simple+      Graphics.NanoVG.Picture+  other-modules:+      Graphics.NanoVG.Fonts+      Graphics.NanoVG.FPS+      Graphics.NanoVG.FrameSize+      Graphics.NanoVG.Window+      Paths_nanovg_simple+  hs-source-dirs:+      src+  ghc-options: -Wall+  c-sources:+      cbits/glew.c+  build-depends:+      GLFW-b >=3.2.1.0 && <3.3+    , OpenGL >=3.0.2.2 && <3.1+    , base >=4.7 && <5+    , monad-loops >=0.4.3 && <0.5+    , nanovg >=0.6.0.0 && <0.7+    , safe-exceptions >=0.1.7.0 && <0.2+    , text >=1.2.3.0 && <1.3+  default-language: Haskell2010++executable nanovg-simple+  main-is: Main.hs+  other-modules:+      Paths_nanovg_simple+  hs-source-dirs:+      app+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N1+  build-depends:+      base >=4.7 && <5+    , nanovg >=0.6.0.0 && <0.7+    , nanovg-simple+    , time >=1.8.0.2 && <1.10+  if flag(library-only)+    buildable: False+  default-language: Haskell2010
+ src/Graphics/NanoVG/FPS.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE RecordWildCards #-}++module Graphics.NanoVG.FPS+  ( showFPS+  ) where++import Data.IORef+import qualified Data.Text as T+import Prelude hiding (init)++import qualified Graphics.UI.GLFW as GLFW+import           Graphics.NanoVG.Window+import qualified NanoVG as NVG++data State = State+  { timeStart       :: !Double+  , frameTotal      :: !Int+  , fpsTotal        :: !Double++  , intervalStart   :: !Double+  , frameInterval   :: !Int+  , fpsLastInterval :: !(Maybe Int)+  }++data Data = Data+  { fontAlias :: !T.Text+  , stRef :: !(IORef State)+  }++-- | This middleware shows FPS counter in top left corner of the window.+showFPS+  :: T.Text+  -- ^ Alias of the font to render text with. Refer to 'Graphics.NanoVG.Simple.loadFont' for more+  -> MiddleWare a (Data, a)+showFPS fontAlias Window {..} = Window+  { winInit = \ctx -> do+      Just time <- GLFW.getTime+      (,) <$> init fontAlias time <*> winInit ctx+  , winRender = \(d, st) ctx ->+      winRender st ctx *> render ctx d+  , winAfterRender = \(d, st) ctx -> do+      Just time <- GLFW.getTime+      update time d *> winAfterRender st ctx+  }++init :: T.Text -> Double -> IO Data+init fontAlias timeStart = do+  let frameTotal = 0+      fpsTotal = 0+      intervalStart = timeStart+      frameInterval = 0+      fpsLastInterval = Nothing+  stRef <- newIORef State {..}+  pure Data {..}++render :: NVG.Context -> Data -> IO ()+render ctx Data {..} = do+  st <- readIORef stRef++  NVG.fontFace ctx fontAlias+  NVG.fontSize ctx 16+  NVG.fillColor ctx $ NVG.Color 0 1 0 1+  NVG.text ctx 30 30 $ "FPS: " <> maybe "TBD" (T.pack . show) (fpsLastInterval st)++update :: Double -> Data -> IO ()+update t Data {..} =+  modifyIORef' stRef $ \st ->+    let st' = if t - intervalStart st > 1+                 then st { fpsLastInterval = Just (frameInterval st - 1)+                         , frameInterval = 1+                         , intervalStart = t+                         }+                 else st { frameInterval = frameInterval st + 1+                         }+    in st' { frameTotal = frameTotal st + 1+           , fpsTotal = fromIntegral (frameTotal st + 1) / (t - timeStart st)+           }
+ src/Graphics/NanoVG/Fonts.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++module Graphics.NanoVG.Fonts+  ( loadFont+  ) where++import Control.Monad+import Data.Text (Text)+import Graphics.NanoVG.Window+import qualified NanoVG as NVG++-- | Load font from of the supported file formats and store it under given alias for further use.+loadFont+  :: Text+  -- ^ File path to load font from. Font is loaded with freetype2 so refer to it's documentation for allowed formats.+  -> Text+  -- ^ Alias which can later be used to refer to the loaded font.+  -> MiddleWare a a+loadFont file alias Window {..} = Window+  { winInit = \ctx -> do+      void $ NVG.createFont ctx alias $ NVG.FileName file+      winInit ctx+  , winRender = winRender+  , winAfterRender = winAfterRender+  }
+ src/Graphics/NanoVG/FrameSize.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE RecordWildCards #-}++module Graphics.NanoVG.FrameSize+  ( Data+  , init+  , size+  ) where++import Data.Functor+import Data.IORef+import Prelude hiding (init)++import           Graphics.Rendering.OpenGL.GL (($=))+import qualified Graphics.Rendering.OpenGL.GL as GL+import qualified Graphics.UI.GLFW as GLFW++data State = State+  { width :: !Int+  , height :: !Int+  }++type Data = IORef State++init :: GLFW.Window -> IO Data+init win = do+  stRef <- do+    (width, height) <- GLFW.getFramebufferSize win+    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral width) (fromIntegral height))+    newIORef State {..}++  GLFW.setFramebufferSizeCallback win $ Just $ \_ width height -> do+    writeIORef stRef State {..}+    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral width) (fromIntegral height))+  pure stRef++size :: Data -> IO (Int, Int)+size stRef = readIORef stRef <&> \State {..} -> (width, height)
+ src/Graphics/NanoVG/Picture.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE LambdaCase #-}+-- | Description: Rendering composable picture fragments+-- The module was originally inspired by gloss Picture data type.+--+-- It allows you to define simple pieces, combine and move\/rotate\/scale them+-- to produce the final image.+--+-- Example of composite picture (filled circle inside stroked one, both moved to the side by 50 pixels):+--+-- @+-- translateP 50 0 $ pictures+--   [ fill (NVG.Color 1 1 1 1) $ circle (10, 10) 10+--   , stroke (NVG.Color 1 1 1 1) $ circle (10, 10) 15+--   ]+-- @+module Graphics.NanoVG.Picture+  ( -- * Shapes+    Shape (..)++    -- ** Helper type aliases+  , Radius+  , Point+  , Center+  , Angle++    -- ** Predefined Constructors+  , circle+  , line+  , rectangle+  , arc+  , shapes+  , translateS+  , rotateS+  , scaleS+  , scaleS'+  , scaleSx+  , scaleSy+  , hole++    -- * Pictures+  , Picture++  , mapShape++    -- * Contstructors++    -- | Pictures are generally constructed by filling or stroking shape+    -- or by transforming exising picture.++  , stroke+  , fill+  , pictures+  , translateP+  , rotateP+  , scaleP+  , scaleP'+  , scalePx+  , scalePy++    -- * Rendering+  , render++    -- * Rendering as 'Window'+  , asWindow+  ) where++import Control.Exception.Safe+import Data.Foldable+import Graphics.NanoVG.Window (Window (..))+import qualified NanoVG as NVG++-- | Radius of a circle or an arc.+type Radius = Float++-- | Point on 2D plane.+type Point = (Float, Float)++-- | Point representing center of circle, arc, rotation or scale.+type Center = Point++-- | Angle of rotation, arc, etc.+type Angle = Float++-- | Shape of a future picture fragment, to be filled or stroked later.+-- Action should define set of paths for the passed 'NVG.Context'.+newtype Shape = Shape+  { unShape :: NVG.Context -> IO ()+  }++-- | Saves NanoVG state, applies modifications (first argument),+-- runs actions (second argument) and restores state.+-- TODO expose?+withState :: NVG.Context -> IO () -> IO () -> IO ()+withState ctx t = bracket_ (NVG.save ctx *> t) (NVG.restore ctx)++-- | Make circular shape.+circle :: Center -> Radius -> Shape+circle (x, y) r = Shape $ \ctx -> NVG.circle ctx (realToFrac x) (realToFrac y) (realToFrac r)++-- | Make line shape.+line :: Point -> Point -> Shape+line (ax, ay) (bx, by) = Shape $ \ctx -> do+  NVG.moveTo ctx (realToFrac ax) (realToFrac ay)+  NVG.lineTo ctx (realToFrac bx) (realToFrac by)++-- | Make rectangular shape given two (opposite) corners positions.+rectangle :: Point -> Point -> Shape+rectangle (ax, ay) (bx, by) = Shape $ \ctx ->+  NVG.rect ctx (realToFrac $ min ax bx) (realToFrac $ min ay by)+               (realToFrac $ abs $ ax - bx) (realToFrac $ abs $ ay - by)++-- | Make arc shape with given center and going counter-clockwise+-- from first angle to the second.+arc :: Center -> Radius -> Angle -> Angle -> Shape+arc (x, y) r a0 a1 = Shape $ \ctx ->+  NVG.arc ctx (realToFrac x) (realToFrac y) (realToFrac r) (realToFrac a0) (realToFrac a1) NVG.CCW++-- | Combine multiple shapes together.+shapes :: [Shape] -> Shape+shapes ss = Shape $ \ctx -> traverse_ (`unShape` ctx) ss++-- | Translate shape by given @x@ and @y@ offsets.+translateS :: Float -> Float -> Shape -> Shape+translateS x y s = Shape $ \ctx ->+  withState ctx (NVG.translate ctx (realToFrac x) (realToFrac y)) $+    unShape s ctx++-- | Rotate shape around given point by given angle.+rotateS :: Center -> Angle -> Shape -> Shape+rotateS (x, y) a s = Shape $ \ctx ->+  withState ctx+    (NVG.translate ctx fx fy *>+     NVG.rotate ctx fa *>+     NVG.translate ctx (-fx) (-fy))+    (unShape s ctx)+  where+    (fx, fy, fa) = (realToFrac x, realToFrac y, realToFrac a)++-- | Scale shape from given point in given direction.+-- This is affine transformation+scaleS :: Center -> Angle -> Float -> Shape -> Shape+scaleS (x, y) a k s = Shape $ \ctx ->+  withState ctx+    (NVG.translate ctx fx fy *>+     NVG.rotate ctx fa *>+     NVG.scale ctx fk 1 *>+     NVG.rotate ctx (-fa) *>+     NVG.translate ctx (-(fx*fk)) (-fy))+    (unShape s ctx)+  where+    (fx, fy, fa, fk) = (realToFrac x, realToFrac y, realToFrac a, realToFrac k)++-- | Scale shape from given point in positive X direction+-- by given factor.+scaleSx :: Center -> Float -> Shape -> Shape+scaleSx (x, y) = scaleS (x, y) 0++-- | Scale shape from given point in positive Y direction+-- by given factor.+scaleSy :: Center -> Float -> Shape -> Shape+scaleSy (x, y) = scaleS (x, y) (pi/2)++-- | Scale shape from given point by given factor in every direction.+scaleS' :: Center -> Float -> Shape -> Shape+scaleS' c k = scaleSx c k . scaleSy c k++-- | Turns shape into a hole which can then be combined+-- with other (solid) shape. E.g.+--+-- > fill (Color 1 0 0 1) $ shapes [circle (0, 0) 40, hole $ circle (0, 0) 30]+--+-- can be used to create a ring of width 10.+hole :: Shape -> Shape+hole s = Shape $ \ctx -> do+  unShape s ctx+  NVG.pathWinding ctx $ fromIntegral $ fromEnum NVG.CW++-- | Picture represent collection of filled/stroked shapes+-- ready to be rendered+data Picture =+    Stroke NVG.Color Shape+  | Fill NVG.Color Shape+  | Pictures [Picture]++-- | Modify shape(s) the picture was based off.+mapShape :: (Shape -> Shape) -> Picture -> Picture+mapShape f = \case+  Stroke c s -> Stroke c $ f s+  Fill c s   -> Fill c $ f s+  Pictures ss  -> Pictures $ mapShape f <$> ss++-- | Translate the picture by given @x@ and @y@ offsets.+translateP :: Float -> Float -> Picture -> Picture+translateP x y = mapShape $ translateS x y++-- | Rotate the picture around given point for given angle.+rotateP :: Center -> Angle -> Picture -> Picture+rotateP c a = mapShape $ rotateS c a++-- | Scale picture from given point in given direction.+-- This is affine transformation+scaleP :: Center -> Angle -> Float -> Picture -> Picture+scaleP c a k = mapShape $ scaleS c a k++-- | Scale picture from given point in positive X direction+-- by given factor.+scalePx :: Center -> Float -> Picture -> Picture+scalePx c = scaleP c 0++-- | Scale picture from given point in positive Y direction+-- by given factor.+scalePy :: Center -> Float -> Picture -> Picture+scalePy c = scaleP c (pi/2)++-- | Scale picture from given point by given factor in every direction.+scaleP' :: Center -> Float -> Picture -> Picture+scaleP' c k = scalePx c k . scalePy c k++-- | Stroke the shape to create a picture.+stroke :: NVG.Color -> Shape -> Picture+stroke = Stroke++-- | Fill the shape to create a picture.+fill :: NVG.Color -> Shape -> Picture+fill = Fill++-- | Combine multiple pictures together.+pictures :: [Picture] -> Picture+pictures = Pictures++-- | Render picture with given NanoVG context.+render :: NVG.Context -> Picture -> IO ()+render ctx = \case+  Stroke col s -> do+    NVG.beginPath ctx+    withState ctx (NVG.strokeColor ctx col *> NVG.strokeWidth ctx 1) $+      unShape s ctx *> NVG.stroke ctx+  Fill col s -> do+    NVG.beginPath ctx+    withState ctx (NVG.fillColor ctx col) $+      unShape s ctx *> NVG.fill ctx+  Pictures ss ->+    traverse_ (render ctx) ss++-- | Create 'Window' which constantly queries and renders received picture.+asWindow :: IO Picture -> Window ()+asWindow g = Window+  { winInit = \_ -> pure ()+  , winRender = \_ ctx -> g >>= render ctx+  , winAfterRender = \_ _ -> pure ()+  }
+ src/Graphics/NanoVG/Simple.hs view
@@ -0,0 +1,27 @@+-- | Description: Simple high-level context management interface for NanoVG with GLFW+-- Module provides utilities to create usable NanoVG contexts in GLFW windows.+module Graphics.NanoVG.Simple+  ( -- | Simple example:+    --+    -- @+    -- import           Graphics.NanoVG.Simple+    -- import qualified NanoVG as NVG+    --+    -- main :: IO ()+    -- main = run 800 600 "Simple app" $ simpleWindow $+    --   NVG.circle ctx 10 10 10 *> NVG.fill ctx+    -- @++    -- * Windows+    Window (..)+  , simpleWindow+  , run+    -- * Middlewares+  , MiddleWare+  , showFPS+  , loadFont+  ) where++import Graphics.NanoVG.Window+import Graphics.NanoVG.FPS+import Graphics.NanoVG.Fonts
+ src/Graphics/NanoVG/Window.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++module Graphics.NanoVG.Window+  ( Window (..)+  , simpleWindow+  , MiddleWare+  , run+  ) where++import           Control.Concurrent+import           Control.Exception.Safe+import           Control.Monad+import           Control.Monad.Loops+import           Foreign.C.Types+import           System.IO (hPutStrLn, stderr)++import qualified Graphics.Rendering.OpenGL as GL+import qualified Graphics.UI.GLFW as GLFW+import qualified NanoVG as NVG++import qualified Graphics.NanoVG.FrameSize as FS++foreign import ccall unsafe "initGlew"+  glewInit :: IO CInt++-- | Window keep state and repeatedly calls render/afterRender.+--+-- Invocation of 'winRender' action happens inside nanovg frame, so you can use+-- the provided context to render whatever you want. The buffers are cleared before+-- each frame.+--+-- There is no interface to update state directly so mutable containers should be used, if so desired.+data Window st = Window+  { winInit        :: !(NVG.Context -> IO st)+  , winRender      :: !(st -> NVG.Context -> IO ())+  , winAfterRender :: !(st -> NVG.Context -> IO ())+  }++-- | Create new window which does not need own persistent state.+simpleWindow :: (NVG.Context -> IO ()) -> Window ()+simpleWindow render = Window+  { winInit = const $ pure ()+  , winRender = const render+  , winAfterRender = \_ _ -> pure ()+  }++-- | Middleware adds some piece of functionality to existing window.+type MiddleWare st0 st = Window st0 -> Window st++-- | Run given rendering instructions ('Window' structure) in new GLFW window of given size and title.+--+-- __NOTE__: It is currently impossible to run multiple windows simultaneously in same application.+run+  :: Int+  -- ^ Initial window width.+  -> Int+  -- ^ Initial window height.+  -> String+  -- ^ Window title.+  -> Window st+  -- ^ Rendering instructions to be executed in the context of the new window.+  -> IO ()+run initWidth initHeight title Window {..} = withGLFW $+  createWindow initWidth initHeight title >>= go+  where+    go win = do+      GLFW.makeContextCurrent $ Just win+      void glewInit++      -- Leave it up to vblank_mode / __GL_SYNC_TO_VBLANK+      -- GLFW.swapInterval 0++      ctx <- NVG.createGL3 [NVG.Antialias, NVG.StencilStrokes, NVG.Debug]+      frameSize <- FS.init win++      st <- winInit ctx++      whileM_ (not <$> GLFW.windowShouldClose win) $ do+        throwError+        (width, height) <- FS.size frameSize++        GL.clear [GL.ColorBuffer, GL.StencilBuffer]+        runFrame ctx width height $ winRender st ctx+        GLFW.swapBuffers win+        GL.flush+        GLFW.pollEvents++        winAfterRender st ctx++    runFrame :: NVG.Context -> Int -> Int -> IO a -> IO a+    runFrame c w h act = NVG.beginFrame c (fromIntegral w) (fromIntegral h) 1 *> act <* NVG.endFrame c++throwError :: IO ()+throwError = do+  errs <- GL.errors+  case errs of+    err:_ ->+      throwString $ "OpenGL error: " <> show err+    _     ->+      pure ()+++createWindow :: Int -> Int -> String -> IO GLFW.Window+createWindow w h title = do+  GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 3+  GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 3+  GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core+  GLFW.windowHint $ GLFW.WindowHint'OpenGLDebugContext True+  Just win <- GLFW.createWindow w h title Nothing Nothing+  pure win+++-- | Do NOT try to nest calls!+-- TODO: use global flag (via unsafePerformIO) to seemlessly handle nesting.+withGLFW :: IO a -> IO a+withGLFW act = runInBoundThread $ do+  GLFW.setErrorCallback $ Just $ \err msg ->+    hPutStrLn stderr $ "GLFW error: " <> show err <> "\n" <> msg+  bracket_ (assertTrueM GLFW.init) GLFW.terminate act+  where+    assertTrueM predM = do+      True <- predM+      pure ()