From 21f814ede1ad03ddfe248aebe9cd794a8bb49c44 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 10 Jul 2022 09:30:00 +0100 Subject: [PATCH] Revert pictures to using lists rather than streams of Verx --- src/Dodge/Creature/Lamp.hs | 4 ++-- src/Picture/Base.hs | 29 ++++++++++++++++------------- src/Picture/Data.hs | 4 ++-- src/Polyhedra.hs | 10 ++++++++-- src/Shader/Poke.hs | 4 ++-- 5 files changed, 30 insertions(+), 21 deletions(-) diff --git a/src/Dodge/Creature/Lamp.hs b/src/Dodge/Creature/Lamp.hs index a68f25267..6d05d8696 100644 --- a/src/Dodge/Creature/Lamp.hs +++ b/src/Dodge/Creature/Lamp.hs @@ -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 diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 41a5baeb4..4489cb3a4 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -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 diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 20beffafb..e76981e8f 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -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] diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 857114b41..d7c9a69bf 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -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 diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index a9bc759df..d99d365d8 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -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 #-}