Add completed circle shader, add incomplete arc shader

shader/arc.frag

@@ -0,0 +1,19 @@
+#version 430 core
+in vec4 gColor;
+in vec2 cenPosT;
+in float gRad;
+out vec4 fColor;
+out float gl_FragDepth;
+
+uniform vec2 winSize;
+
+void main()
+{
+  vec2 pos = gl_FragCoord.xy;
+ // fColor = vec4( gColor.xyz , 0 );
+ // fColor = vec4( gColor.xyz , 1 - step(distance(pos,cenPos.xy),gRad) );
+ // fColor = vec4( gColor.xyz , distance(pos,cenPos.xy)/gRad );
+  fColor = vec4( gColor.rgb, gColor.a * (1-step(gRad/2,distance(pos,cenPosT))) );
+  gl_FragDepth = max(gl_FragCoord.z , step(gRad/2,distance(pos,cenPosT)));
+  //fColor = vec4( 0.5,0,0 , 1 );
+}

shader/arc.geom

@@ -0,0 +1,34 @@
+#version 430 core
+layout (points) in;
+layout (triangle_strip, max_vertices = 4) out;
+in vec4 vColor [];
+in float vRad [];
+out vec4 gColor;
+out float gRad;
+out vec2 cenPosT;
+
+uniform vec2 winSize;
+uniform float zoom;
+
+void main()
+{
+  vec3 cenPos = gl_in[0].gl_Position.xyz;
+  //cenPos = vec3 (0.5,0,0);
+  gColor = vColor[0];
+  gRad = vRad[0] * zoom * 2;
+//  gRad = 0.2;
+
+  cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
+
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  //gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+
+  EndPrimitive();
+}

shader/arc.vert

@@ -0,0 +1,13 @@
+#version 430 core
+layout (location = 0) in vec3 position;
+layout (location = 1) in vec4 color;
+layout (location = 2) in float rad;
+out vec4 vColor;
+out float vRad;
+void main()
+{
+  gl_Position = vec4(position,1);
+  //gl_Position = vec4(0,0,0,1);
+  vColor = color;
+  vRad = rad;
+}

shader/circle.frag

@@ -0,0 +1,19 @@
+#version 430 core
+in vec4 gColor;
+in vec2 cenPosT;
+in float gRad;
+out vec4 fColor;
+out float gl_FragDepth;
+
+uniform vec2 winSize;
+
+void main()
+{
+  vec2 pos = gl_FragCoord.xy;
+ // fColor = vec4( gColor.xyz , 0 );
+ // fColor = vec4( gColor.xyz , 1 - step(distance(pos,cenPos.xy),gRad) );
+ // fColor = vec4( gColor.xyz , distance(pos,cenPos.xy)/gRad );
+  fColor = vec4( gColor.rgb, gColor.a * (1-step(gRad/2,distance(pos,cenPosT))) );
+  gl_FragDepth = max(gl_FragCoord.z , step(gRad/2,distance(pos,cenPosT)));
+  //fColor = vec4( 0.5,0,0 , 1 );
+}

shader/circle.geom

@@ -0,0 +1,34 @@
+#version 430 core
+layout (points) in;
+layout (triangle_strip, max_vertices = 4) out;
+in vec4 vColor [];
+in float vRad [];
+out vec4 gColor;
+out float gRad;
+out vec2 cenPosT;
+
+uniform vec2 winSize;
+uniform float zoom;
+
+void main()
+{
+  vec3 cenPos = gl_in[0].gl_Position.xyz;
+  //cenPos = vec3 (0.5,0,0);
+  gColor = vColor[0];
+  gRad = vRad[0] * zoom * 2;
+//  gRad = 0.2;
+
+  cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
+
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  //gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  EmitVertex();
+
+  EndPrimitive();
+}

shader/circle.vert

