Refactor picture rendering code

src/Picture/Data.hs

@@ -2,7 +2,7 @@
 --{-# LANGUAGE Strict #-}
 module Picture.Data
     where
-import Shader.Data
+
 import Data.Monoid
 import qualified Data.Foldable as F
 import qualified Data.Sequence as Se
@@ -12,11 +12,9 @@ import Geometry.Data
 
 import Control.Lens
 
-import Foreign
+--import Foreign
 
-import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
+--import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
-
-import qualified Control.Foldl as F
 
 import Control.Monad 
 
@@ -29,34 +27,6 @@ data RenderType
     | RenderLine [(Point3,Point4)]
     | RenderEllipse [(Point3,Point4)]
 
-pokeShaders :: [FullShader RenderType] -> F.FoldM IO RenderType [Int]
-pokeShaders fss = traverse pokeShader fss
-
-pokeShader :: FullShader RenderType -> F.FoldM IO RenderType Int
-pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
-  where vao = _shaderVAO fs
-        (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ vao
-        fls = _shaderPokeStrategy fs
-
-pokeRender :: (RenderType -> [[[Float]]])
-                -> [(Ptr Float,Int)] -> Int -> RenderType -> IO Int
-pokeRender toFs ptrs n rt = pokeList ptrs n (toFs rt)
-
-pokeList :: [(Ptr Float,Int)] -> Int -> [[[Float]]] -> IO Int
-pokeList ptrs n fsss = foldM (pokePtrs ptrs) n fsss
-
-pokePtrs :: [(Ptr Float,Int)] -> Int -> [[Float]] -> IO Int
-pokePtrs ptrIs n fss = do
-    zipWithM_ f ptrIs fss
-    return $ n + 1
-        where f (ptr,i) fs = pokeArrayOff ptr (i*n) fs
-
-pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
-pokeArrayOff ptr i xs =
-    zipWithM_ (pokeElemOff ptr) [i..] xs
-
-
-
 type RGBA = (Float,Float,Float,Float)
 type Color = (Float,Float,Float,Float)
 
@@ -93,7 +63,6 @@ instance Functor (RTree a) where
     fmap f (RBranches i ts) = RBranches i $ (fmap (fmap f)) ts
     fmap f (RLeaf x)      = RLeaf (f x)
 
-
 flat2 (x,y)     = [x,y]
 flat3 (x,y,z)   = [x,y,z]
 flat4 (x,y,z,w) = [x,y,z,w]
@@ -114,7 +83,6 @@ data Picture
     | OverPic (Point3 -> Point3) (Point2 -> Point2) Float (Point4 -> Point4) Picture
     | OnLayer Int Picture
 
-
 blank :: Picture
 {-# INLINE blank #-}
 blank = Blank

src/Picture/Preload.hs

@@ -12,15 +12,14 @@ import Codec.Picture
 import qualified Data.Vector.Storable as V
 
 import Control.Lens
-import Control.Monad
+--import Control.Monad
 
 import Foreign
 
 import Shader
 
 data RenderData = RenderData
-    { --_charMap :: Image PixelRGBA8
+    { _textures :: [TextureObject]
-      _textures :: [TextureObject]
     , _backShader       :: (Program, [UniformLocation])
     , _wallShadowShader :: (Program, [UniformLocation])
     , _lightmapCircleShader :: (Program, [UniformLocation])
@@ -35,7 +34,6 @@ data RenderData = RenderData
 
 makeLenses ''RenderData
 
-
 pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
 pokeTriStrat _ = []
 
@@ -103,8 +101,7 @@ preloadRender = do
     fadevao       <- setupVAO [(0,4)]
     
     return $ RenderData
-        { -- _charMap      = convertRGBA8 cmap
+        { _textures = [dirttex,dirttex]
-         _textures = [dirttex,dirttex]
         , _listShaders = [bslist,lslist,cslist,aslist,eslist]
         , _lightmapCircleShader = fcs
         , _backShader = bgs

src/Picture/Render.hs

@@ -1,6 +1,9 @@
 --{-# LANGUAGE Strict #-}
 {-# LANGUAGE DeriveFoldable, StandaloneDeriving #-}
 module Picture.Render
+    ( module Picture.Render
+    , picToLTree
+    )
     where
 
 import Shader
@@ -18,6 +21,7 @@ import qualified Control.Foldl as F
 import Data.Bifunctor
 
 import Picture.Data
+import Picture.Tree
 import Geometry
 
 import Picture.Preload
@@ -33,93 +37,14 @@ import qualified Graphics.Rendering.OpenGL as GL
 
 import Data.Foldable
 import Data.List
-import qualified Data.Vector.Storable as V
+--import qualified Data.Vector.Storable as V
 import qualified Data.IntMap as IM
-import qualified Data.DList as DL
+--import qualified Data.DList as DL
 
-import Control.DeepSeq
+--import Control.DeepSeq
 
 import qualified SDL as SDL
 
-white = (1,1,1,1)
-black = (0,0,0,1)
-
-polyToTris :: [s] -> [s]
-{-# INLINE polyToTris #-}
-polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
-polyToTris _ = []
-
-tripFirst :: (a -> a') -> (a,b,c) -> (a',b,c)
-{-# INLINE tripFirst #-}
-tripFirst f (x,y,z) = (f x,y,z)
-
-tripSecond :: (b -> b') -> (a,b,c) -> (a,b',c)
-{-# INLINE tripSecond #-}
-tripSecond f (x,y,z) = (x,f y,z)
-
-scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3)
-{-# INLINE scaleT #-}
-scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))
-
-overPos :: (Point3 -> Point3) -> RenderType -> RenderType
-{-# INLINE overPos #-}
-overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
-overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
-overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
-overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
---overPos f (RenderCirc (a,b,c)) = RenderCirc (f a,b,c)
-overPos f (RenderArc (a,b,c))  = RenderArc (f a,b,c)
-
-overRot :: Float -> RenderType -> RenderType
-{-# INLINE overRot #-}
-overRot ang (RenderArc (a,b,(r,s,t,v))) = RenderArc (a,b,(r+ang,s+ang,t,v))
-overRot _ ren = ren
-
-overCol :: (Point4 -> Point4) -> RenderType -> RenderType
-{-# INLINE overCol #-}
-overCol f (RenderPoly vs)      = RenderPoly $ map (second $ f) vs
-overCol f (RenderLine vs)      = RenderLine $ map (second $ f) vs
-overCol f (RenderEllipse vs)   = RenderEllipse $ map (second $ f) vs
-overCol f (RenderText vs)      = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
---overCol f (RenderCirc (a,b,c)) = RenderCirc (a,f b,c)
-overCol f (RenderArc (a,b,c))   = RenderArc (a,f b,c)
-
-overSca :: (Point2 -> Point2) -> RenderType -> RenderType
-{-# INLINE overSca #-}
-overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,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,y)) vs
-scaleRen x y rt = overPos (scale3 x y) rt
-{-# INLINE translateRen #-}
-translateRen x y = overPos $ translate3 x y
-rotateRen,setDepthRen :: Float -> RenderType -> RenderType
-{-# INLINE rotateRen #-}
-rotateRen a (RenderArc (p,c,(as,ae,r,w))) = overPos (rotate3 a) $ RenderArc (p,c,(f as,f ae,r,w))
-    --where f b = normalizeAngle $ a + b
-    where f b = a + b
-rotateRen a pic = overPos (rotate3 a) pic
-{-# INLINE setDepthRen #-}
-setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
-{-# INLINE colorRen #-}
-colorRen :: RGBA -> RenderType -> RenderType
-colorRen c = overCol $ const c
-
-stringToList :: String -> [(Point3,Point4,Point3)]
-{-# INLINE stringToList #-}
-stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))
-                         [0,0.9*dimText..]
-                         $ map charToTuple s
-    --where dimText = 100
-dimText :: Float
-dimText = 100
-
-charToTuple :: Char -> (Point3,Point4,Point3)
-{-# INLINE charToTuple #-}
-charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
-    where offset = fromIntegral (fromEnum c) - 32
 
 --picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType
 --{-# INLINE picToAlt #-}
@@ -152,103 +77,6 @@ charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
 --picToAlt j Blank = Ap.empty
 --picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
 
-collapseBranch :: (RenderType -> RenderType) -> FTree RenderType -> FTree RenderType
-collapseBranch f (FBranch g t) = FBranch (f . g) t
-collapseBranch f (FBranches ts) = FBranches $ map (collapseBranch f) ts
-collapseBranch f (FLeaf x) = FLeaf (f x)
-
-filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
-{-# INLINE filtB #-}
-filtB mx i t | Just i == mx || Nothing == mx = t
-             | otherwise                     = LBranches []
-
-picToLTree :: Maybe Int -> Picture -> LTree RenderType
-{-# INLINE picToLTree #-}
-picToLTree mx (Polygon i ps)
-    = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
-picToLTree mx (PolygonCol i vs) = 
-    filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
-        where (ps,cs) = unzip vs
-picToLTree mx (Circle i colC colE r)
-    = filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC)
-                                         ,( (-r,-r,0), colE)
-                                         ,( ( r,-r,0), black)
-                                         ]
-picToLTree mx (ThickArc i startA endA rad wdth) 
-    = filtB mx i $ LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
-picToLTree mx (Line i ps) 
-    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
-picToLTree mx (LineCol i vs) 
-    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
-        where (ps,cs) = unzip vs
-picToLTree mx (Text i s) 
-    = filtB mx i $ LLeaf $ RenderText $ stringToList s
-picToLTree j Blank = LBranches []
-picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
-picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic)) 
-    = picToLTree j $ OverPic (f . g) (f' . g') (r + s) (f'' . g'') pic
-picToLTree j (OverPic f f' r f'' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f' r f'') ps)
-picToLTree j (OverPic f f' r f'' pic) = fmap (overPos f . overSca f' . overRot r . overCol f'') $ picToLTree j pic
-picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
-                                    | otherwise = LBranches []
-picToLTree Nothing  (OnLayer _ pic) = picToLTree Nothing pic
-
-doubleLine :: [a] -> [a]
-{-# INLINE doubleLine #-}
-doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
-doubleLine _ = []
-
-theFold :: TwoPtrs
-        -> ThreePtrs
-        -> ThreePtrs
-        -> TwoPtrs
-        -> ThreePtrs
-        -> TwoPtrs
-        -> F.FoldM IO RenderType (Int,Int,Int,Int,Int,Int)
-theFold pas pbs pcs pds pes pfs
-    = (,,,,,) <$> pokeTwoPtrsWith pokePoly pas 
-             <*> pokeThreePtrsWith pokeText pbs 
-             <*> pokeThreePtrsWith pokeCirc pcs
-             <*> pokeTwoPtrsWith pokeLine pds
-             <*> pokeThreePtrsWith pokeArc pes
-             <*> pokeTwoPtrsWith pokeEllipse pfs
-
-type ThreePtrs = (Ptr Float,Ptr Float,Ptr Float)
-type TwoPtrs = (Ptr Float,Ptr Float)
-
-pokeThreePtrsWith :: (ThreePtrs -> Int -> RenderType -> IO Int)
-    -> ThreePtrs -> F.FoldM IO RenderType Int
-{-# INLINE pokeThreePtrsWith #-}
-pokeThreePtrsWith pokeF ptrs = F.FoldM (pokeF ptrs) (return 0) return
-pokeTwoPtrsWith :: (TwoPtrs -> Int -> RenderType -> IO Int)
-    -> TwoPtrs -> F.FoldM IO RenderType Int
-{-# INLINE pokeTwoPtrsWith #-}
-pokeTwoPtrsWith  pokeF ptrs = F.FoldM (pokeF ptrs) (return 0) return
-
-pokeArc:: ThreePtrs -> Int -> RenderType -> IO Int
-{-# INLINE pokeArc #-}
-pokeArc (pa,pb,pc) n (RenderArc (p,c,s))
-    | n > 20000 * 2 = return n
-    | otherwise = do
-        pokeThreeOff pa n p
-        pokeFourOff  pb n c
-        pokeFourOff  pc n s
-        return $ n + 1
-pokeArc _ n _ = return n
-
-pokeEllipse:: TwoPtrs -> Int -> RenderType -> IO Int
-{-# INLINE pokeEllipse #-}
-pokeEllipse ptrs n (RenderEllipse vs) = foldM (pokeEllipseVert ptrs) n vs
-pokeEllipse _    n _ = return n
-
-pokeEllipseVert :: TwoPtrs -> Int -> (Point3,Point4) -> IO Int
-{-# INLINE pokeEllipseVert #-}
-pokeEllipseVert (pa,pb) n (p,c)
-    | n > 20000 * 2 = return n
-    | otherwise = do
-        pokeThreeOff pa n p
-        pokeFourOff  pb n c
-        return $ n + 1
 
 pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
 {-# INLINE pokeTwoOff #-}
@@ -261,7 +89,6 @@ pokeThreeOff ptr n (x,y,z) = do
     pokeElemOff ptr (3*n+0) x
     pokeElemOff ptr (3*n+1) y
     pokeElemOff ptr (3*n+2) z
-
 pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
 {-# INLINE pokeFourOff #-}
 pokeFourOff ptr n (x,y,z,w) = do
@@ -270,74 +97,6 @@ pokeFourOff ptr n (x,y,z,w) = do
     pokeElemOff ptr (4*n+2) z
     pokeElemOff ptr (4*n+3) w
 
-
-pokeLine :: TwoPtrs -> Int -> RenderType -> IO Int
-{-# INLINE pokeLine #-}
-pokeLine (pa,pb) n (RenderLine vs) = foldM (pokeLineVert pa pb) n vs
-pokeLine _       n _               = return n
-
-pokeLineVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
-{-# INLINE pokeLineVert #-}
-pokeLineVert pa pb n (p,c)
-    | n > 20000 * 2 = return n
-    | otherwise = do
-        pokeThreeOff pa n p
-        pokeFourOff  pb n c
-        return (n+1)
-
-pokeCirc :: ThreePtrs -> Int -> RenderType -> IO Int
-{-# INLINE pokeCirc #-}
-pokeCirc _          n _               = return n
-
-pokeText :: (Ptr Float, Ptr Float, Ptr Float) -> Int -> RenderType -> IO Int
-{-# INLINE pokeText #-}
-pokeText (pa,pb,pc) n  (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs
-pokeText _          n _               = return n
-
-pokeTextVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Point3) -> IO Int
-{-# INLINE pokeTextVert #-}
-pokeTextVert pa pb pc n (p,c,t)
-    | n > 20000 * 2 = return n
-    | otherwise = do
-        pokeThreeOff pa n p
-        pokeFourOff  pb n c
-        pokeThreeOff pc n t
-        return (n+1)
-
-pokePoly :: TwoPtrs -> Int -> RenderType -> IO Int
-{-# INLINE pokePoly #-}
-pokePoly (pa,pb) n (RenderPoly vs) = foldM (pokeVert pa pb) n vs
-pokePoly _       n _               = return n
-
-pokeVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
-{-# INLINE pokeVert #-}
-pokeVert pa pb n (p,c)
-    | n > 20000 * 2 = return n
-    | otherwise = do
-        pokeThreeOff pa n p
-        pokeFourOff  pb n c
-        return (n+1)
-
-translate3 :: Float -> Float -> Point3 -> Point3
-{-# INLINE translate3 #-}
-translate3 a b (x,y,z) = (x+a,y+b,z)
-scale3 :: Float -> Float -> Point3 -> Point3
-{-# INLINE scale3 #-}
-scale3 a b (x,y,z) = (x*a,y*b,z)
-rotate3 :: Float -> Point3 -> Point3
-{-# INLINE rotate3 #-}
-rotate3 a (x,y,z) = (x',y',z)
-    where (x',y') = rotateV a (x,y)
-
-twoPtrsVAO :: VAO -> (Ptr Float, Ptr Float)
-{-# INLINE twoPtrsVAO #-}
-twoPtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
-    (a:b:_) -> (a,b)
-threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float)
-{-# INLINE threePtrsVAO #-}
-threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
-    (a:b:c:_) -> (a,b,c)
-
 setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [FullShader RenderType] -> IO ()
 setShaderUniforms rot zoom (tranx,trany) (winx,winy) fss = do
     let scalMat = Linear.Matrix.transpose $

src/Picture/Tree.hs

@@ -0,0 +1,140 @@
+module Picture.Tree
+    ( picToLTree
+    )
+    where
+import Picture.Data
+import Geometry
+
+import Data.Bifunctor
+import Data.List
+
+picToLTree :: Maybe Int -> Picture -> LTree RenderType
+{-# INLINE picToLTree #-}
+picToLTree mx (Polygon i ps)
+    = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
+picToLTree mx (PolygonCol i vs) = 
+    filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
+        where (ps,cs) = unzip vs
+picToLTree mx (Circle i colC colE r)
+    = filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC)
+                                         ,( (-r,-r,0), colE)
+                                         ,( ( r,-r,0), black)
+                                         ]
+picToLTree mx (ThickArc i startA endA rad wdth) 
+    = filtB mx i $ LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
+picToLTree mx (Line i ps) 
+    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
+picToLTree mx (LineCol i vs) 
+    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
+        where (ps,cs) = unzip vs
+picToLTree mx (Text i s) 
+    = filtB mx i $ LLeaf $ RenderText $ stringToList s
+picToLTree j Blank = LBranches []
+picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
+picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic)) 
+    = picToLTree j $ OverPic (f . g) (f' . g') (r + s) (f'' . g'') pic
+picToLTree j (OverPic f f' r f'' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f' r f'') ps)
+picToLTree j (OverPic f f' r f'' pic) = fmap (overPos f . overSca f' . overRot r . overCol f'') $ picToLTree j pic
+picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
+                                    | otherwise = LBranches []
+picToLTree Nothing  (OnLayer _ pic) = picToLTree Nothing pic
+
+filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
+{-# INLINE filtB #-}
+filtB mx i t | Just i == mx || Nothing == mx = t
+             | otherwise                     = LBranches []
+
+doubleLine :: [a] -> [a]
+{-# INLINE doubleLine #-}
+doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
+doubleLine _ = []
+
+white = (1,1,1,1)
+black = (0,0,0,1)
+
+polyToTris :: [s] -> [s]
+{-# INLINE polyToTris #-}
+polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
+polyToTris _ = []
+
+tripFirst :: (a -> a') -> (a,b,c) -> (a',b,c)
+{-# INLINE tripFirst #-}
+tripFirst f (x,y,z) = (f x,y,z)
+
+tripSecond :: (b -> b') -> (a,b,c) -> (a,b',c)
+{-# INLINE tripSecond #-}
+tripSecond f (x,y,z) = (x,f y,z)
+
+scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3)
+{-# INLINE scaleT #-}
+scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))
+
+overPos :: (Point3 -> Point3) -> RenderType -> RenderType
+{-# INLINE overPos #-}
+overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
+overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
+overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
+overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
+overPos f (RenderArc (a,b,c))  = RenderArc (f a,b,c)
+
+overRot :: Float -> RenderType -> RenderType
+{-# INLINE overRot #-}
+overRot ang (RenderArc (a,b,(r,s,t,v))) = RenderArc (a,b,(r+ang,s+ang,t,v))
+overRot _ ren = ren
+
+overCol :: (Point4 -> Point4) -> RenderType -> RenderType
+{-# INLINE overCol #-}
+overCol f (RenderPoly vs)      = RenderPoly $ map (second $ f) vs
+overCol f (RenderLine vs)      = RenderLine $ map (second $ f) vs
+overCol f (RenderEllipse vs)   = RenderEllipse $ map (second $ f) vs
+overCol f (RenderText vs)      = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
+overCol f (RenderArc (a,b,c))   = RenderArc (a,f b,c)
+
+overSca :: (Point2 -> Point2) -> RenderType -> RenderType
+{-# INLINE overSca #-}
+overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,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,y)) vs
+scaleRen x y rt = overPos (scale3 x y) rt
+{-# INLINE translateRen #-}
+translateRen x y = overPos $ translate3 x y
+rotateRen,setDepthRen :: Float -> RenderType -> RenderType
+{-# INLINE rotateRen #-}
+rotateRen a (RenderArc (p,c,(as,ae,r,w))) = overPos (rotate3 a) $ RenderArc (p,c,(f as,f ae,r,w))
+    --where f b = normalizeAngle $ a + b
+    where f b = a + b
+rotateRen a pic = overPos (rotate3 a) pic
+{-# INLINE setDepthRen #-}
+setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
+{-# INLINE colorRen #-}
+colorRen :: RGBA -> RenderType -> RenderType
+colorRen c = overCol $ const c
+
+stringToList :: String -> [(Point3,Point4,Point3)]
+{-# INLINE stringToList #-}
+stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))
+                         [0,0.9*dimText..]
+                         $ map charToTuple s
+    --where dimText = 100
+dimText :: Float
+dimText = 100
+
+charToTuple :: Char -> (Point3,Point4,Point3)
+{-# INLINE charToTuple #-}
+charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
+    where offset = fromIntegral (fromEnum c) - 32
+
+translate3 :: Float -> Float -> Point3 -> Point3
+{-# INLINE translate3 #-}
+translate3 a b (x,y,z) = (x+a,y+b,z)
+scale3 :: Float -> Float -> Point3 -> Point3
+{-# INLINE scale3 #-}
+scale3 a b (x,y,z) = (x*a,y*b,z)
+rotate3 :: Float -> Point3 -> Point3
+{-# INLINE rotate3 #-}
+rotate3 a (x,y,z) = (x',y',z)
+    where (x',y') = rotateV a (x,y)
+