Commit before tree representation of picture

src/Dodge/Rendering.hs

@@ -81,9 +81,9 @@ collectDrawings :: World -> Picture
 collectDrawings w = screenShift (decPicts <> ppPicts <> itFloorPicts 
                                 <> crPicts
                                 <> clPicts
-                                   <> buttonPicts <> ptPicts 
-                                    <> ptPicts'
-                                    <> afterPtPicts'
+                                <> buttonPicts <> ptPicts 
+                                <> ptPicts'
+                                <> afterPtPicts'
                                 <> wlPicts
                                 <> wallShadows
                                 <> smokeShadows
@@ -96,7 +96,6 @@ collectDrawings w = screenShift (decPicts <> ppPicts <> itFloorPicts
     where
           screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
                                             . uncurry translate ((0,0) -.- _cameraPos w)
-          rotPicts = map (scale zoom zoom . rotate (radToDeg (_cameraRot w)))
           zoom     = _cameraZoom w
           decPicts :: Picture
           decPicts      = mconcat $ IM.elems $ _decorations w
@@ -152,14 +151,14 @@ hudDrawings w = (onLayer InvLayer)
     where itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
 
 crDraw :: Creature -> Drawing
-crDraw c = uncurry translateDrawing (_crPos c) $ rotateDrawing (- radToDeg (_crDir c)) (_crPict c c)
+crDraw c = uncurry translate (_crPos c) $ rotateRad (_crDir c) (_crPict c c)
 ppDraw :: PressPlate -> Drawing
-ppDraw c = uncurry translateDrawing (_ppPos c) $ rotateDrawing (- radToDeg (_ppRot c)) (_ppPict c)
+ppDraw c = uncurry translate (_ppPos c) $ rotateRad (_ppRot c) (_ppPict c)
 btDraw :: Button -> Drawing
-btDraw c = uncurry translateDrawing (_btPos c) $ rotateDrawing (- radToDeg (_btRot c)) (_btPict c)
+btDraw c = uncurry translate (_btPos c) $ rotateRad (_btRot c) (_btPict c)
 
 clDraw :: Cloud -> Drawing
-clDraw c = uncurry translateDrawing (_clPos c) $ (_clPict c c)
+clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
 
 drawCursor :: World -> Picture
 drawCursor w = translate (105-halfWidth w) 

src/Picture/Data.hs

@@ -3,6 +3,8 @@
 module Picture.Data
     where
 import Data.Monoid
+import qualified Data.Foldable as F
+import qualified Data.Sequence as Se
 import qualified Data.DList as DL
 import qualified Data.Vector as V
 import Geometry.Data
@@ -13,25 +15,60 @@ type RGBA = (Float,Float,Float,Float)
 type Color = (Float,Float,Float,Float)
 
 
+type VerticesContainer a = Se.Seq a
+toVC = Se.fromList
+fromVC :: VerticesContainer a -> [a]
+fromVC = F.toList
 --type VerticesContainer a = DL.DList a
 --toVC = DL.fromList
 --fromVC = DL.toList
-type VerticesContainer a = [a]
-toVC = id
-fromVC = id
+--type VerticesContainer a = [a]
+--toVC = id
+--fromVC = id
 
 mapVC :: (a -> b) -> VerticesContainer a -> VerticesContainer b
 mapVC = fmap
 
-data Shape = Shape
-    { _shPos :: VerticesContainer Point3
-    , _shCol :: VerticesContainer RGBA
-    }
-combineShapes :: Shape -> Shape -> Shape
-combineShapes sa sb = Shape
-    { _shPos  = _shPos  sa <> _shPos sb
-    , _shCol  = _shCol  sa <> _shCol sb
-    }
+data NTree a b
+    = NBranch a [NTree a b]
+    | NLeaf b
+
+reduceNTree :: NTree (a -> a) a -> NTree () a
+reduceNTree = reduceNTree' id
+    where 
+        reduceNTree' :: (b -> b) -> NTree (b -> b) b -> NTree () b
+        reduceNTree' f (NBranch g xs) = NBranch () $ map (reduceNTree' (f . g)) xs
+        reduceNTree' f (NLeaf x) = NLeaf $ f x
+
+concatLeaves :: NTree a b -> DL.DList b
+concatLeaves (NLeaf x) = DL.singleton x
+concatLeaves (NBranch _ xs) = mconcat (map concatLeaves xs)
+
+--reduceShapeTree :: (Shape -> Shape) -> ShapeTree -> [Shape]
+--reduceShapeTree
+--    (TransformShape f xs) = map (f . reduceShapeTree) xs
+--reduceShapeTree
+--    (Leaf s) = [s]
+
+data ShapeTree 
+    = TransformShape (Shape -> Shape) [ShapeTree]
+    | Leaf Shape
+
+data Shape 
+    = Shape 
+        { _shPos :: VerticesContainer Point3
+        , _shCol :: VerticesContainer RGBA
+        }
+    | TextShape
+        { _shPos :: VerticesContainer Point3
+        , _shCol :: VerticesContainer RGBA
+        , _shTex :: VerticesContainer Point2
+        }
+--combineShapes :: Shape -> Shape -> Shape
+--combineShapes sa sb = Shape
+--    { _shPos  = _shPos  sa <> _shPos sb
+--    , _shCol  = _shCol  sa <> _shCol sb
+--    }
 
 data Picture = Scene
     { _scPosTri  :: VerticesContainer Point3