@@ -0,0 +1,13 @@
+#version 430 core
+layout (location = 0) in vec3 position;
+layout (location = 1) in vec4 color;
+layout (location = 2) in float rad;
+out vec4 vColor;
+out float vRad;
+void main()
+{
+  gl_Position = vec4(position,1);
+  //gl_Position = vec4(0,0,0,1);
+  vColor = color;
+  vRad = rad;
+}

src/Picture/Data.hs

@@ -46,6 +46,7 @@ data Picture
     | Polygon [Point2]
     | PolygonCol [(Point2,RGBA)]
     | Circle Float
+    | ThickArc Float Float Float Float
     | Scale Float Float Picture
     | Translate Float Float Picture
     | Rotate Float Picture

src/Picture/Preload.hs

@@ -50,6 +50,10 @@ data PreloadData = PreloadData
     , _asWinUni :: UniformLocation
     , _asZoomUni :: UniformLocation
     }
+data VAO = VAO
+    { _vao :: VertexArrayObject
+    , _vaoBufferTargets :: [(BufferObject,Ptr Float,Int)]
+    }
 
 makeLenses ''PreloadData
 
@@ -125,7 +129,7 @@ doPreload' = do
     basicVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
     textVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
     circVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
-    arcVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,3)]
+    arcVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
 
 -- allocate memory for vertex attributes
 -- for triangles
@@ -145,7 +149,7 @@ doPreload' = do
 -- for arcs
     ptrArcPos <- mallocArray (3*20000)
     ptrArcCol <- mallocArray (4*20000)
-    ptrArcSca <- mallocArray (3*20000)
+    ptrArcSca <- mallocArray (4*20000)
 
     return $ PreloadData
         { _charMap      = convertRGBA8 cmap

src/Picture/Render.hs

@@ -60,6 +60,7 @@ 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 (RenderCirc (a,b,c)) = RenderCirc (f a,b,c)
+overPos f (RenderArc (a,b,c))  = RenderArc (f a,b,c)
 overPos _ RenderBlank = RenderBlank
 
 overCol :: (Point4 -> Point4) -> RenderType -> RenderType
@@ -67,12 +68,13 @@ overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
 overCol f (RenderLine vs) = RenderLine $ 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)
 overCol _ RenderBlank = RenderBlank
 
 scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
 {-# INLINE scaleRen #-}
 scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs
-scaleRen x y (RenderCirc (a,b,c)) = overPos (scale3 x y) $ RenderCirc (a,b,c)
+--scaleRen x y (RenderCirc (a,b,c)) = overPos (scale3 x y) $ RenderCirc (a,b,c)
 scaleRen x y rt = overPos (scale3 x y) rt
 {-# INLINE translateRen #-}
 translateRen x y = overPos $ translate3 x y
@@ -102,7 +104,9 @@ picToFTree :: Picture -> FTree RenderType
 picToFTree (Polygon ps) = FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
 picToFTree (PolygonCol vs) = let (ps,cs) = unzip vs
                              in  FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
-picToFTree (Circle r)   = FLeaf $ RenderCirc $ ((0.5,0,0),red,r)
+picToFTree (Circle r)   = FLeaf $ RenderCirc $ ((0,0,0),black,r)
+picToFTree (ThickArc startA endA rad wdth) 
+    = FLeaf $ RenderArc $ ((0,0,0),white,(startA,endA,rad,wdth))
 picToFTree Blank    = FLeaf $ RenderBlank
 picToFTree (Text s) = FLeaf $ RenderText $ stringToList s
 picToFTree (Scale x y pic) = FBranch (scaleRen x y) $ picToFTree pic
@@ -232,10 +236,19 @@ rotate3 :: Float -> Point3 -> Point3
 rotate3 a (x,y,z) = (x',y',z)
     where (x',y') = rotateV a (x,y)
 
+fSize = sizeOf (0 :: Float)
+
+bindArrayBuffers :: Int -> [(BufferObject,Ptr Float,Int)] -> IO ()
+bindArrayBuffers numVs ps = do
+    forM_ ps $ \(bo,ptr,i) -> do
+        bindBuffer ArrayBuffer $= Just bo
+        bufferData ArrayBuffer $= (fromIntegral $ fSize * numVs * i, ptr, StreamDraw)
+        
+
 renderPicture' :: PreloadData -> Float -> (Float,Float) -> Picture -> IO ()
 renderPicture' pdata zoom (winx,winy) pic = do
     let firstIndex = 0
-        fSize = sizeOf (0::Float)
+        numArcVs = 0
 
     (nTriVs,numVert',numCircVs,nLineVs) 
         <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
@@ -247,40 +260,47 @@ renderPicture' pdata zoom (winx,winy) pic = do
     depthFunc $= Just Less
 -- draw triangles
     currentProgram $= Just (_basicShader pdata)
-    bindVertexArrayObject $= Just (_basicVAO pdata)
+    bindArrayBuffers nTriVs [(_posVBO pdata, _ptrPosVBO pdata, 3)
-    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
+                            ,(_colVBO pdata, _ptrColVBO pdata, 4)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * nTriVs * 3, _ptrPosVBO pdata, StreamDraw)
+                            ]
-    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * nTriVs * 4, _ptrColVBO pdata, StreamDraw)
     drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
 -- draw lines, don't need to change the program or vaos, just need to bind the
 -- vbos and draw
-    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
+    bindArrayBuffers nLineVs 
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * nLineVs * 3, _ptrLinePos pdata, StreamDraw)
+        [(_posVBO pdata, _ptrLinePos pdata, 3)
-    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
+        ,(_colVBO pdata, _ptrLineCol pdata, 4)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * nLineVs * 4, _ptrLineCol pdata, StreamDraw)
+        ]
     drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs)
 -- draw circles
     currentProgram $= Just (_circShader pdata)
     uniform (_uniWinSize pdata) $= Vector2 winx winy
     uniform (_csZoomUni pdata)  $= zoom
     bindVertexArrayObject $= Just (_circVAO pdata)
