Refactor vao preload

src/Picture.hs

@@ -3,6 +3,7 @@
 module Picture
     ( module Picture.Data
     , polygon
+    , polygonCol
     , arc
     , arcSolid
     , thickArc
@@ -14,7 +15,6 @@ module Picture
     , pictures
     , translate
     , rotate
-    , rotateRad
     , scale
     , color
     , withAlpha
@@ -71,6 +71,10 @@ polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
 polygon = Polygon
 
+polygonCol :: [(Point2,RGBA)] -> Picture
+{-# INLINE polygonCol #-}
+polygonCol = PolygonCol
+
 --polygon :: [Point2] -> Picture
 --{-# INLINE polygon #-}
 --polygon (a:b:c:ps) = NLeaf $ emptyScene
@@ -81,40 +85,18 @@ polygon = Polygon
 --          tris = toVC $ concatMap (\(x,y)-> [a,x,y]) twoPs
 --polygon _ = blank
 
-color' :: RGBA -> Scene -> Scene
-{-# INLINE color' #-}
-color' c pic@(Scene {_scColTri = colTri,_scColChar= colChar}) =
-    pic {_scColTri  = mapVC (const c) colTri
-        ,_scColChar = mapVC (const c) colChar
-        }
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
 color c pic = Color c pic
 
-overPos :: (Point3 -> Point3) -> Scene -> Scene
-{-# 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 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
 
-translate' :: Float -> Float -> Scene -> Scene
-{-# INLINE translate' #-}
---translate x y = over scPosTri (mapVC $ translate3 x y) . over scPosChar (mapVC $ translate3 x y)
-translate' x y = overPos $ translate3 x y
-
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
 translate x y pic = Translate x y pic
 
-setDepth' :: Float -> Scene -> Scene
-{-# INLINE setDepth' #-}
-setDepth' d = overPos $ \(x,y,z) -> (x,y,d)
-
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
 setDepth d pic = SetDepth d pic
@@ -123,11 +105,6 @@ scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
 scale3 a b (x,y,z) = (x*a,y*b,z)
 
-scale' :: Float -> Float -> Scene -> Scene
-{-# INLINE scale' #-}
---scale x y = over scPosTri (mapVC $ scale3 x y) . over scPosChar (mapVC $ scale3 x y)
-scale' x y pic = overPos (scale3 x y) $ over scTexChar (fmap (second (*x))) pic
-
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
 scale x y pic = Scale x y pic
@@ -137,28 +114,11 @@ rotate3 :: Float -> Point3 -> Point3
 rotate3 a (x,y,z) = (x',y',z)
     where (x',y') = rotateV a (x,y)
 
-rotate' :: Float -> Scene -> Scene
-{-# INLINE rotate' #-}
-rotate' a = overPos $ rotate3 $ 0 - degToRad a
-
---rotate :: Float -> Picture -> Picture
---{-# INLINE rotate #-}
---rotate a pic = NBranch (rotate' a) pic
---
-----  -- this rotation uses radians, and is anticlockwise
---rotateRad' :: Float -> Scene -> Scene
---{-# INLINE rotateRad' #-}
---rotateRad' a = overPos $ rotate3 a
---
---rotateRad :: Float -> Picture -> Picture
---{-# INLINE rotateRad #-}
---rotateRad a pic = NBranch (rotateRad' a) pic
-
-rotate a = rotateRad (0 - degToRad a)
+rotate = Rotate
 {-# INLINE rotate #-}
 
-rotateRad a = Rotate a
-{-# INLINE rotateRad #-}
+--rotateRad a = Rotate a
+--{-# INLINE rotateRad #-}
 
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
@@ -171,72 +131,32 @@ makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
     where as = [a,a+step.. b]
           step = pi * 0.2
 
---circleSolidD :: Float -> Float -> Picture
---circleSolidD d r = polygonD d $ makeArc r (0,2*pi)
-
 circleSolid :: Float -> Picture
 {-# INLINE circleSolid #-}
-circleSolid rad = polygon $ makeArc rad (0,2*pi)
+--circleSolid rad = polygon $ makeArc rad (0,2*pi)
+circleSolid = Circle
 
 circle :: Float -> Picture
 {-# INLINE circle #-}
 circle rad = line $ makeArc rad (0,2*pi)
 
---text :: String -> Picture
---text s = zipWith (\x -> overVs $ first $ translate3 x 0) 
---                 [0,0.25..]
---                 $ map charToShape s
-
 text :: String -> Picture
 {-# INLINE text #-}
 text = Text
 
-----text :: String -> Picture
-----{-# INLINE text #-}
-----text s = pictures $  zipWith (\x -> translate x (0-dimText)) 
-----                           [0,0.9*dimText..] 
-----                           (map charToScene s)
-----
-----charToScene :: Char -> Picture
-----charToScene c = NLeaf $ Scene
-----    {_scPosTri = mempty
-----    ,_scColTri = mempty
-----    ,_scPosChar = toVC [(0.0,0.0,0)]
-----    ,_scColChar = toVC [white]
-----    ,_scTexChar = toVC [(offset,100)]
-----    }
-----    where x = 1/128
-----          s = offset * x
-----          offset = fromIntegral (fromEnum c) - 32
---charToScene :: Char -> Picture
---charToScene c = Scene
---    {_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 = 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
---          e = s + x
---          offset = fromIntegral (fromEnum c) - 32
-    
-
-dimText = 100
-
 line :: [Point2] -> Picture
 {-# INLINE line #-}
-line ps = thickLine ps 1
+line = Line
 
 thickLine :: [Point2] -> Float -> Picture
 {-# INLINE thickLine #-}
-thickLine ps x = blank
+thickLine ps t = pictures $ f ps
+    where f (x:y:ys) 
+            | x == y = f (x:ys)
+            | otherwise 
+                     = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
+          f _        = []
+          n a b      = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
 
 thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
@@ -296,9 +216,3 @@ bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a)
 
 greyN :: Float -> Color
 greyN x = (x,x,x,1)
-
-
---zeroZ :: Point2 -> Point3
---{-# INLINE zeroZ #-}
---zeroZ (x,y) = (x,y,0)
-