diff --git a/shader/bezierQuad.frag b/shader/bezierQuad.frag index 47b0565a6..29a42bfde 100644 --- a/shader/bezierQuad.frag +++ b/shader/bezierQuad.frag @@ -1,6 +1,8 @@ #version 430 core in vec4 gColor; in vec3 gBoundingBox; +in float gRadStart; +in float gRadEnd; out vec4 fColor; @@ -8,7 +10,8 @@ float x = gBoundingBox.x; float y = gBoundingBox.y; float z = gBoundingBox.z; -float w = 0.1; +float w = gRadEnd; +float w2 = gRadStart; float f (float a, float b) { @@ -17,10 +20,9 @@ float f (float a, float b) } void main() { - //float d = x - y - 1 + 2* sqrt(y); float d = sqrt(x) + sqrt(y) - 1; - float e = sqrt(f(x,w)) + sqrt(f(y,w)) - 1; + float e = sqrt(f(x,w)) + sqrt(f(y,w2)) - 1.0; if ( d < 0 || e > 0) { discard; } fColor = gColor; // if ( d < 0) { fColor = vec4 (0,1,0,1); } diff --git a/shader/bezierQuad.geom b/shader/bezierQuad.geom index 670a30abd..3d19afbb7 100644 --- a/shader/bezierQuad.geom +++ b/shader/bezierQuad.geom @@ -2,7 +2,10 @@ layout (triangles) in; layout (triangle_strip, max_vertices = 3) out; in vec4 vColor[]; +in float vRad[]; out vec4 gColor; +out float gRadStart; +out float gRadEnd; out vec3 gBoundingBox; void main() @@ -11,6 +14,8 @@ void main() vec3 pb = gl_in[1].gl_Position.xyz; vec3 pc = gl_in[2].gl_Position.xyz; + gRadStart = vRad[0]; + gRadEnd = vRad[2]; // vec3 pa = vec3(paa.xy + 0.1 * (paa.xy - pca.xy), paa.z); // vec3 pc = vec3(pca.xy + 0.1 * (pca.xy - paa.xy), pca.z); diff --git a/shader/bezierQuad.vert b/shader/bezierQuad.vert index aac780c96..cbec90230 100644 --- a/shader/bezierQuad.vert +++ b/shader/bezierQuad.vert @@ -1,7 +1,9 @@ #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; uniform vec2 winSize; uniform float zoom; @@ -13,4 +15,5 @@ void main() { gl_Position = worldMat * vec4(position.xyz,1); vColor = color; + vRad = rad; } diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index f73a0221c..793700ad7 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -121,7 +121,7 @@ worldPictures w where tst x y sc t = translate x y $ scale sc sc $ color white $ text t testPic :: World -> [Picture] -testPic w = [setLayer 1 $ onLayerL [99] $ color red $ bezierQuad (-200,200) (-200,-200) (200,200) ] +testPic w = [setLayer 1 $ onLayerL [99] $ bezierQuad white red 5 50 (-200,200) (-200,-200) (00,00) ] -- $ uncurry translate (mouseWorldPos w) diff --git a/src/Picture.hs b/src/Picture.hs index d4790ccf5..3570db576 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -69,8 +69,20 @@ polygonCol :: [(Point2,RGBA)] -> Picture {-# INLINE polygonCol #-} polygonCol = PolygonCol 0 -bezierQuad :: Point2 -> Point2 -> Point2 -> Picture -bezierQuad a b c = BezierQuad 0 [a,b,c] +-- note that much of work computing the width of the bezier curve is done here +-- not sure that moving the control point does much... +bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture +bezierQuad cola colc ra rc a b c = BezierQuad 0 [(aX,cola ,raX) + ,(bx,mixColors 0.5 0.5 cola colc,1) + ,(cX,colc ,rcX)] + where v = a -.- c + nv = normalizeV v + aX = a +.+ ra * 0.5 *.* nv + cX = c -.- rc * 0.5 *.* nv + raX = ra / magV (aX -.- cX) + rcX = rc / magV (aX -.- cX) + bx = b +.+ (0.5 * ra *.* normalizeV (b -.- a)) + +.+ (0.5 * rc *.* normalizeV (b -.- c)) color :: RGBA -> Picture -> Picture {-# INLINE color #-} diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 5cf63a2ed..1b4e555f2 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -22,7 +22,7 @@ import Data.Traversable data RenderType = RenderPoly [(Point3,Point4)] - | RenderBezQ [(Point3,Point4)] + | RenderBezQ [(Point3,Point4,Float)] | RenderText [(Point3,Point4,Point3)] | RenderArc (Point3,Point4,Point4) | RenderLine [(Point3,Point4)] @@ -75,7 +75,7 @@ data Picture = Blank | Text Int String | Polygon Int [Point2] - | BezierQuad Int [Point2] + | BezierQuad Int [(Point2,RGBA,Float)] | PolygonCol Int [(Point2,RGBA)] | Circle Int RGBA RGBA Float | ThickArc Int Float Float Float Float diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index b9fa41774..cddbc54e2 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -50,7 +50,7 @@ preloadRender = do "data/texture/charMap.png" bezierQuadShader - <- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeBezQStrat + <- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4),(2,1)] Triangles pokeBezQStrat --the following vbo is set up to contain one fixed vertex dummyvbo <- genObjectName @@ -84,7 +84,7 @@ cleanUpRenderPreload pd = do {-# INLINE pokeBezQStrat #-} pokeBezQStrat :: RenderType -> [[[Float]]] -pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs +pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),s) -> [[x,y,z],[r,g,b,a],[s]]) vs pokeBezQStrat _ = [] {-# INLINE pokeTriStrat #-} diff --git a/src/Picture/Tree.hs b/src/Picture/Tree.hs index 679475507..c675b8d77 100644 --- a/src/Picture/Tree.hs +++ b/src/Picture/Tree.hs @@ -17,8 +17,10 @@ picToLTree mx (Polygon i ps) picToLTree mx (PolygonCol i vs) = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs where (ps,cs) = unzip vs -picToLTree mx (BezierQuad i ps) - = filtB mx i $ LLeaf $ RenderBezQ $ zip (map zeroZ $ ps) $ repeat black +picToLTree mx (BezierQuad i vs) + = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs + where (ps,cols,rs) = unzip3 vs + picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC) ,( (-r,-r,0), colE) @@ -68,9 +70,9 @@ 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 (RenderBezQ vs) = RenderBezQ $ 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 (RenderBezQ vs) = RenderBezQ $ 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) @@ -82,10 +84,10 @@ overRot _ ren = ren overCol :: (Point4 -> Point4) -> RenderType -> RenderType {-# INLINE overCol #-} overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs -overCol f (RenderBezQ vs) = RenderBezQ $ 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 (RenderBezQ vs) = RenderBezQ $ 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