-    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
+    bindArrayBuffers numCircVs 
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *3, _ptrCircPos pdata, StreamDraw)
+        [(_posVBO pdata, _ptrCircPos pdata, 3)
-    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
+        ,(_colVBO pdata, _ptrCircCol pdata, 4)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *4, _ptrCircCol pdata, StreamDraw)
+        ,(_texVBO pdata, _ptrCircSca pdata, 1)
-    bindBuffer ArrayBuffer $= Just (_texVBO pdata)
+        ]
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *1, _ptrCircSca pdata, StreamDraw)
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
-
+-- draw arcs
+    currentProgram $= Just (_arcShader pdata)
+    uniform (_asWinUni pdata) $= Vector2 winx winy
+    uniform (_asZoomUni pdata)  $= zoom
+    bindVertexArrayObject $= Just (_arcVAO pdata)
+    bindArrayBuffers numArcVs 
+        [(_posVBO pdata, _ptrArcPos pdata, 3)
+        ,(_colVBO pdata, _ptrArcCol pdata, 4)
+        ,(_texVBO pdata, _ptrArcSca pdata, 4)
+        ]
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numArcVs)
+-- draw text
     currentProgram $= Just (_textShader pdata)
     bindVertexArrayObject $= Just (_textVAO pdata)
-    bindBuffer ArrayBuffer $= Just (_posVBO pdata)
+    bindArrayBuffers numVert' 
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *3, _ptrCharPos pdata, StreamDraw)
+        [(_posVBO pdata, _ptrCharPos pdata, 3)
-    bindBuffer ArrayBuffer $= Just (_colVBO pdata)
+        ,(_colVBO pdata, _ptrCharCol pdata, 4)
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *4, _ptrCharCol pdata, StreamDraw)
+        ,(_texVBO pdata, _ptrCharTex pdata, 2)
-    bindBuffer ArrayBuffer $= Just (_texVBO pdata)
+        ]
-    bufferData ArrayBuffer $= (fromIntegral $ fSize * numVert' *2, _ptrCharTex pdata, StreamDraw)
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numVert')