Try to fuse functions over pictures (overPos and overCol)

src/Picture/Data.hs

@@ -66,7 +66,7 @@ data Picture
     | SetDepth Float Picture
     | Color RGBA Picture
     | Pictures [Picture]
-    | OverPos (Point3 -> Point3) (Float -> Float) Picture
+    | OverPic (Point3 -> Point3) (Float -> Float) (Point4 -> Point4) Picture
 
 
 blank :: Picture

src/Picture/Render.hs

@@ -77,6 +77,11 @@ overCol f (RenderCirc (a,b,c)) = RenderCirc (a,f b,c)
 overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
 overCol _ RenderBlank = RenderBlank
 
+overSca :: (Float -> Float) -> RenderType -> RenderType
+{-# INLINE overSca #-}
+overSca f (RenderText vs) = RenderText $ map (scaleT (f 1)) vs
+overSca f p = p
+
 scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
 {-# INLINE scaleRen #-}
 scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs
@@ -231,6 +236,9 @@ picToLTree j (Rotate a pic) = fmap (rotateRen a) $ picToLTree j pic
 picToLTree j (SetDepth a pic) = fmap (setDepthRen a) $ picToLTree j pic
 picToLTree j (Color c pic) = fmap (colorRen c) $ picToLTree j pic
 picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
+picToLTree j (OverPic f f' f'' (OverPic g g' g'' pic)) = picToLTree j $ OverPic (f . g) (f' . g') (f'' . g'') pic
+picToLTree j (OverPic f f' f'' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f' f'') ps)
+picToLTree j (OverPic f f' f'' pic) = fmap (overPos f . overSca f' . overCol f'') $ picToLTree j pic
 
 doubleLine :: [Point2] -> [Point2]
 doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)