Commit with working graphics but slow, will attempt to change text

src/Picture.hs

@@ -1,5 +1,5 @@
 --{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE Strict #-}
+--{-# LANGUAGE Strict #-}
 module Picture
     ( module Picture.Data
     , polygon
@@ -61,26 +61,36 @@ black = (0,0,0,1)
 polygonD :: Float -> [Point2] -> Picture
 {-# INLINE polygonD #-}
 polygonD d (a:b:c:ps) = blank
-    { _scPosTri = DL.fromList $ map (\(x,y) -> (x,y,d)) tris
-    , _scColTri = DL.fromList $ map (const black) tris
+    { _scPosTri = mapVC (\(x,y) -> (x,y,d)) tris
+    , _scColTri = mapVC (const black) tris
     }
     where twoPs = zip (b:c:ps) (c:ps)
-          tris = concatMap (\(x,y)-> [a,x,y]) twoPs
+          tris = toVC $ concatMap (\(x,y)-> [a,x,y]) twoPs
 polygonD _ _ = blank
 
 polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
 polygon (a:b:c:ps) = blank
-    { _scPosTri = DL.fromList $ map zeroZ tris
-    , _scColTri = DL.fromList $ map (const black) tris
+    { _scPosTri = fmap zeroZ tris
+    , _scColTri = fmap (const black) tris
     }
     where twoPs = zip (b:c:ps) (c:ps)
-          tris = concatMap (\(x,y)-> [a,x,y]) twoPs
+          tris = toVC $ concatMap (\(x,y)-> [a,x,y]) twoPs
 polygon _ = blank
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = over scColTri (DL.map $ const c) . over scColChar (DL.map $ const c)
+color c pic@(Scene {_scColTri = colTri,_scColChar= colChar}) =
+    pic {_scColTri  = mapVC (const c) colTri
+        ,_scColChar = mapVC (const c) colChar
+        }
+
+overPos :: (Point3 -> Point3) -> Picture -> Picture
+{-# INLINE overPos #-}
+overPos f pic@(Scene {_scPosTri = posTri,_scPosChar= posChar}) =
+    pic {_scPosTri  = mapVC f posTri
+        ,_scPosChar = mapVC f posChar
+        }
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
@@ -88,19 +98,13 @@ translate3 a b (x,y,z) = (x+a,y+b,z)
 
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
-translate x y = over scPosTri (DL.map $ translate3 x y) . over scPosChar (DL.map $ translate3 x y)
+--translate x y = over scPosTri (mapVC $ translate3 x y) . over scPosChar (mapVC $ translate3 x y)
+translate x y = overPos $ translate3 x y
 
 setDepth :: Float -> Picture -> Picture
-setDepth d = over scPosTri (DL.map $ (\(x,y,z)->(x,y,d)))
-             . over scPosChar (DL.map $ (\(x,y,z)->(x,y,d)))
-
---overVs' :: (CPoint2 -> CPoint) -> Picture -> Picture
-----{-# INLINE overVs' #-}
---overVs' f !(Scene a b) = let !a' = map f a
---                             !b' = map g b
---                         in  Scene a' b'
---    where g !(x,y,z) = let !(x',y') = f (x,y)
---                       in  (x',y',z)
+--setDepth d = over scPosTri (mapVC $ (\(x,y,z)->(x,y,d)))
+--             . over scPosChar (mapVC $ (\(x,y,z)->(x,y,d)))
+setDepth d = overPos $ \(x,y,z) -> (x,y,d)
 
 scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
@@ -108,7 +112,8 @@ scale3 a b (x,y,z) = (x*a,y*b,z)
 
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
-scale x y = over scPosTri (DL.map $ scale3 x y) . over scPosChar (DL.map $ scale3 x y)
+--scale x y = over scPosTri (mapVC $ scale3 x y) . over scPosChar (mapVC $ scale3 x y)
+scale x y = overPos $ scale3 x y
 
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
@@ -117,14 +122,16 @@ rotate3 a (x,y,z) = (x',y',z)
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate a = over scPosTri (DL.map $ rotate3 (0 - degToRad a)) 
-            . over scPosChar (DL.map $ rotate3 (0 - degToRad a))
+--rotate a = over scPosTri (mapVC $ rotate3 (0 - degToRad a)) 
+--            . over scPosChar (mapVC $ rotate3 (0 - degToRad a))
+rotate a = overPos $ rotate3 $ 0 - degToRad a
 
 --  -- this rotation uses radians, and is anticlockwise
 rotateRad :: Float -> Picture -> Picture
 {-# INLINE rotateRad #-}
-rotateRad a = over scPosTri (DL.map $ rotate3 a) 
-            . over scPosChar (DL.map $ rotate3 a)
+--rotateRad a = over scPosTri (mapVC $ rotate3 a) 
+--            . over scPosChar (mapVC $ rotate3 a)
+rotateRad a = overPos $ rotate3 a
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
@@ -161,17 +168,17 @@ text s = mconcat $ zipWith (\x -> translate x (0-dimText))
 
 charToScene :: Char -> Picture
 charToScene c = Scene
-    {_scPosTri = DL.empty
-    ,_scColTri = DL.empty
-    ,_scPosChar = DL.fromList [(0.0    ,0.0      ,0)        
+    {_scPosTri = mempty
+    ,_scColTri = mempty
+    ,_scPosChar = toVC [(0.0    ,0.0      ,0)        
                   ,(dimText,0.0      ,0)    
                   ,(dimText,dimText*2,0)
                   ,(0.0    ,0.0      ,0)        
                   ,(dimText,dimText*2,0)
                   ,(0.0    ,dimText*2,0)    
                   ]
-    ,_scColChar = DL.fromList $ take 6 $ repeat white
-    ,_scTexChar = DL.fromList $ [(s,1) ,(e,1) ,(e,0) ,(s,1) ,(e,0) ,(s,0)]
+    ,_scColChar = toVC $ take 6 $ repeat white
+    ,_scTexChar = toVC $ [(s,1) ,(e,1) ,(e,0) ,(s,1) ,(e,0) ,(s,0)]
     }
     where x = 1/128
           s = offset * x