Revert pictures to using lists rather than streams of Verx

This commit is contained in:
2022-07-10 09:30:00 +01:00
parent dc803b64b0
commit 21f814ede1
5 changed files with 30 additions and 21 deletions
+2 -2
View File
@@ -16,7 +16,7 @@ import Polyhedra
import qualified IntMapHelp as IM
import LensHelp
import qualified Streaming.Prelude as S
--import qualified Streaming.Prelude as S
colorLamp
:: Point3 -- color of lamp
@@ -41,7 +41,7 @@ lamp h = defaultInanimate
lampCrPic :: Float -> Picture
lampCrPic h = pictures
[ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
, foldMap (S.each . polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
, foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
]
where
f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
+16 -13
View File
@@ -47,7 +47,7 @@ import Geometry
import Picture.Data
import Color
import qualified Streaming.Prelude as S
--import qualified Streaming.Prelude as S
import Data.Foldable
blank :: Picture
@@ -59,7 +59,10 @@ polygonWire :: [Point2] -> Picture
polygonWire ps = line (ps ++ [head ps])
picFormat :: [Verx] -> Picture
picFormat = S.each
picFormat = id
picMap :: (Verx -> Verx) -> Picture -> Picture
picMap = map
-- | Expects clockwise input.
polygon :: [Point2] -> Picture
@@ -148,7 +151,7 @@ extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
color :: RGBA -> Picture -> Picture
{-# INLINE color #-}
color c = S.map $ overCol (const c)
color c = picMap $ overCol (const c)
translateH :: Float -> Float -> Point3 -> Point3
{-# INLINE translateH #-}
@@ -156,30 +159,30 @@ translateH !a !b (V3 x y z) = V3 (x+a) (y+b) z
translate :: Float -> Float -> Picture -> Picture
{-# INLINE translate #-}
translate x = S.map . overPos . translateH x
translate x = picMap . overPos . translateH x
translate3 :: Point3 -> Picture -> Picture
{-# INLINE translate3 #-}
translate3 = S.map . overPos . (+.+.+)
translate3 = picMap . overPos . (+.+.+)
tranRot :: V2 Float -> Float -> Picture -> Picture
{-# INLINE tranRot #-}
tranRot (V2 x y) r = S.map $ overPos (translateH x y . rotate3 r)
tranRot (V2 x y) r = picMap $ overPos (translateH x y . rotate3 r)
setDepth :: Float -> Picture -> Picture
{-# INLINE setDepth #-}
--setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
setDepth d = S.map $ overPos (\(V3 x y _) -> V3 x y d)
setDepth d = picMap $ overPos (\(V3 x y _) -> V3 x y d)
addDepth :: Float -> Picture -> Picture
{-# INLINE addDepth #-}
--addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
addDepth d = S.map $ overPos (\(V3 x y z) -> V3 x y (z+d))
addDepth d = picMap $ overPos (\(V3 x y z) -> V3 x y (z+d))
-- TODO change the Int here to a dedicated type
setLayer :: Layer -> Picture -> Picture
{-# INLINE setLayer #-}
setLayer i = S.map f
setLayer i = picMap f
where
f v = v {_vxLayer = i}
@@ -189,11 +192,11 @@ scale3 a b (V3 x y z) = V3 (x*a) (y*b) z
scale :: Float -> Float -> Picture -> Picture
{-# INLINE scale #-}
scale x = S.map . overPos . scale3 x
scale x = picMap . overPos . scale3 x
rotate :: Float -> Picture -> Picture
{-# INLINE rotate #-}
rotate = S.map . overPos . rotate3
rotate = picMap . overPos . rotate3
concatMapPic :: Foldable t => (a -> Picture) -> t a -> Picture
{-# INLINE concatMapPic #-}
@@ -371,11 +374,11 @@ charToTuple x c =
offset = fromIntegral (fromEnum c) - 32
mirrorxz :: Picture -> Picture
mirrorxz = S.map (overPos flipy)
mirrorxz = picMap (overPos flipy)
where
flipy (V3 x y z) = V3 x (negate y) z
mirroryz :: Picture -> Picture
mirroryz = S.map (overPos flipx)
mirroryz = picMap (overPos flipx)
where
flipx (V3 x y z) = V3 (negate x) y z
+2 -2
View File
@@ -45,8 +45,8 @@ bezNum = ShadNum 2
textNum = ShadNum 3
arcNum = ShadNum 4
ellNum = ShadNum 5
type Picture = Stream (Of Verx) IO ()
type Picture' = [Verx]
type Picture' = Stream (Of Verx) IO ()
type Picture = [Verx]
flat2 :: V2 a -> [a]
flat2 (V2 x y) = [x,y]
flat3 :: V3 a -> [a]
+8 -2
View File
@@ -18,7 +18,13 @@ import Data.Maybe
import Data.List
import Data.Bifunctor
import Control.Lens
import qualified Streaming.Prelude as S
--import qualified Streaming.Prelude as S
--picMap :: (Verx -> Verx) -> Picture -> Picture
--picMap = map
picFormat :: [Verx] -> Picture
picFormat = id
translateXY :: Float -> Float -> Polyhedra -> Polyhedra
translateXY x y = pyFaces %~ map (map $ first tran)
@@ -120,7 +126,7 @@ polyToPics :: Polyhedra -> [Picture]
polyToPics = map helpPoly3D . _pyFaces
helpPoly3D :: [(Point3, Point4)] -> Picture
helpPoly3D = S.each . map f . polyToTris
helpPoly3D = picFormat . map f . polyToTris
where
f (pos,col) = Verx pos col [] BottomLayer polyNum
+2 -2
View File
@@ -31,7 +31,7 @@ pokeVerxs
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count)
pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each
pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
@@ -204,7 +204,7 @@ pokeLayVerxs
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts)
pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each
pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-}