Merge Picture and RenderType datatypes

src/Picture.hs

@@ -54,8 +54,10 @@ import Geometry
 import Geometry.Vector3D
 import Geometry.Data
 import Picture.Data
+import Picture.Tree
 
---import Data.Bifunctor
+import Data.List
+import Data.Bifunctor
 --import qualified Data.DList as DL
 --import Graphics.Rendering.OpenGL (lineWidth, ($=))
 --import Control.Lens
@@ -63,17 +65,22 @@ import Picture.Data
 black :: RGBA
 black = (0,0,0,1)
 
+zl :: RenderType -> [(Int,RenderType)]
+zl rt = [(0,rt)]
+
 polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
-polygon = Polygon
+polygon ps = zl $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
 
 polygonZ :: [Point2] -> Float -> Picture
 {-# INLINE polygonZ #-}
-polygonZ = PolygonZ
+polygonZ ps z = zl $ RenderPolyZ $ zip3 (map zeroZ $ polyToTris ps) (repeat black) (repeat z)
 
 polygonCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE polygonCol #-}
-polygonCol = PolygonCol
+polygonCol vs    = zl $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
+  where 
+    (ps,cs) = unzip vs
 
 poly3 :: [Point3] -> Picture
 {-# INLINE poly3 #-}
@@ -81,14 +88,14 @@ poly3 = poly3Col . map (, black)
 
 poly3Col :: [(Point3,RGBA)] -> Picture
 {-# INLINE poly3Col #-}
-poly3Col = Poly3D
+poly3Col vs = zl $ RenderPoly $ polyToTris vs
 
 -- note that much of work computing the width of the bezier curve is done here
 bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
 bezierQuad cola colc ra rc a b c 
     | a == b && b == c = blank
     | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
-    | otherwise = BezierQuad
+    | otherwise = bzhelp
         [-- ( (0,0) , cola, (0,0), (0,0) )
          (aIn, cola, (fa aIn,fc aIn) , (1,0) )
         ,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
@@ -118,6 +125,12 @@ bezierQuad cola colc ra rc a b c
     fa' = extrapolate aIn cIn bIn
     fc' = extrapolate cIn aIn bIn
 
+bzhelp vs = zl $ 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
+
+
 -- given a one and two zeros of a linear function over x and y,
 -- determine the function
 -- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
@@ -135,7 +148,7 @@ extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) =
 
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c = OverPic id (const c)
+color c = map $ second $ overCol (const c)
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
@@ -143,19 +156,19 @@ 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
+translate x y = map $ second $ overPos (translate3 x y)
 
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
-setDepth d = OverPic (\(x,y,_) -> (x,y,d)) id
+setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
 
 addDepth :: Float -> Picture -> Picture
 {-# INLINE addDepth #-}
-addDepth d = OverPic (\(x,y,z) -> (x,y,z+d)) id
+addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
 
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
-setLayer = OnLayer
+setLayer = map . first . const
 
 scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
@@ -163,15 +176,15 @@ 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) id
+scale x y = map $ second $ overPos $ (scale3 x y)
 
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate a = OverPic (rotate3 a) id
+rotate a = map $ second $ overPos $ (rotate3 a)
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
-pictures = Pictures
+pictures = concat
 
 makeArc :: Float -> (Float,Float) -> [Point2]
 {-# INLINE makeArc #-}
@@ -182,11 +195,15 @@ makeArc rad (a,b) = map (`rotateV` (0,rad)) angles
 
 circleSolid :: Float -> Picture
 {-# INLINE circleSolid #-}
-circleSolid = Circle white white
+circleSolid = circleSolidCol white white
 
 circleSolidCol :: Color -> Color -> Float -> Picture
 {-# INLINE circleSolidCol #-}
-circleSolidCol = Circle
+circleSolidCol colC colE r = zl $ RenderEllipse 
+    [( (-r, r,0), colC)
+    ,( (-r,-r,0), colE)
+    ,( ( r,-r,0), black)
+    ]
 
 circle :: Float -> Picture
 {-# INLINE circle #-}
@@ -194,7 +211,7 @@ circle rad = thickArc 0 (2*pi) rad 1
 
 text :: String -> Picture
 {-# INLINE text #-}
-text = Text
+text s = zl $ RenderText $ stringToList s
 
 line :: [Point2] -> Picture
 {-# INLINE line #-}
@@ -256,13 +273,26 @@ thickArc :: Float -> Float -> Float -> Float -> Picture
 thickArc startA endA rad wdth
     | endA - startA > pi = pictures 
         [ thickArc (startA + pi) endA rad wdth
-        , ThickArc startA (startA + pi) r w
+        , thickArcHelp startA (startA + pi) r w
         ]
-    | otherwise = ThickArc startA endA r w
+    | otherwise = thickArcHelp startA endA r w
   where
     r = rad + 0.5 * wdth
     w = 1 - wdth / r
 
+thickArcHelp startA endA rad wdth = zl $ RenderArc 
+    [(  (0,0,0),black,(0,0,wdth))
+    ,((xa,ya,0),black,(1,0,wdth))
+    ,((xb,yb,0),black,(1,1,wdth))
+    ,(  (0,0,0),black,(0,0,wdth))
+    ,((xb,yb,0),black,(1,1,wdth))
+    ,((xc,yc,0),black,(0,1,wdth))
+    ]
+  where
+    (xa,ya) = rotateV startA (rad,0)
+    (xb,yb) = rotateV (0.5 * (startA + endA)) (rad * sqrt 2,0)
+    (xc,yc) = rotateV endA (rad,0)
+
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}
 withAlpha a (x,y,z,a') = (x,y,z,a*a')