Implement Colored Triangle

examples/simple-triangle/Main.hs

@@ -63,6 +63,14 @@ triangleVertices =
   , Sin $ vec3 (-0.5) 0.5 1
   ]
 
+-- We also fail to use Vec2 here because of alignment issues
+triangleVerticesWithColors :: [Vertex '[Vec3, Vec3]]
+triangleVerticesWithColors =
+  [ vec3 0 (-0.5)   1 :&: vec3 1 0 0
+  , vec3 0.5 0.5    1 :&: vec3 0 1 0
+  , vec3 (-0.5) 0.5 1 :&: vec3 0 0 1
+  ]
+
 gameLoop :: RenderQueue () ⊸ Core (RenderQueue ())
 gameLoop rq = Linear.do
  should_close <- (shouldCloseWindow ↑)
@@ -77,19 +85,36 @@ main :: Prelude.IO ()
 main = do
  withLinearIO $
   runCore (640, 480) Linear.do
-    pipeline             <- (makeRenderPipeline shaderPipeline GHNil ↑)
-    (emptyMat, pipeline) <- (material GHNil pipeline ↑)
-    (mesh, pipeline)     <- (createMeshWithIxs pipeline GHNil triangleVertices [0, 1, 2] ↑)
-    (rq, Ur pkey)        <- pure (insertPipeline pipeline LMon.mempty)
-    (rq, Ur mkey)        <- pure (insertMaterial pkey emptyMat rq)
-    (rq, Ur mshkey)      <- pure (insertMesh mkey mesh rq)
 
-    rq <- gameLoop rq
+    -- Use the simple or colored Triangle?
+    let simple = False
+
+    if simple then Linear.do
+      pipeline      <- (makeRenderPipeline shaderPipelineSimple GHNil ↑)
+      (emptyMat, pipeline) <- (material GHNil pipeline ↑)
+      (mesh, pipeline) <- (createMesh pipeline GHNil triangleVertices ↑)
+      (rq, Ur pkey)        <- pure (insertPipeline pipeline LMon.mempty)
+      (rq, Ur mkey)        <- pure (insertMaterial pkey emptyMat rq)
+      (rq, Ur mshkey)      <- pure (insertMesh mkey mesh rq)
+
+      rq <- gameLoop rq
+
+      (freeRenderQueue rq ↑)
+
+    else Linear.do
+
+      pipeline  <- (makeRenderPipeline shaderPipelineColors GHNil ↑)
+      (emptyMat, pipeline) <- (material GHNil pipeline ↑)
+      (mesh, pipeline) <- (createMeshWithIxs pipeline GHNil triangleVerticesWithColors [0, 1, 2] ↑)
+      (rq, Ur pkey)    <- pure (insertPipeline pipeline LMon.mempty)
+      (rq, Ur mkey)    <- pure (insertMaterial pkey emptyMat rq)
+      (rq, Ur mshkey)  <- pure (insertMesh mkey mesh rq)
 
-    (freeRenderQueue rq ↑)
+      rq <- gameLoop rq
 
-    -- In fact, freeing these again is a type error. Woho!
-    -- (destroyRenderPipeline pipeline ↑)
+      (freeRenderQueue rq ↑)
+      -- In fact, freeing these again is a type error. Woho!
+      -- (destroyRenderPipeline pipeline ↑)
 
     return (Ur ())
 

examples/simple-triangle/Shaders.hs

@@ -48,37 +48,61 @@ import qualified Ghengin.Core.Shader as G
 import Common.Shader
 
 --------------------------------------------------------------------------------
--- * Vertex Shader
+-- * Simple Triangle Shader
 --------------------------------------------------------------------------------
 
+type VertexInput
+  = '[ Slot 0 0 ':-> V 3 Float ]
+
+shaderPipelineSimple :: G.ShaderPipeline _
+shaderPipelineSimple
+  = G.ShaderPipeline (StructInput @VertexInput @(Triangle List))
+  G.:>-> vertexSimple
+  G.:>-> fragmentSimple
+
 -- ROMES:TODO: If this were V 3 Float, why don't we get an error? Shouldn't 'Input' 'Location' match 'Slot's?
 type VertexDefs =
-  '[ "in_position"  ':-> Input      '[ Location 0 ] (V 2 Float)
+  '[ "in_position"  ':-> Input      '[ Location 0 ] (V 3 Float)
    ]
 
-type VertexInput
-  = '[ Slot 0 0 ':-> V 2 Float ]
-
-vertex :: G.VertexShaderModule VertexDefs _
-vertex = shader do
-    ~(Vec2 x y) <- get @"in_position"
+vertexSimple :: G.VertexShaderModule VertexDefs _
+vertexSimple = shader do
+    ~(Vec3 x y _) <- get @"in_position"
     put @"gl_Position" (Vec4 x y 0 1)
 
---------------------------------------------------------------------------------
--- * Fragment Shader
---------------------------------------------------------------------------------
-
-fragment :: G.FragmentShaderModule '[] _
-fragment = shader do
+fragmentSimple :: G.FragmentShaderModule '[] _
+fragmentSimple = shader do
   #out_colour .= Vec4 1 0 0 1
 
 --------------------------------------------------------------------------------
--- * Pipeline
+-- * Colored Triangle Shader
 --------------------------------------------------------------------------------
 
-shaderPipeline :: G.ShaderPipeline _
-shaderPipeline
-  = G.ShaderPipeline (StructInput @VertexInput @(Triangle List))
-  G.:>-> vertex
-  G.:>-> fragment
+type VertexInputColors
+  = '[ Slot 0 0 ':-> V 3 Float
+     , Slot 1 0 ':-> V 3 Float ]
+
+shaderPipelineColors :: G.ShaderPipeline _
+shaderPipelineColors
+  = G.ShaderPipeline (StructInput @VertexInputColors @(Triangle List))
+  G.:>-> vertexColor
+  G.:>-> fragmentColor
+
+type VertexDefsColors =
+  '[ "in_position"  ':-> Input      '[ Location 0 ] (V 3 Float)
+   , "in_color"     ':-> Input      '[ Location 1 ] (V 3 Float)
+   , "frag_color"   ':-> Output     '[ Location 0 ] (V 3 Float)
+   ]
+
+vertexColor :: G.VertexShaderModule VertexDefsColors _
+vertexColor = shader do
+    ~(Vec3 x y _) <- get @"in_position"
+    color <- get @"in_color"
+    put @"gl_Position" (Vec4 x y 0 1)
+    put @"frag_color" color
+
+fragmentColor :: G.FragmentShaderModule '["in_color" ':-> Input '[Location 0] (V 3 Float)] _
+fragmentColor = shader do
+  ~(Vec3 r g b) <- #in_color
+  #out_colour .= Vec4 r g b 1