From d3c8504d213ead38c7085dddb84b7fd7b0156fbe Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 10 Mar 2021 12:12:59 +0100 Subject: [PATCH] Allow for interpolating colors from center to edge of ellipses --- shader/ellipseInterpolate.frag | 15 +++++ shader/ellipseInterpolate.geom | 36 +++++++++++ shader/ellipseInterpolate.vert | 16 +++++ src/Dodge/Weapons.hs | 11 ++-- src/Picture.hs | 13 ++-- src/Picture/Data.hs | 3 +- src/Picture/Preload.hs | 2 +- src/Picture/Render.hs | 110 +++++++++++++++------------------ 8 files changed, 128 insertions(+), 78 deletions(-) create mode 100644 shader/ellipseInterpolate.frag create mode 100644 shader/ellipseInterpolate.geom create mode 100644 shader/ellipseInterpolate.vert diff --git a/shader/ellipseInterpolate.frag b/shader/ellipseInterpolate.frag new file mode 100644 index 000000000..9f2073c76 --- /dev/null +++ b/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 diff --git a/shader/ellipseInterpolate.geom b/shader/ellipseInterpolate.geom new file mode 100644 index 000000000..9deea4868 --- /dev/null +++ b/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(); +} diff --git a/shader/ellipseInterpolate.vert b/shader/ellipseInterpolate.vert new file mode 100644 index 000000000..7abf7b24a --- /dev/null +++ b/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; +} diff --git a/src/Dodge/Weapons.hs b/src/Dodge/Weapons.hs index 0cce0a40e..c6d951c95 100644 --- a/src/Dodge/Weapons.hs +++ b/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' - $ color (withAlpha 0.01 orange) - $ circleSolid 50 + glow p' = setLayer 1 $ onLayerL [levLayer UPtLayer,0] $ uncurry translate p' + $ circleSolidCol (withAlpha 0 orange) + (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 ) +.+ diff --git a/src/Picture.hs b/src/Picture.hs index 748243911..a754cb544 100644 --- a/src/Picture.hs +++ b/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 +circleSolid = Circle 0 white white + +circleSolidCol :: Color -> Color -> Float -> Picture +{-# INLINE circleSolidCol #-} +circleSolidCol = Circle 0 circle :: Float -> Picture {-# INLINE circle #-} diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index b558c659b..b545c19f4 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -68,8 +68,7 @@ data Picture | Text Int String | Polygon Int [Point2] | PolygonCol Int [(Point2,RGBA)] - | Circle Int Float - | Ellipse Int Point2 Point2 Float + | Circle Int RGBA RGBA Float | ThickArc Int Float Float Float Float | Line Int [Point2] | LineCol Int [(Point2,RGBA)] diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 08d361bb9..2ccc1dada 100644 --- a/src/Picture/Preload.hs +++ b/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" diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index a3e40850a..0cb05014e 100644 --- a/src/Picture/Render.hs +++ b/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 -{-# INLINE picToAlt #-} -picToAlt x (Polygon i ps) - | i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black - | otherwise = Ap.empty -picToAlt x (PolygonCol i vs) - | i /= x = Ap.empty - | otherwise = - let (ps,cs) = unzip vs - in Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs -picToAlt x (Circle i r) - | i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r) - | otherwise = Ap.empty -picToAlt x (Ellipse i (ax,ay) (bx,by) r) - | i == x = Ap.pure $ RenderEllipse [((ax,ay+r,0),black) - ,((ax,ay-r,0),black) - ,((bx,by-r,0),black) - ] - | otherwise = Ap.empty -picToAlt x (ThickArc i startA endA rad wdth) - | i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth)) - | otherwise = Ap.empty -picToAlt x (Line i ps) - | i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white - | otherwise = Ap.empty -picToAlt x (Text i s) - | i == x = Ap.pure $ RenderText $ stringToList s - | otherwise = Ap.empty -picToAlt j Blank = Ap.empty -picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics +--picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType +--{-# INLINE picToAlt #-} +--picToAlt x (Polygon i ps) +-- | i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black +-- | otherwise = Ap.empty +--picToAlt x (PolygonCol i vs) +-- | i /= x = Ap.empty +-- | otherwise = +-- let (ps,cs) = unzip vs +-- in Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs +--picToAlt x (Circle i r) +-- | i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r) +-- | otherwise = Ap.empty +--picToAlt x (Ellipse i (ax,ay) (bx,by) r) +-- | i == x = Ap.pure $ RenderEllipse [((ax,ay+r,0),black) +-- ,((ax,ay-r,0),black) +-- ,((bx,by-r,0),black) +-- ] +-- | otherwise = Ap.empty +--picToAlt x (ThickArc i startA endA rad wdth) +-- | i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth)) +-- | otherwise = Ap.empty +--picToAlt x (Line i ps) +-- | i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white +-- | otherwise = Ap.empty +--picToAlt x (Text i s) +-- | i == x = Ap.pure $ RenderText $ stringToList s +-- | otherwise = Ap.empty +--picToAlt j Blank = Ap.empty +--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 - | Nothing == mx = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black - | otherwise = LBranches [] -picToLTree mx (PolygonCol i vs) - | Just i == mx || Nothing == mx = - let (ps,cs) = unzip vs - in LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs - | otherwise = LBranches [] -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 [] + = filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black +picToLTree mx (PolygonCol i vs) = + filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs + where (ps,cs) = unzip vs +picToLTree mx (Circle i colC colE r) + = filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC) + ,( (-r,-r,0), colE) + ,( ( r,-r,0), black) + ] picToLTree mx (ThickArc i startA endA rad wdth) - | Just i == mx || Nothing == mx = LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth)) - | otherwise = LBranches [] + = filtB mx i $ LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth)) picToLTree mx (Line i ps) - | Just i == mx || Nothing == mx = LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white - | otherwise = LBranches [] + = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white picToLTree mx (LineCol i vs) - | Just i == mx || Nothing == mx = - let (ps,cs) = unzip vs - in LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs - | otherwise = LBranches [] + = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs + where (ps,cs) = unzip vs picToLTree mx (Text i s) - | Just i == mx || Nothing == mx = LLeaf $ RenderText $ stringToList s - | otherwise = LBranches [] + = filtB mx i $ LLeaf $ RenderText $ stringToList s 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))