Revert "Turn Shape into a stream"

This reverts commit c7e720248d.

src/Dodge/Creature/HandPos.hs

@@ -43,7 +43,7 @@ translatePointToRightHand' cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
 translateToRightHand :: Creature -> SPic -> SPic
-translateToRightHand cr = translateToRightHand' cr -- . mirrorSPxz
+translateToRightHand cr = translateToRightHand' cr . mirrorSPxz
 
 translateToRightHand' :: Creature -> SPic -> SPic
 translateToRightHand' cr

src/Dodge/Item/Equipment/Shape.hs

@@ -23,7 +23,7 @@ equipPosition epos cr sh = case epos of
     OnLeftWrist -> translateToLeftHand cr sh
     OnRightWrist -> translateToRightHand cr sh
     OnLegs -> translateToLeftLeg cr sh <> 
-        translateToRightLeg cr sh --(mirrorSPxz sh)
+        translateToRightLeg cr (mirrorSPxz sh)
     OnHead -> translateToHead cr sh
     OnChest -> translateToChest cr sh
     _ -> sh

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -99,7 +99,7 @@ teslaGun = defaultBatteryGun
 teslaGunPic :: Item -> SPic
 teslaGunPic _ = noPic $ colorSH blue $
        upperPrismPoly 5 (rectNESW xb    8 xa    0)
-    <> upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
+    ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
   where
     xa = 1
     xb = 9

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -31,7 +31,6 @@ import Shape
 import Sound.Data
 import LensHelp
 
-import qualified Data.Vector.Fusion.Stream.Monadic as VS
 --import qualified Data.Map.Strict as M
 --import qualified Data.Sequence as Seq
 --import Control.Lens
@@ -303,8 +302,7 @@ miniGunXPict i spin _ =
     )
   where
     aBarrel = translateSH (V3 15 2 2) baseCaneShape
-    barrels = VS.concatMap (\an -> aBarrel & rotateSHx (2*pi * fromIntegral an / fromIntegral i)) 
+    barrels = concatMap (\an -> aBarrel & rotateSHx (2*pi * fromIntegral an / fromIntegral i)) [1..i]
-        $ VS.fromList [1..i]
     a = fromIntegral spin / 100
     --x = fromIntegral am / 10
 --    clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) 

src/Dodge/Item/Weapon/Shatter.hs

@@ -41,7 +41,7 @@ shatterGun = defaultWeapon
 shatterGunSPic :: Item -> SPic
 shatterGunSPic _ = noPic $ colorSH blue $
        upperPrismPoly 5 (rectNESW xb    8 xa    0)
-    <> upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
+    ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
   where
     xa = 1
     xb = 9

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -56,7 +56,7 @@ flamerPic :: Item -> SPic
 flamerPic it = 
     ( colorSH yellow $ 
         translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r)
-        <> upperPrismPoly 5 (rectNESW 2 18 (-2) 0)
+        ++ upperPrismPoly 5 (rectNESW 2 18 (-2) 0)
     , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am)
     )
   where

src/Dodge/Room/Foreground.hs

@@ -5,7 +5,7 @@ import Picture
 import Geometry
 import Shape
 import Quaternion
---import Bound
+import Bound
 
 --import Dodge.Data.ForegroundShape
 import Dodge.Default.Foreground
@@ -13,8 +13,8 @@ import Data.List
 import Data.Maybe
 import Control.Lens
 import ShapePicture
---import Streaming
+import Streaming
---import qualified Streaming.Prelude as S
+import qualified Streaming.Prelude as S
 
 highDiagonalMesh
     :: Point2 

src/Shader/Poke.hs

@@ -19,6 +19,7 @@ import qualified Data.Vector.Unboxed as UV
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
+import Data.Vector.Fusion.Util
 import Control.Monad.Primitive
 --import qualified Control.Monad.Parallel as MP
 
@@ -84,9 +85,9 @@ pokeShape
     :: Ptr Float 
     -> Ptr GLushort 
     -> Ptr GLushort 
-    -> VS.Stream IO ShapeObj
+    -> [ShapeObj] 
     -> IO (Int,Int,Int)
-pokeShape ptr iptr ieptr = VS.foldM (pokeShapeObj ptr iptr ieptr) (0,0,0)
+pokeShape ptr iptr ieptr = VS.foldM (pokeShapeObj ptr iptr ieptr) (0,0,0) . VS.fromList
 
 pokeShapeObj
     :: Ptr Float 

src/Shape.hs

