Refactor rendering

shader/twoD/bezierQuad.frag

@@ -8,7 +8,7 @@ out vec4 fColor;
 void main()
 {
   //float d = x - y - 1 + 2* sqrt(y);
-  float d = sqrt(boxOut.x) + sqrt(boxOut.y) - 1;
+  float d = sqrt(boxOut.x) + sqrt(boxOut.y) - 1.0;
 //  float e = sqrt(f(x,wStart)) + sqrt(f(y,wEnd)) - 1.0;
   float e = sqrt(boxIn.x) + sqrt(boxIn.y) - 1.0;
   if ( d < 0 || e > 0) { discard; }

shader/twoD/character.vert

@@ -10,7 +10,7 @@ out vec2 gTexCoord;
 
 void main()
 {
-    gl_Position = vec4(aPos, 1.0);
+    gl_Position = worldMat * vec4(aPos, 1.0);
     gColor = aColor;
     gTexCoord = aTexCoord;
 }

src/Picture.hs

@@ -122,7 +122,7 @@ extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) =
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = OverPic id id 0 (const c)
+color c = OverPic id 0 (const c)
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
@@ -130,11 +130,11 @@ translate3 a b (x,y,z) = (x+a,y+b,z)
 
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
-translate x y = OverPic (translate3 x y) id 0 id
+translate x y = OverPic (translate3 x y) 0 id
 
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
-setDepth d = OverPic (\(x,y,_) -> (x,y,d)) id 0 id
+setDepth d = OverPic (\(x,y,_) -> (x,y,d)) 0 id
 
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
@@ -146,7 +146,7 @@ scale3 a b (x,y,z) = (x*a,y*b,z)
 
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
-scale x y = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id
+scale x y = OverPic (scale3 x y) 0 id
 
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
@@ -156,7 +156,7 @@ rotate3 a (x,y,z) = (x',y',z)
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate a = OverPic (rotate3 a) id a id
+rotate a = OverPic (rotate3 a) a id
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}

src/Picture/Data.hs

@@ -86,7 +86,7 @@ data Picture
     | Line Int [Point2]
     | LineCol Int [(Point2,RGBA)]
     | Pictures [Picture]
-    | OverPic (Point3 -> Point3) (Point2 -> Point2) Float (Point4 -> Point4) Picture
+    | OverPic (Point3 -> Point3) Float (Point4 -> Point4) Picture
     | OnLayer Int Picture
 
 blank :: Picture

src/Picture/Tree.hs

@@ -23,18 +23,19 @@ 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
+  where 
+    (ps,cs) = unzip vs
 picToLTree mx (Poly3D i vs) = filtB mx i $ LLeaf $ RenderPoly $ polyToTris vs
-picToLTree mx (BezierQuad i vs) 
-    = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
-        where (ps,cols,offps,rads) = unzip4 vs
-              rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
+picToLTree mx (BezierQuad i vs) = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
+  where 
+    (ps,cols,offps,rads) = unzip4 vs
+    rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
                                       
-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 (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) 
@@ -46,12 +47,12 @@ picToLTree mx (Text i s)
     = filtB mx i $ LLeaf $ RenderText $ stringToList s
 picToLTree _ 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) 
-    = overPos f . overSca f' . overRot r . overCol f'' <$> picToLTree j pic
+picToLTree j (OverPic f r f'' (OverPic g s g'' pic)) 
+    = picToLTree j $ OverPic (f . g) (r + s) (f'' . g'') pic
+picToLTree j (OverPic f r f'' (Pictures ps)) 
+    = LBranches (map (picToLTree j . OverPic f r f'') ps)
+picToLTree j (OverPic f r f'' pic) 
+    = overPos 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
@@ -70,10 +71,6 @@ white, black :: Color
 white = (1,1,1,1)
 black = (0,0,0,1)
 
-scaleT :: (Float,Float) -> (Point3,Point4,Point2) -> (Point3,Point4,Point2)
-{-# INLINE scaleT #-}
-scaleT (x,y) (a,b,(o,s)) = (a,b,(o,s))
-
 overPos :: (Point3 -> Point3) -> RenderType -> RenderType
 {-# INLINE overPos #-}
 overPos f (RenderPoly vs) = RenderPoly $ map (first f) vs
@@ -99,11 +96,6 @@ overCol f (RenderBezQ vs)     = RenderBezQ    $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
 overCol _ _ = undefined
 
-overSca :: (Point2 -> Point2) -> RenderType -> RenderType
-{-# INLINE overSca #-}
-overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,1))) vs
-overSca _ p = p
-
 stringToList :: String -> [(Point3,Point4,Point2)]
 {-# INLINE stringToList #-}
 stringToList s = concat $ zipWith (\x -> map (f x))