Make pictures use Streaming

src/Picture/Base.hs

@@ -47,9 +47,12 @@ import Geometry
 import Picture.Data
 import Color
 
+import qualified Streaming.Prelude as S
+import Data.Foldable
+
 blank :: Picture
 {-# INLINE blank #-}
-blank = []
+blank = mempty
 
 polygonWire :: [Point2] -> Picture
 {-# INLINE polygonWire #-}
@@ -58,19 +61,19 @@ polygonWire ps = line (ps ++ [head ps])
 -- | Expects clockwise input.
 polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
-polygon = map f . polyToTris
+polygon = S.each . map f . polyToTris
   where
     f (V2 x y) = Verx (V3 x y 0) black [] BottomLayer polyNum
 
 polygonZ :: [Point2] -> Float -> Picture
 {-# INLINE polygonZ #-}
-polygonZ ps z = map (f . zeroZ) $ polyToTris ps
+polygonZ ps z = S.each . map (f . zeroZ) $ polyToTris ps
   where
     f pos = Verx pos black [z] BottomLayer polyzNum
 
 polygonCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE polygonCol #-}
-polygonCol = polyToTris . map f
+polygonCol = S.each . polyToTris . map f
   where
     f (V2 x y,col) = Verx (V3 x y 0) col [] BottomLayer polyNum
 
@@ -80,7 +83,7 @@ poly3 = poly3Col . map (, black)
 
 poly3Col :: [(Point3,RGBA)] -> Picture
 {-# INLINE poly3Col #-}
-poly3Col = map f . polyToTris
+poly3Col = S.each . map f . polyToTris
   where
     f (pos,col) = Verx pos col [] BottomLayer polyNum
 
@@ -119,7 +122,7 @@ bezierQuad cola colc ra rc a b c
     fc' = extrapolate cIn aIn bIn
 
 bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
-bzhelp = map f
+bzhelp = S.each . map f
   where
     f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] BottomLayer bezNum
 
@@ -140,7 +143,7 @@ extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) =
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = map $ overCol (const c)
+color c = S.map $ overCol (const c)
 
 translateH :: Float -> Float -> Point3 -> Point3
 {-# INLINE translateH #-}
@@ -148,30 +151,30 @@ translateH !a !b (V3 x y z) = V3 (x+a) (y+b) z
 
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
-translate x = map . overPos . translateH x
+translate x = S.map . overPos . translateH x
 
 translate3 :: Point3 -> Picture -> Picture
 {-# INLINE translate3 #-}
-translate3 = map . overPos . (+.+.+)
+translate3 = S.map . overPos . (+.+.+)
 
 tranRot :: V2 Float -> Float -> Picture -> Picture
 {-# INLINE tranRot #-}
-tranRot (V2 x y) r = map $ overPos (translateH x y . rotate3 r)
+tranRot (V2 x y) r = S.map $ overPos (translateH x y . rotate3 r)
 
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
 --setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
-setDepth d = map $ overPos (\(V3 x y _) -> V3 x y d)
+setDepth d = S.map $ 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 = map $ overPos (\(V3 x y z) -> V3 x y (z+d))
+addDepth d = S.map $ 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 = map f
+setLayer i = S.map f
   where
     f v = v {_vxLayer = i}
 
@@ -181,23 +184,23 @@ scale3 a b (V3 x y z) = V3 (x*a) (y*b) z
 
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
-scale x = map . overPos . scale3 x
+scale x = S.map . overPos . scale3 x
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate = map . overPos . rotate3
+rotate = S.map . overPos . rotate3
 
 concatMapPic :: Foldable t => (a -> Picture) -> t a -> Picture
 {-# INLINE concatMapPic #-}
-concatMapPic = concatMap
+concatMapPic = foldMap
 
 appendPic :: Picture -> Picture -> Picture
 {-# INLINE appendPic #-}
-appendPic = (++)
+appendPic = (<>)
 
 pictures :: Foldable t => t Picture -> Picture
 {-# INLINABLE pictures #-}
-pictures = concat
+pictures = fold
 
 makeArc :: Float -> Point2 -> [Point2]
 {-# INLINE makeArc #-}
@@ -212,7 +215,7 @@ circleSolid = circleSolidCol white white
 
 circleSolidCol :: Color -> Color -> Float -> Picture
 {-# INLINE circleSolidCol #-}
-circleSolidCol colC colE r = map f
+circleSolidCol colC colE r = S.each $ map f
     [(V3 (-r)   r  0, colC)
     ,(V3 (-r) (-r) 0, colE)
     ,(V3   r  (-r) 0, black)
@@ -234,7 +237,7 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0,100..]
 
 text :: String -> Picture
 {-# INLINE text #-}
-text = map f . stringToList
+text = S.each . map f . stringToList
   where
     f (pos,col,V2 a b) = Verx pos col [a,b] BottomLayer textNum
 
@@ -316,7 +319,7 @@ thickArc startA endA rad wdth
 
 thickArcHelp :: Float -> Float -> Float -> Float -> Picture
 {-# INLINE thickArcHelp #-}
-thickArcHelp startA endA rad wdth = map f
+thickArcHelp startA endA rad wdth = S.each $ map f
     [  (V3 0 0 0,black,V3 0 0 wdth)
     ,(V3 xa ya 0,black,V3 1 0 wdth)
     ,(V3 xb yb 0,black,V3 1 1 wdth)
@@ -363,11 +366,11 @@ charToTuple x c =
     offset = fromIntegral (fromEnum c) - 32
 
 mirrorxz :: Picture -> Picture
-mirrorxz = map (overPos flipy)
+mirrorxz = S.map (overPos flipy)
   where
     flipy (V3 x y z) = V3 x (negate y) z
 
 mirroryz :: Picture -> Picture
-mirroryz = map (overPos flipx)
+mirroryz = S.map (overPos flipx)
   where
     flipx (V3 x y z) = V3 (negate x) y z