@@ -25,7 +25,7 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS
 
 emptySH :: Shape
 {-# INLINE emptySH #-}
-emptySH = VS.empty
+emptySH = mempty
 
 -- - approximate a circle by a polygon with n*2 points of radius x
 polyCirc :: Int -> Float -> [Point2]
@@ -45,7 +45,7 @@ prismPoly
     -> [Point3] 
     -> Shape
 {-# INLINE prismPoly #-}
-prismPoly upps downps = VS.singleton $ ShapeObj (TopPrism n) (VS.fromList $ f upps downps)
+prismPoly upps downps = [ShapeObj (TopPrism n) (VS.fromList $ f upps downps)]
   where
     n = length upps
     f (a:as) (b:bs) = g a:g b:f as bs
@@ -58,7 +58,7 @@ upperPrismPoly
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPoly #-}
-upperPrismPoly h ps = VS.singleton $ ShapeObj (TopPrism n) (VS.fromList $ f ps)
+upperPrismPoly h ps = [ShapeObj (TopPrism n) (VS.fromList $ f ps)]
   where
     n = length ps
     g h' (V2 x y) = pairToSV (V3 x y h', black)
@@ -70,7 +70,7 @@ upperPrismPolyHalf
     -> [Point2] 
     -> Shape
 {-# INLINE upperPrismPolyHalf #-}
-upperPrismPolyHalf h ps = VS.singleton $ ShapeObj (TopPrism n) (VS.fromList $ f upps downps)
+upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (VS.fromList $ f upps downps)]
   where
     n = length ps
     upps = map f' ps
@@ -94,7 +94,7 @@ overColSH = fmap . overColObj
 
 overPosSHI :: (Point3 -> Point3) -> Shape -> Shape
 {-# INLINE overPosSHI #-}
-overPosSHI = VS.map . overPosObj
+overPosSHI = fmap . overPosObj
 
 translateSH :: Point3 -> Shape -> Shape
 {-# INLINE translateSH #-}

src/Shape/Data.hs

@@ -3,19 +3,14 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleInstances #-}
 module Shape.Data
     where
 import Geometry.Data
 
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
+import Data.Vector.Fusion.Util
 import Control.Lens
-type Shape = VS.Stream IO ShapeObj
+type Shape = [ShapeObj]
-
-instance Semigroup (VS.Stream IO ShapeObj) where
-    (<>) = (VS.++)
-instance Monoid (VS.Stream IO ShapeObj) where
-    mempty = VS.empty
 
 --_shVertices :: Shape -> [ShapeV]
 --{-# INLINE _shVertices #-}

src/ShapePicture.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 module ShapePicture
     ( emptyBlank
@@ -12,25 +10,23 @@ module ShapePicture
     , noShape
     , _spShape
     , _spPicture
---    , mirrorSPyz
+    , mirrorSPyz
---    , mirrorSPxz
+    , mirrorSPxz
     ) where
 import Shape
 import Picture
 import Geometry
 
-import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Data.Bifunctor
---import Control.Lens
 
-type SPic = (Shape, Picture)
+type SPic =  (Shape, Picture)
 
 -- should all this be inlined/inlinable?
 noPic :: Shape -> SPic
 noPic = (,mempty)
 
 noShape :: Picture -> SPic
-noShape = (VS.empty,)
+noShape = (mempty,)
 
 _spShape :: SPic -> Shape
 _spShape = fst
@@ -52,12 +48,12 @@ translateSP v = bimap (translateSH v) (translate3 v)
 rotateSP :: Float -> SPic -> SPic
 rotateSP a = bimap (rotateSH a) (rotate a)
 
---mirrorSPxz :: SPic -> SPic
+mirrorSPxz :: SPic -> SPic
---mirrorSPxz = bimap (reverse . overPosSH flipy) mirrorxz
+mirrorSPxz = bimap (reverse . overPosSH flipy) mirrorxz
---  where
+  where
---    flipy (V3 x y z) = V3 x (negate y) z
+    flipy (V3 x y z) = V3 x (negate y) z
---
+
---mirrorSPyz :: SPic -> SPic
+mirrorSPyz :: SPic -> SPic
---mirrorSPyz = bimap (reverse . overPosSH flipx) mirroryz
+mirrorSPyz = bimap (reverse . overPosSH flipx) mirroryz
---  where
+  where
---    flipx (V3 x y z) = V3 (negate x) y z
+    flipx (V3 x y z) = V3 (negate x) y z