Holostress: repro for lambdacube3d/lambdacube-gl#9

Holostress.hs

@@ -0,0 +1,57 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+import           Prelude                           hiding ((.), id)
+import "GLFW-b"  Graphics.UI.GLFW                  as GLFW
+import qualified Graphics.Rendering.Cairo          as GRC
+import qualified Graphics.Rendering.Cairo.Internal as GRC (create)
+import qualified GI.Cairo                          as GIC
+import qualified Foreign.Ptr                       as F
+import qualified GI.PangoCairo.Functions           as GIPC
+import qualified LambdaCube.Linear                 as LCLin
+import           LambdaCube.Mesh                   as LC
+import qualified LambdaCube.GL.Mesh                as GL
+import qualified Data.Vector                       as V
+import qualified Data.Map                          as Map
+import qualified Graphics.Rendering.Cairo.Types    as GRC
+import qualified Data.GI.Base                      as GI
+
+-- Local imports
+import HoloCube
+import WindowSys
+
+main ∷ IO ()
+main = do
+  win         ← makeGLWindow "holotype"
+  (Renderer{..}, _)
+              ← makeSimpleRenderedStream win (("canvasStream", "canvasMtl") ∷ (ObjArrayNameS, UniformNameS))
+  let (w, h) = (1, 1)
+      loop = do
+        dSurface      ← GRC.createImageSurface GRC.FormatARGB32 w h
+        dGRC          ← GRC.create dSurface
+        dGIC          ← GIC.Context <$> GI.newManagedPtr (F.castPtr $ GRC.unCairo dGRC) (return ())
+        let (dx, dy) = (fromIntegral w, fromIntegral $ -h)
+            position = V.fromList [ LCLin.V2  0 dy,   LCLin.V2  0  0,   LCLin.V2 dx  0,   LCLin.V2  0 dy,   LCLin.V2 dx  0,   LCLin.V2 dx dy ]
+            texcoord = V.fromList [ LCLin.V2  0  1,   LCLin.V2  0  0,   LCLin.V2  1  0,   LCLin.V2  0  1,   LCLin.V2  1  0,   LCLin.V2  1  1 ]
+            dMesh    = LC.Mesh { mPrimitive  = P_Triangles
+                               , mAttributes = Map.fromList [ ("position",  A_V2F position)
+                                                            , ("uv",        A_V2F texcoord) ] }
+        GL.uploadMeshToGPU dMesh
+        GIPC.createContext dGIC
+        loop
+  loop