Allow for interpolating colors from center to edge of ellipses

shader/ellipseInterpolate.frag

@@ -0,0 +1,15 @@
+#version 430 core
+in vec4 gColorC;
+in vec4 gColorE;
+in vec2 gBoundingBox;
+
+out vec4 fColor;
+//out float gl_FragDepth;
+
+void main()
+{
+  float d = dot(gBoundingBox,gBoundingBox);
+  if ( d > 1) { discard; }
+  fColor = mix (gColorE , gColorC, d);
+}
+//note it is the fragdepth that stops this from being square

shader/ellipseInterpolate.geom

@@ -0,0 +1,36 @@
+#version 430 core
+layout (triangles) in;
+layout (triangle_strip, max_vertices = 4) out;
+in vec4 vCol[];
+out vec4 gColorC;
+out vec4 gColorE;
+out vec2 gBoundingBox;
+
+uniform vec2 winSize;
+uniform float zoom;
+
+void main()
+{
+  vec3 pa = gl_in[0].gl_Position.xyz;
+  vec3 pb = gl_in[1].gl_Position.xyz;
+  vec3 pc = gl_in[2].gl_Position.xyz;
+  gColorC = vCol[0];
+  gColorE = vCol[1];
+
+  gBoundingBox = vec2 (-1,1);
+  gl_Position = vec4 (pb, 1);
+  //gl_Position = vec4 (0.5,0,0, 1);
+  EmitVertex();
+  gBoundingBox = vec2 (1,1);
+  gl_Position = vec4 (pa, 1);
+  EmitVertex();
+  gBoundingBox = vec2 (-1,-1);
+  gl_Position = vec4 (pc, 1);
+//  gl_Position = vec4 (0.5,0.5,0, 1);
+  EmitVertex();
+  gBoundingBox = vec2 (1,-1);
+  gl_Position = vec4 (pa + pc - pb, 1);
+  EmitVertex();
+
+  EndPrimitive();
+}

shader/ellipseInterpolate.vert

@@ -0,0 +1,16 @@
+#version 430 core
+layout (location = 0) in vec3 position;
+layout (location = 1) in vec4 col;
+out vec4 vCol;
+
+uniform vec2 winSize;
+uniform float zoom;
+uniform vec2 translation;
+uniform float rotation;
+uniform mat4 worldMat;
+
+void main()
+{
+  gl_Position = worldMat * vec4(position,1);
+  vCol = col;
+}

src/Dodge/Weapons.hs

@@ -1065,14 +1065,11 @@ moveFlame rotd w pt =
                 rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
                                    , _btVel' = reflV wl, _ptPict' = thepic $ pOut p
                                    }
-                glow p' = setLayer 2 $ onLayerL [levLayer UPtLayer,0] $ uncurry translate p'
+                glow p' = setLayer 1 $ onLayerL [levLayer UPtLayer,0] $ uncurry translate p'
-                            $ color (withAlpha 0.01 orange)
+                            $ circleSolidCol (withAlpha 0 orange)
-                            $ circleSolid 50
+                            (withAlpha 0.02 orange) -- (withAlpha 0 orange) 50
+                            50
                 pOut p = p +.+ safeNormalizeV (sp -.- p)
-                --reflV wall = (0.6 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
-                --                        vel )
-                --                +.+
-                --             (0.4 *.* vel)
                 reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
                                         vel )
                                 +.+

src/Picture.hs

@@ -9,8 +9,8 @@ module Picture
     , thickArc
     , thickCircle
     , circleSolid
+    , circleSolidCol
     , circle
-    , ellipseSolid
     , line
     , lineCol
     , text
@@ -119,14 +119,13 @@ makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
     where as = [a,a+step.. b]
           step = pi * 0.2
 
