Reset Shapes to be list (not stream) of ShapeObj

src/Dodge/Floor.hs

@@ -43,16 +43,16 @@ initialAnoTree = OnwardList
     [ IntAnno $ AnTree . startRoom
     , AnRoom $ roomCCrits 0
     , AnRoom $ return airlock0
---    , AnRoom slowDoorRoom
+    , AnRoom slowDoorRoom
 --    , AnRoom $ roomCCrits 10
 --    , AnTree firstBreather
-    , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
+--    , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
-    ]
+--    ]
-
+--
-extraAnoList :: [Annotation]
+--extraAnoList :: [Annotation]
-extraAnoList =
+--extraAnoList =
---     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
+----     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
-    [ AnRoom $ roomCCrits 10
+--    [ AnRoom $ roomCCrits 10
     , AnRoom $ roomCCrits 10
     , AnTree $ tToBTree "spawners" <$> spawnerRoom
     , AnRoom pistolerRoom

src/Shader/Poke.hs

@@ -98,11 +98,17 @@ pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort
     -> IO (Int,Int,Int)
 pokeShape ptr iptr ieptr = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return (0,0,0)) return
 
+--pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
+--    -> (Int,Int,Int)
+--    -> Stream (Of ShapeObj) IO ()
+--    -> IO (Int,Int,Int)
+--pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return
+--
 pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
     -> (Int,Int,Int)
-    -> Stream (Of ShapeObj) IO ()
+    -> [ShapeObj]
     -> IO (Int,Int,Int)
-pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return
+pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return . S.each
 
 pokeShapeObj
     :: Ptr Float 

src/Shape.hs

@@ -23,6 +23,12 @@ import Shape.Data
 import Color
 import qualified Streaming.Prelude as S
 
+singleShape :: ShapeObj -> Shape
+{-# INLINE singleShape #-}
+singleShape = (:[])
+
+shMap = map
+
 emptySH :: Shape
 {-# INLINE emptySH #-}
 emptySH = mempty
@@ -45,7 +51,7 @@ prismPoly
     -> [Point3] 
     -> Shape
 {-# INLINE prismPoly #-}
-prismPoly upps downps = S.yield (ShapeObj (TopPrism n) (f upps downps))
+prismPoly upps downps = singleShape (ShapeObj (TopPrism n) (f upps downps))
   where
     n = length upps
     f (a:as) (b:bs) = g a:g b:f as bs
@@ -58,7 +64,7 @@ upperPrismPoly
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPoly #-}
-upperPrismPoly h ps = S.yield (ShapeObj (TopPrism n) (f ps))
+upperPrismPoly h ps = singleShape (ShapeObj (TopPrism n) (f ps))
   where
     n = length ps
     g h' (V2 x y) = pairToSV (V3 x y h', black)
@@ -70,7 +76,7 @@ upperPrismPolyHalf
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPolyHalf #-}
-upperPrismPolyHalf h ps = S.yield (ShapeObj (TopPrism n) (f upps downps))
+upperPrismPolyHalf h ps = singleShape (ShapeObj (TopPrism n) (f upps downps))
   where
     n = length ps
     upps = map f' ps
@@ -86,7 +92,7 @@ colorSH = overColSH . const
 
 overColSH :: (Point4 -> Point4) -> Shape -> Shape
 {-# INLINE overColSH #-}
-overColSH = S.map . overColObj
+overColSH = shMap . overColObj
 
 translateSH :: Point3 -> Shape -> Shape
 {-# INLINE translateSH #-}
@@ -106,7 +112,7 @@ rotateSH = overPosSH . rotate3
 
 overPosSH :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINEABLE overPosSH #-}
-overPosSH = S.map . overPosObj
+overPosSH = shMap . overPosObj
 
 rotateSHx :: Float -> Shape -> Shape
 {-# INLINE rotateSHx #-}

src/Shape/Data.hs

@@ -10,7 +10,8 @@ import Geometry.Data
 --import Data.Vector.Fusion.Util
 import Control.Lens
 import Streaming
-type Shape = Stream (Of ShapeObj) IO ()
+type Shape' = Stream (Of ShapeObj) IO ()
+type Shape = [ShapeObj]
 
 --_shVertices :: Shape -> [ShapeV]
 --{-# INLINE _shVertices #-}

src/ShapePicture.hs

@@ -23,6 +23,8 @@ import qualified Streaming.Prelude as S
 
 type SPic =  (Shape, Picture)
 
+shMap = map
+
 -- should all this be inlined/inlinable?
 noPic :: Shape -> SPic
 {-# INLINE noPic #-}
@@ -58,12 +60,12 @@ rotateSP a = bimap (rotateSH a) (rotate a)
 
 mirrorSPxz :: SPic -> SPic
 {-# INLINE mirrorSPxz #-}
-mirrorSPxz = bimap (S.map (over shVs reverse) . overPosSH flipy) mirrorxz
+mirrorSPxz = bimap (shMap (over shVs reverse) . overPosSH flipy) mirrorxz
   where
     flipy (V3 x y z) = V3 x (negate y) z
 
 mirrorSPyz :: SPic -> SPic
 {-# INLINE mirrorSPyz #-}
-mirrorSPyz = bimap (S.map (over shVs reverse) . overPosSH flipx) mirroryz
+mirrorSPyz = bimap (shMap (over shVs reverse) . overPosSH flipx) mirroryz
   where
     flipx (V3 x y z) = V3 (negate x) y z