diff --git a/cabal.project b/cabal.project index 43840d2..699d1cf 100644 --- a/cabal.project +++ b/cabal.project @@ -14,9 +14,9 @@ packages: -- ~/Developer/fir/ -- ~/Developer/gl-block/ -profiling: true -package * - profiling-detail: late +-- profiling: true +-- package * +-- profiling-detail: late package ghengin-core flags: +enable-culling diff --git a/examples/simple-camera/Main.hs b/examples/simple-camera/Main.hs index 130286e..25c6e72 100644 --- a/examples/simple-camera/Main.hs +++ b/examples/simple-camera/Main.hs @@ -7,6 +7,7 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} module Main where +import qualified Prelude import GHC.Generics import Geomancy.Vec3 import Geomancy.Mat4 @@ -28,68 +29,11 @@ import qualified Prelude import qualified Math.Linear as FIR import qualified FIR +import Game.Geometry.Cube (coloredCube) import Shaders type CubeMesh = Mesh '[Vec3, Vec3] '[Transform] -cubeVertices :: [Vertex '[Vec3, Vec3]] -cubeVertices = [ - - -- left face (white) - vec3 (-0.5) (-0.5) (-0.5) :&: white, - vec3 (-0.5) (-0.5) (0.5) :&: white, - vec3 (-0.5) (0.5) (0.5) :&: white, - vec3 (-0.5) (0.5) (0.5) :&: white, - vec3 (-0.5) (0.5) (-0.5) :&: white, - vec3 (-0.5) (-0.5) (-0.5) :&: white, - - -- right face (yellow) - vec3 (-0.5) (-0.5) (-0.5) :&: yellow, - vec3 0.5 (0.5) (-0.5) :&: yellow, - vec3 0.5 (-0.5) (-0.5) :&: yellow, - vec3 (-0.5) (-0.5) (-0.5) :&: yellow, - vec3 (-0.5) (0.5) (-0.5) :&: yellow, - vec3 0.5 (0.5) (-0.5) :&: yellow, - - -- top face (orange, remember y axis points down) - vec3 (-0.5) (-0.5) (-0.5) :&: orange, - vec3 (0.5) (-0.5) (-0.5) :&: orange, - vec3 (0.5) (-0.5) (0.5) :&: orange, - vec3 (-0.5) (-0.5) (-0.5) :&: orange, - vec3 (0.5) (-0.5) (0.5) :&: orange, - vec3 (-0.5) (-0.5) (0.5) :&: orange, - - -- bottom face (red) - vec3 (-0.5) (0.5) (-0.5) :&: red, - vec3 (-0.5) (0.5) (0.5) :&: red, - vec3 (0.5) (0.5) (0.5) :&: red, - vec3 (-0.5) (0.5) (-0.5) :&: red, - vec3 (0.5) (0.5) (0.5) :&: red, - vec3 (0.5) (0.5) (-0.5) :&: red, - - -- nose face (blue) - vec3 (0.5) (0.5) (-0.5) :&: blue, - vec3 (0.5) (0.5) (0.5) :&: blue, - vec3 (0.5) (-0.5) (0.5) :&: blue, - vec3 (0.5) (-0.5) (0.5) :&: blue, - vec3 (0.5) (-0.5) (-0.5) :&: blue, - vec3 (0.5) (0.5) (-0.5) :&: blue, - - -- tail face (green) - vec3 (-0.5) (0.5) (0.5) :&: green, - vec3 (-0.5) (-0.5) (0.5) :&: green, - vec3 (0.5) (0.5) (0.5) :&: green, - vec3 (-0.5) (-0.5) (0.5) :&: green, - vec3 (0.5) (-0.5) (0.5) :&: green, - vec3 (0.5) (0.5) (0.5) :&: green] - where - white = vec3 0.9 0.9 0.9 - yellow = vec3 0.8 0.8 0.1 - orange = vec3 0.9 0.6 0.1 - red = vec3 0.8 0.1 0.1 - blue = vec3 0.1 0.1 0.8 - green = vec3 0.1 0.8 0.1 - data Camera = Camera { view :: Mat4 , proj :: Mat4 @@ -128,7 +72,7 @@ main = do pipeline <- (makeRenderPipeline shaderPipeline (StaticBinding (Ur defaultCamera) :## GHNil) ↑) (emptyMat, pipeline) <- (material GHNil pipeline ↑) (mesh :: CubeMesh, pipeline) <- - (createMesh pipeline (DynamicBinding (Ur (rotateY (pi/4))) :## GHNil) cubeVertices ↑) + (createMesh pipeline (DynamicBinding (Ur (rotateY (pi/4))) :## GHNil) coloredCube ↑) (rq, Ur pkey) <- pure (insertPipeline pipeline LMon.mempty) (rq, Ur mkey) <- pure (insertMaterial pkey emptyMat rq) (rq, Ur mshkey) <- pure (insertMesh mkey mesh rq) diff --git a/examples/simple-camera/Shaders.hs b/examples/simple-camera/Shaders.hs index a734bdd..ff47b36 100644 --- a/examples/simple-camera/Shaders.hs +++ b/examples/simple-camera/Shaders.hs @@ -36,8 +36,8 @@ shaderPipeline G.:>-> fragment type VertexDefs = - '[ "in_position" ':-> Input '[ Location 0 ] (V 3 Float) - , "in_color" ':-> Input '[ Location 1 ] (V 3 Float) + '[ "in_position" ':-> Input '[ Location 1 ] (V 3 Float) -- position comes after color (location=1) + , "in_color" ':-> Input '[ Location 0 ] (V 3 Float) -- color comes first (location=0) , "frag_color" ':-> Output '[ Location 0 ] (V 3 Float) , "model" ':-> Uniform '[ DescriptorSet 2, Binding 0 ] (Struct '[ "m" ':-> M 4 4 Float ]) , "camera" ':-> Uniform '[ DescriptorSet 0, Binding 0 ] diff --git a/ghengin-core/ghengin-vulkan/Ghengin/Vulkan/Renderer/Pipeline.hs b/ghengin-core/ghengin-vulkan/Ghengin/Vulkan/Renderer/Pipeline.hs index 5f23833..0b70dfc 100644 --- a/ghengin-core/ghengin-vulkan/Ghengin/Vulkan/Renderer/Pipeline.hs +++ b/ghengin-core/ghengin-vulkan/Ghengin/Vulkan/Renderer/Pipeline.hs @@ -187,7 +187,7 @@ createGraphicsPipeline ppstages pushConstantRanges = Unsafe.toLinearN @2 \render , cullMode = Vk.CULL_MODE_NONE #endif - , frontFace = Vk.FRONT_FACE_COUNTER_CLOCKWISE -- Default vertice front face to be defined clock wise + , frontFace = Vk.FRONT_FACE_COUNTER_CLOCKWISE -- Default vertice front face to be defined counter clock wise -- , frontFace = Vk.FRONT_FACE_CLOCKWISE , depthBiasEnable = False -- Biasing depth values based on a fragment's slope (could be used for shadow mapping) , depthBiasConstantFactor = 0 diff --git a/ghengin/ghengin-geometry/Game/Geometry/Cube.hs b/ghengin/ghengin-geometry/Game/Geometry/Cube.hs new file mode 100644 index 0000000..c89f31f --- /dev/null +++ b/ghengin/ghengin-geometry/Game/Geometry/Cube.hs @@ -0,0 +1,68 @@ +-- | +-- +-- Assumptions: +-- +-- * Using a cartesian coordinate space XYZ where Y points "up" and Z points "outwards": +-- ZX is parallel to the floor/ceiling, YX is parallel to the screen, YZ is +-- perpendicular to the screen... +-- +-- * Using triangle list primitive topology +-- +-- * Using COUNTER_CLOCKWISE order for front facing triangles +module Game.Geometry.Cube where + +import Prelude -- We often don't need linearity here. +import Ghengin.Core.Mesh.Vertex +import Game.Geometry.Transform + +-- | A unit cube centered at (0,0,0). +cube :: [Vertex '[Vec3]] +cube = concatMap (`transform` square) + [ translateV (vec3 0 0 (-0.5)) -- front face + , rotateY pi <> translateV (vec3 0 0 0.5 ) -- back face + , rotateY (pi/2) <> translateV (vec3 0.5 0 0 ) -- right face + , rotateY (-pi/2) <> translateV (vec3 (-0.5) 0 0 ) -- left face + , rotateX (-pi/2) <> translateV (vec3 0 0.5 0 ) -- top face + , rotateX (pi/2) <> translateV (vec3 0 (-0.5) 0 ) -- bottom face + ] + -- recall, matrix mult MVP order on CPU + + +-- | A unit square centered at (0,0,0) along the YZ plane with its front side +-- normal along the X coordinate axis (ie "facing forward"). +square :: [Vertex '[Vec3]] +square = Prelude.map Sin + [ vec3 0.5 0.5 0 -- 1,6 + , vec3 0.5 (-0.5) 0 -- 2 + , vec3 (-0.5) (-0.5) 0 -- 3,4 + , vec3 (-0.5) (-0.5) 0 -- 3,4 + , vec3 (-0.5) 0.5 0 -- 5 + , vec3 0.5 0.5 0 -- 1,6 + ] + +-------------------------------------------------------------------------------- +-- * Colored + +type Color = Vec3 + +-- | A colored 'cube'. +-- Note that color is in location=0, and position in location=1 +coloredCube :: [Vertex '[Color, Vec3]] +coloredCube = zipWith paint cube [1..] where + paint face (ix::Int) + -- every six vertices we get a new face + | ix <= 6 = blue :& face + | ix <= 6*2 = green :& face + | ix <= 6*3 = yellow :& face + | ix <= 6*4 = white :& face + | ix <= 6*5 = orange :& face + | ix <= 6*6 = red :& face + | otherwise = error "unexpected vertice unit cube" + + white = vec3 0.9 0.9 0.9 + yellow = vec3 0.8 0.8 0.1 + orange = vec3 0.9 0.6 0.1 + red = vec3 0.8 0.1 0.1 + blue = vec3 0.1 0.1 0.8 + green = vec3 0.1 0.8 0.1 + diff --git a/ghengin/ghengin-geometry/Game/Geometry/Sphere.hs b/ghengin/ghengin-geometry/Game/Geometry/Sphere.hs index db2979e..35829d6 100644 --- a/ghengin/ghengin-geometry/Game/Geometry/Sphere.hs +++ b/ghengin/ghengin-geometry/Game/Geometry/Sphere.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-name-shadowing -Wno-incomplete-uni-patterns #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BlockArguments #-} @@ -18,7 +19,6 @@ import qualified Data.Vector.Storable as SV import qualified Data.IntMap as IM import qualified Data.Map as M -import Data.Foldable (foldl') import Data.List (sort) import Data.List.Split (chunksOf) diff --git a/ghengin/ghengin-geometry/Game/Geometry/Transform.hs b/ghengin/ghengin-geometry/Game/Geometry/Transform.hs new file mode 100644 index 0000000..a57d3c9 --- /dev/null +++ b/ghengin/ghengin-geometry/Game/Geometry/Transform.hs @@ -0,0 +1,20 @@ +module Game.Geometry.Transform + ( transform + , module Geomancy.Transform + , module Geomancy.Vec3 + ) + where + +import Ghengin.Core.Mesh.Vertex +import Geomancy.Vec3 +import Geomancy.Transform + +-- | Transform a list of vertices. +-- Use with functions re-exported from Geomancy.Transform +-- +-- Recall, from Geomancy's documentation: +-- CPU-side matrices compose in MVP order, optimized for mconcat (local1 : local2 : ... : root) operation. +-- GPU-side, in GLSL, it is PVM * v. +transform :: Transform -> [Vertex '[Vec3]] -> [Vertex '[Vec3]] +transform tr vs = [ Sin (v `apply` tr) | Sin v <- vs ] + diff --git a/ghengin/ghengin.cabal b/ghengin/ghengin.cabal index 2ca2ee9..b23ad9d 100644 --- a/ghengin/ghengin.cabal +++ b/ghengin/ghengin.cabal @@ -226,7 +226,8 @@ library camera library geometry import: common-flags visibility: public - exposed-modules: Game.Geometry, Game.Geometry.Sphere + exposed-modules: Game.Geometry, Game.Geometry.Sphere, Game.Geometry.Cube, + Game.Geometry.Transform build-depends: base >=4.19.0.0, ghengin-core:backend-independent-bits, ghengin-core, vector, containers, split, geomancy hs-source-dirs: ghengin-geometry default-language: GHC2021 diff --git a/utils/live b/utils/live index 54b1c29..90d0348 100755 --- a/utils/live +++ b/utils/live @@ -2,4 +2,3 @@ ghcid --test "Main.main" --command "cabal repl --semaphore --ghc-options=-fno-ghci-sandbox $@" -