-ellipseSolid :: Point2 -> Point2 -> Float -> Picture
-{-# INLINE ellipseSolid #-}
-ellipseSolid = Ellipse 0
-
 circleSolid :: Float -> Picture
 {-# INLINE circleSolid #-}
---circleSolid rad = polygon $ makeArc rad (0,2*pi)
+circleSolid = Circle 0 white white
-circleSolid = Circle 0
+
+circleSolidCol :: Color -> Color -> Float -> Picture
+{-# INLINE circleSolidCol #-}
+circleSolidCol = Circle 0
 
 circle :: Float -> Picture
 {-# INLINE circle #-}

src/Picture/Data.hs

@@ -68,8 +68,7 @@ data Picture
     | Text Int String
     | Polygon Int [Point2]
     | PolygonCol Int [(Point2,RGBA)]
-    | Circle Int Float
+    | Circle Int RGBA RGBA Float
-    | Ellipse Int Point2 Point2 Float
     | ThickArc Int Float Float Float Float
     | Line Int [Point2]
     | LineCol Int [(Point2,RGBA)]

src/Picture/Preload.hs

@@ -105,7 +105,7 @@ preloadRender = do
     fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
     bgs <- makeSourcedShader "background" [VertexShader,GeometryShader,FragmentShader]
     wss <- makeSourcedShader "wallShadow" [VertexShader,GeometryShader,FragmentShader]
-    es  <- makeSourcedShader "ellipse"     [VertexShader,GeometryShader,FragmentShader]
+    es  <- makeSourcedShader "ellipseInterpolate"     [VertexShader,GeometryShader,FragmentShader]
 
     wssLightPosUniLoc   <- GL.uniformLocation (fst wss) "lightPos"
 

src/Picture/Render.hs

@@ -118,80 +118,68 @@ charToTuple :: Char -> (Point3,Point4,Point3)
 charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
     where offset = fromIntegral (fromEnum c) - 32
 
-picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType
+--picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType
-{-# INLINE picToAlt #-}
+--{-# INLINE picToAlt #-}
-picToAlt x (Polygon i ps) 
+--picToAlt x (Polygon i ps) 
-    | i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
+--    | i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
-    | otherwise = Ap.empty
+--    | otherwise = Ap.empty
-picToAlt x (PolygonCol i vs) 
+--picToAlt x (PolygonCol i vs) 
-    | i /= x = Ap.empty 
+--    | i /= x = Ap.empty 
-    | otherwise = 
+--    | otherwise = 
-        let (ps,cs) = unzip vs
+--        let (ps,cs) = unzip vs
-        in  Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
+--        in  Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
-picToAlt x (Circle i r) 
+--picToAlt x (Circle i r) 
-    | i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r)
+--    | i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r)
-    | otherwise = Ap.empty
+--    | otherwise = Ap.empty
-picToAlt x (Ellipse i (ax,ay) (bx,by) r) 
+--picToAlt x (Ellipse i (ax,ay) (bx,by) r) 
-    | i == x = Ap.pure $ RenderEllipse [((ax,ay+r,0),black)
+--    | i == x = Ap.pure $ RenderEllipse [((ax,ay+r,0),black)
-                                       ,((ax,ay-r,0),black)
+--                                       ,((ax,ay-r,0),black)
-                                       ,((bx,by-r,0),black)
+--                                       ,((bx,by-r,0),black)
-                                       ]
+--                                       ]
-    | otherwise = Ap.empty
+--    | otherwise = Ap.empty
-picToAlt x (ThickArc i startA endA rad wdth) 
+--picToAlt x (ThickArc i startA endA rad wdth) 
-    | i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
+--    | i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
-    | otherwise = Ap.empty
+--    | otherwise = Ap.empty
-picToAlt x (Line i ps) 
+--picToAlt x (Line i ps) 
-    | i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
+--    | i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
-    | otherwise = Ap.empty
+--    | otherwise = Ap.empty
-picToAlt x (Text i s) 
+--picToAlt x (Text i s) 
-    | i == x = Ap.pure $ RenderText $ stringToList s
+--    | i == x = Ap.pure $ RenderText $ stringToList s
-    | otherwise = Ap.empty
+--    | otherwise = Ap.empty
-picToAlt j Blank = Ap.empty
+--picToAlt j Blank = Ap.empty
-picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
+--picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
 
 collapseBranch :: (RenderType -> RenderType) -> FTree RenderType -> FTree RenderType
 collapseBranch f (FBranch g t) = FBranch (f . g) t
 collapseBranch f (FBranches ts) = FBranches $ map (collapseBranch f) ts
 collapseBranch f (FLeaf x) = FLeaf (f x)
 
+filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
+{-# INLINE filtB #-}
+filtB mx i t | Just i == mx || Nothing == mx = t
+             | otherwise                     = LBranches []
+
 picToLTree :: Maybe Int -> Picture -> LTree RenderType
 {-# INLINE picToLTree #-}
 picToLTree mx (Polygon i ps)
-    | Just i == mx = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
+    = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
-    | Nothing == mx = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
+picToLTree mx (PolygonCol i vs) = 
-    | otherwise = LBranches []
+    filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
-picToLTree mx (PolygonCol i vs) 
+        where (ps,cs) = unzip vs
-    | Just i == mx || Nothing == mx = 
+picToLTree mx (Circle i colC colE r)
-        let (ps,cs) = unzip vs
+    = filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC)
-        in  LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
+                                         ,( (-r,-r,0), colE)
-    | otherwise = LBranches []
+                                         ,( ( r,-r,0), black)
-picToLTree mx (Circle i r) 
-    | Just i == mx || Nothing == mx = LLeaf $ RenderEllipse
-                                                [((-r, r,0), black)
-                                                ,((-r,-r,0), black)
-                                                ,(( r,-r,0), black)
                                          ]
-    | otherwise = LBranches []
-picToLTree mx (Ellipse i (ax,ay) (bx,by) r) 
-    | Just i == mx || Nothing == mx = LLeaf $ RenderEllipse [((ax,ay+r,0),black)
-                                       ,((ax,ay-r,0),black)
-                                       ,((bx,by-r,0),black)
-                                       ]
-    | otherwise = LBranches []
 picToLTree mx (ThickArc i startA endA rad wdth) 
-    | Just i == mx || Nothing == mx = LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
+    = filtB mx i $ LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
-    | otherwise = LBranches []
 picToLTree mx (Line i ps) 
-    | Just i == mx || Nothing == mx = LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
+    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
-    | otherwise = LBranches []
 picToLTree mx (LineCol i vs) 
-    | Just i == mx || Nothing == mx = 
+    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
-        let (ps,cs) = unzip vs
+        where (ps,cs) = unzip vs
-        in  LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
-    | otherwise = LBranches []
 picToLTree mx (Text i s) 
-    | Just i == mx || Nothing == mx = LLeaf $ RenderText $ stringToList s
+    = filtB mx i $ LLeaf $ RenderText $ stringToList s
-    | otherwise = LBranches []
 picToLTree j Blank = LBranches []
 picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
 picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic))