From a5730014c81316e7042d7c6e844e76229cf25f0a Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sun, 10 Jul 2022 09:42:24 +0100
Subject: [PATCH] Reset Shapes to be list (not stream) of ShapeObj

---
 src/Dodge/Floor.hs  | 16 ++++++++--------
 src/Shader/Poke.hs  | 10 ++++++++--
 src/Shape.hs        | 16 +++++++++++-----
 src/Shape/Data.hs   |  3 ++-
 src/ShapePicture.hs |  6 ++++--
 5 files changed, 33 insertions(+), 18 deletions(-)

diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index 4e76e0e8f..5eb03529e 100644
--- a/src/Dodge/Floor.hs
+++ b/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
-    ]
-
-extraAnoList :: [Annotation]
-extraAnoList =
---     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
-    [ AnRoom $ roomCCrits 10
+--    , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
+--    ]
+--
+--extraAnoList :: [Annotation]
+--extraAnoList =
+----     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
+--    [ AnRoom $ roomCCrits 10
     , AnRoom $ roomCCrits 10
     , AnTree $ tToBTree "spawners" <$> spawnerRoom
     , AnRoom pistolerRoom
diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs
index d99d365d8..3c631d4ab 100644
--- a/src/Shader/Poke.hs
+++ b/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 
diff --git a/src/Shape.hs b/src/Shape.hs
index a5b8e3496..74dd24fba 100644
--- a/src/Shape.hs
+++ b/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 #-}
diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs
index 43ce29fa5..5f6625a78 100644
--- a/src/Shape/Data.hs
+++ b/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 #-}
diff --git a/src/ShapePicture.hs b/src/ShapePicture.hs
index c81265ac8..30b04b176 100644
--- a/src/ShapePicture.hs
+++ b/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