Holostress: repro for lambdacube3d/lambdacube-gl#9

Holostress.hs

@@ -0,0 +1,62 @@
+{-# 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.PangoCairo.Functions           as GIPC
+import           Linear
+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
+
+-- Local imports
+import Flatland
+import HoloCanvas
+import HoloCube
+import HoloSettings
+import WindowSys
+
+main ∷ IO ()
+main = do
+  stts        ← defaultSettings
+  win         ← makeGLWindow "holotype"
+  (Renderer{..}, stream)
+              ← makeSimpleRenderedStream win (("canvasStream", "canvasMtl") ∷ (ObjArrayNameS, UniformNameS))
+  let loop = do
+        _ ← cassemble stts stream
+        loop
+  loop
+cassemble ∷ Settings 'PU → ObjectStream -> IO ()
+cassemble Settings{..} ObjectStream{..}  = do
+  let (Di (V2 w h)) = fmap ceiling (di 1 1)
+  dSurface      ← GRC.createImageSurface GRC.FormatARGB32 w h
+  dGRC          ← GRC.create dSurface
+  dGIC          ← grcToGIC dGRC
+  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
+  pure ()