justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow for interpolating colors from center to edge of ellipses

Browse Source
This commit is contained in:
jgk
2021-03-10 12:12:59 +01:00
parent 5a16086743
commit d3c8504d21
8 changed files with 128 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Weapons.hs
+4 -7
View File
@@ -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 )
+.+
src/Picture.hs
+6 -7
View File
@@ -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 #-}
src/Picture/Data.hs
+1 -2
View File
@@ -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)]
src/Picture/Preload.hs
+1 -1
View File
@@ -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
+49 -61
View File
@@ -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))