diff --git a/Holostress.hs b/Holostress.hs new file mode 100644 index 0000000..eb64ab9 --- /dev/null +++ b/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 ()