Merge pull request #21 from alt-romes/wip/romes/storable-vecs

Update createMesh functions to take Storable.Vector

Author: alt-romes

examples/planets-core/Planet.hs

@@ -13,17 +13,15 @@ import Ghengin.Core.Render.Pipeline
 import Ghengin.Core.Render.Property
 import Ghengin.Core.Material
 import Ghengin.Core.Type.Compatible
-import Data.List (foldl')
 import Ghengin.Core.Log
 
-import qualified Data.List.NonEmpty as NE
 import qualified Data.Vector as V
+import qualified Data.Vector.Storable as SV
 
 import Geomancy.Transform
 
 import Ghengin.Core
 import Ghengin.Core.Mesh
-import Geomancy (VectorSpace(..))
 import Geomancy.Vec3
 
 import Ghengin.Geometry.Sphere
@@ -83,13 +81,13 @@ newPlanetMesh rp Planet{..} = enterD "newPlanetMesh" $ Linear.do
   let UnitSphere us is = newUnitSphere resolution
 
       (planetPs, elevations)
-               = P.unzip $ P.map (\(p :&: _) -> pointOnPlanet planetShape p) us
-      planetNs = V.toList $ computeNormals (V.fromList (P.map fromIntegral is)) (V.fromList planetPs)
-      planetVs = P.zipWith (:&:) planetPs planetNs
+               = V.unzip $ V.map (\(p :&: _) -> pointOnPlanet planetShape p) (V.convert us)
+      planetNs = computeNormals (SV.map fromIntegral is) (V.convert planetPs)
+      planetVs = SV.zipWith (:&:) (V.convert planetPs) planetNs
 
       minmax = MinMax (P.minimum elevations) (P.maximum elevations)
 
-   in (, Ur minmax) <$> (createMeshWithIxs rp (DynamicBinding (Ur mempty) :## GHNil) planetVs is ↑)
+   in (, Ur minmax) <$> (createMeshWithIxsSV rp (DynamicBinding (Ur mempty) :## GHNil) planetVs is ↑)
 
 --------------------------------------------------------------------------------
 -- * Material

ghengin-core/ghengin-core-indep/Ghengin/Core/Mesh/Vertex.hs

@@ -50,6 +50,7 @@ infixr 6 :&
 pattern (:&:) :: v -> v' -> Vertex '[v, v']
 pattern (:&:) a b = a :& Sin b
 infixr 6 :&:
+{-# COMPLETE (:&:) #-}
 
 -- It is kind of precarious to copy over the generic implementation here.
 -- Would be better to implement Generic for Vertex, and derive generically Block.

ghengin-core/ghengin-core-indep/Ghengin/Core/Prelude.hs

@@ -27,6 +27,8 @@ module Ghengin.Core.Prelude
 
   -- vector
   , V.Vector
+  , toSV
+  , SVector
 
   -- reference-counting
   , Forgettable, Shareable
@@ -80,6 +82,7 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Vector as V
+import qualified Data.Vector.Storable as SV
 import qualified Data.V.Linear.Internal as VL
 import qualified Data.V.Linear.Internal.Instances ()
 
@@ -95,6 +98,18 @@ import Data.Linear.Alias as Alias
 
 import qualified Unsafe.Linear as Unsafe
 
+--------------------------------------------------------------------------------
+-- * Storable vector utils
+--------------------------------------------------------------------------------
+
+type SVector = SV.Vector
+
+-- | Convert a list in a storable vector. Useful when creating meshes from lists
+toSV :: SV.Storable a => [a] -> SV.Vector a
+toSV = SV.fromList
+
+--------------------------------------------------------------------------------
+
 -- Worry about performance of doing things safely later.
 -- For now, simply strive for correctness.
 
@@ -104,21 +119,17 @@ import qualified Unsafe.Linear as Unsafe
 {-# INLINE (<$$>) #-}
 (<$$>) = (Prelude.<$>)
 
+--------------------------------------------------------------------------------
+-- * Generic HList (aka "Product"), but this one is linear!
+--------------------------------------------------------------------------------
+
 -- | Generic HList
 -- Perhaps move to its own module?
 data GHList c xs where
     GHNil :: GHList c '[]
     (:##) :: c a ⊸ GHList c as ⊸ GHList c (a ': as)
 infixr 6 :##
 
-{-
-Note [Coerce HList to List]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-They have the same representation ^_^, so unsafeCoerce is safe ^_^
--}
-
--- GHList instances
-
 instance Consumable (GHList c '[]) where
   consume GHNil = ()
 
@@ -144,12 +155,7 @@ instance (∀ a. Shareable m (c a)) => Shareable m (GHList c as) where
     (as1, as2) <- Alias.share as
     pure (a1:##as1, a2:##as2)
 
--- TODO: Some special linear lenses to use propertyAt ... import Control.Lens ((^.), Lens', lens)
--- ROMES:TODO: For the lens to be used as a getter, I think we will need this definition of functor rather than the control one.
--- Otherwise, I think we can assume the lens is always over something which is
--- Consumable, (we only ever deal with properties which are consumable, btut I
--- suppose we could have properties which aren't, and are always updated).
--- Perhaps just the setter lens could be over the thing if it is Consumable
+--------------------------------------------------------------------------------
 
 (=<<) :: Monad m => (a ⊸ m b) ⊸ m a ⊸ m b
 f =<< x = x >>= f
@@ -180,19 +186,6 @@ vzipWith f (VL.V va) (VL.V vb) = VL.V (Unsafe.toLinear3 V.zipWith (Unsafe.toLine
 v2vec :: VL.V n a ⊸ V.Vector a
 v2vec (VL.V v) = v
 
-
--- | Shame, traversable should really be polimorphic over %p.
--- I'm afraid it could break some instances, so I'll just specialize this to V
--- threadThrough :: Data.Linear.Traversable t => (a %p -> c ⊸ (b,c)) -> c ⊸ t a %p -> (t b, c)
---
--- Wait, isn't this (linear) mapAccumL? It already exists! Only it's linear on
--- the first argument too. We can work around it with dup2 @Int in our case
---
--- We comment it out. Delete in the next commit.
--- threadThrough :: KnownNat n => (a %p -> c ⊸ (b,c)) -> VL.V n a %p -> c ⊸ (VL.V n b, c)
--- threadThrough f va c = runState (vtraverse (\a -> StateT (pure . f a)) va) c
-
-
 l2vec :: [a] ⊸ V.Vector a
 l2vec = Unsafe.toLinear V.fromList
 

ghengin-core/ghengin-core/Ghengin/Core/Mesh.hs

@@ -3,10 +3,13 @@
 module Ghengin.Core.Mesh
   ( Mesh(..) -- Export these from an Internals module, not from here
   , Some(..)
+
   , createMesh
   , createMeshWithIxs
-  -- , calculateFlatNormals
-  -- , calculateSmoothNormals
+
+  , createMeshSV
+  , createMeshWithIxsSV
+
   , freeMesh
 
   , meshId
@@ -15,7 +18,6 @@ module Ghengin.Core.Mesh
   , module Ghengin.Core.Mesh.Vertex
   ) where
 
-import GHC.Stack
 import Ghengin.Core.Prelude as Linear
 import Data.Unique
 
@@ -40,17 +42,6 @@ import qualified Data.IntMap.Strict as IM
 
 import qualified Data.Linear.Alias as Alias
 
-{-
-Note [Meshes]
-~~~~~~~~~~~~~
-
-OUTDATED!
-
-All meshes are freed when the window is closed. However, if you change/discard a
-mesh during the game you must free it explicitly. TODO: Enforce it somehow: linear types+reference counting
-
- -}
-
 type Mesh :: [Type] -- ^ Vertex attributes
           -> [Type] -- ^ Mesh properties
           -> Type
@@ -126,11 +117,18 @@ createMesh :: (CompatibleMesh props π, CompatibleVertex ts π, Storable (Vertex
             -- ^ The render pipeline
             ⊸ PropertyBindings props
             -- ^ The 'PropertyBindings' for the properties of this mesh (the second type argument to 'Mesh')
-            ⊸ [Vertex ts] -- TODO: Use Vector
+            ⊸ [Vertex ts]
             -- ^ Vertices
            -> Renderer (Mesh ts props, RenderPipeline π bs)
-createMesh (RenderProperty pr rps) props0 vs = createMesh rps props0 vs >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
-createMesh (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) props0 (SV.fromList -> vs) = enterD "createMesh" Linear.do
+createMesh a b c = createMeshSV a b (SV.fromList c)
+
+-- | Like 'createMesh', but takes a storable vector directly rather than a list.
+createMeshSV
+  :: (CompatibleMesh props π, CompatibleVertex ts π, Storable (Vertex ts))
+  => RenderPipeline π bs ⊸ PropertyBindings props ⊸ SV.Vector (Vertex ts)
+  -> Renderer (Mesh ts props, RenderPipeline π bs)
+createMeshSV (RenderProperty pr rps) props0 vs = createMeshSV rps props0 vs >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
+createMeshSV (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) props0 vs = enterD "createMesh" Linear.do
   Ur uniq      <- liftSystemIOU newUnique
   vertexBuffer <- createVertexBuffer vs
 
@@ -142,16 +140,23 @@ createMesh (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders u
 
 -- | Like 'createMesh', but create the mesh using a vertex buffer created from
 -- the vertices and an indexbuffer created from the indices
-createMeshWithIxs :: HasCallStack => (CompatibleMesh props π, CompatibleVertex ts π, Storable (Vertex ts))
+createMeshWithIxs :: (CompatibleMesh props π, CompatibleVertex ts π, Storable (Vertex ts))
                   => RenderPipeline π bs
                    ⊸ PropertyBindings props
-                   ⊸ [Vertex ts] -- TODO: Use Vector
+                   ⊸ [Vertex ts]
                   -- ^ Vertices
-                  -> [Int32] -- TODO: Use Vector
+                  -> [Int32]
                   -- ^ Indices
                   -> Renderer (Mesh ts props, RenderPipeline π bs)
-createMeshWithIxs (RenderProperty pr rps) props0 vs ixs = createMeshWithIxs rps props0 vs ixs >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
-createMeshWithIxs (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) props0 (SV.fromList -> vertices) (SV.fromList -> ixs) = enterD "createMeshWithIxs" Linear.do
+createMeshWithIxs a b c d = createMeshWithIxsSV a b (SV.fromList c) (SV.fromList d)
+
+createMeshWithIxsSV
+  :: (CompatibleMesh props π, CompatibleVertex ts π, Storable (Vertex ts))
+  => RenderPipeline π bs ⊸ PropertyBindings props
+   ⊸ SV.Vector (Vertex ts) -> SV.Vector Int32
+  -> Renderer (Mesh ts props, RenderPipeline π bs)
+createMeshWithIxsSV (RenderProperty pr rps) props0 vs ixs = createMeshWithIxsSV rps props0 vs ixs >>= \case (m, rp) -> pure (m, RenderProperty pr rp)
+createMeshWithIxsSV (RenderPipeline gpip rpass (rdset, rres, (Ur bmap), dpool0) shaders uq) props0 vertices ixs = enterD "createMeshWithIxs" Linear.do
   Ur uniq      <- liftSystemIOU newUnique
   vertexBuffer <- createVertexBuffer vertices
   indexBuffer  <- createIndex32Buffer ixs
@@ -199,5 +204,3 @@ freeMesh mesh = Linear.do
       Alias.forget ds >> destroyDeviceLocalBuffer vb >> destroyDeviceLocalBuffer ib
     MeshProperty prop xs ->
       Alias.forget prop >> freeMesh xs
-
--- TODO: Nub vertices (make indexes pointing at different vertices which are equal to point at the same vertice and remove the other)?

ghengin-core/ghengin-core/Ghengin/Core/Render/Property.hs

@@ -24,7 +24,6 @@ import Ghengin.Core.Render
 import Ghengin.Core.Type.Utils
 import qualified Data.Linear.Alias as Alias
 import qualified Data.IntMap.Linear as IM
-import Ghengin.Core.Renderer.DescriptorSet (BindingsMap)
 import Vulkan.Linear ()
 
 import qualified Vulkan as Vk -- TODO: Core shouldn't depend on any specific renderer implementation external to Core

ghengin-core/ghengin-core/Ghengin/Core/Renderer/Buffer.hsig

@@ -4,7 +4,7 @@ import Data.Word (Word, Word32)
 import Data.Int (Int32)
 import qualified Data.Vector.Storable as SV
 -- TODO:Exchange Vk specific types to renderer agnostic enumerations
-import qualified Vulkan as Vk (DescriptorType, BufferUsageFlags)
+import qualified Vulkan as Vk (BufferUsageFlags)
 
 import Ghengin.Core.Mesh.Vertex
 import Ghengin.Core.Renderer.Kernel

ghengin-core/ghengin-core/Ghengin/Core/Renderer/Command.hsig

@@ -5,7 +5,6 @@ import Ghengin.Core.Log
 import qualified Data.Functor.Linear as Data
 import qualified Data.Linear.Alias as Alias
 
-import Ghengin.Core.Renderer.Kernel
 import Ghengin.Core.Renderer.Pipeline
 import Ghengin.Core.Renderer.Buffer
 import Ghengin.Core.Renderer.DescriptorSet

ghengin-core/ghengin-vulkan/Ghengin/Vulkan/Renderer/Buffer.hs

@@ -11,7 +11,6 @@ import qualified Prelude
 
 import Foreign.Storable
 
-import Data.Int
 import qualified Data.Linear.Alias as Alias
 
 import qualified Data.Vector.Storable as SV

ghengin-core/ghengin-vulkan/Ghengin/Vulkan/Renderer/DescriptorSet.hs

@@ -60,8 +60,6 @@ import Ghengin.Core.Shader.Pipeline
 
 import qualified Data.Linear.Alias as Alias
 
-import qualified FIR.Layout
-
 -- The descriptor set number 0 will be used for engine-global resources, and bound
 -- once per frame. The descriptor set number 1 will be used for per-pass
 -- resources, and bound once per pass. The descriptor set number 2 will be used

ghengin/ghengin-geometry/Ghengin/Geometry/Normals.hs

@@ -17,8 +17,8 @@ import Geomancy
 import qualified Geomancy.Vec3 as Vec3
 
 import Prelude.Linear
-import Data.Vector (Vector)
 import qualified Data.Vector as V
+import qualified Data.Vector.Storable as SV
 import qualified Data.Array.Mutable.Linear as Array
 
 {- | Compute the smooth normal vectors of a mesh surface.
@@ -58,28 +58,32 @@ have all allocated buffers automatically initialized to zero. In that case, if
 this is the first and only normalization for a given mesh, you may skip the
 first loop on the function too of course.
 -}
-computeNormals :: Vector Int  -- ^ Every three indices into the vertices array forms a face
-               -> Vector Vec3 -- ^ The position of every vertex
-               -> Vector Vec3 -- ^ The normal vector for each vertex
+computeNormals :: SV.Vector Int  -- ^ Every three indices into the vertices array forms a face
+               -> SV.Vector Vec3 -- ^ The position of every vertex
+               -> SV.Vector Vec3 -- ^ The normal vector for each vertex
 computeNormals ixs vs =
-  unur $ Array.alloc (V.length vs) (vec3 0 0 0) $ \arr0 ->
+  V.convert $ unur $ -- todo: freeze variant which constructs SV.Vector?
+  Array.alloc (SV.length vs) (vec3 0 0 0) $ \arr0 ->
     Array.freeze $
     Array.map Vec3.normalize $
       foldl' (\arr (Ur i) -> let
            ia = ixs ! (i)
            ib = ixs ! (i+1)
            ic = ixs ! (i+2)
-           e1 = vs ! ia ^-^ vs ! ib
-           e2 = vs ! ic ^-^ vs ! ib
+           e1 = ((vs ! ia) :: Vec3) ^-^ (vs ! ib)
+           e2 = (vs ! ic) ^-^ (vs ! ib)
            no = Vec3.cross e1 e2 
         in arr & ia += no
                & ib += no
                & ic += no
-        ) arr0 [Ur i | i <- [0,3..V.length ixs - 1]]
+        ) arr0 [Ur i | i <- [0,3..SV.length ixs - 1]]
   where
-    (!) = V.unsafeIndex
+    (!) :: SV.Storable x => SV.Vector x -> Int -> x
+    (!) = SV.unsafeIndex
 
     (+=) :: Int -> Vec3 -> Array.Array Vec3 %1 -> Array.Array Vec3
     (+=) i new arr0 = case Array.unsafeGet i arr0 of
       (Ur exists, arr1) -> Array.unsafeSet i (new ^+^ exists) arr1
 
+-- TODO: Try backpermute
+