Partial fix of layering

This commit is contained in:
jgk
2021-02-24 04:15:43 +01:00
parent 2afe40594e
commit 4db5fb44fe
2 changed files with 45 additions and 24 deletions
+43 -24
View File
@@ -1658,32 +1658,51 @@ moveLaser phaseV pos dir mcid w pt
Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (sp -.- p))
(reflectDir wl) Nothing
_ -> id
pic = case thHit of
Nothing ->
pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
,fadeLine lp op 0.9 3 white
,fadeLine lp op 0.3 3 yellow
,fadeLine lp op 0.05 (a*20+40) yellow
]
_ ->
pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
]
where lp = last ps
lp' = last $ init (sp:ps)
op = lp +.+ 50 *.* normalizeV (lp -.- lp')
pic = pictures [ fadeLine sp (head ps) 0.5 40 yellow
, setLayer 2 $ color (withAlpha 0.9 white) $ vThickLine (sp:ps)
, setLayer 2 $ color (withAlpha 0.5 yellow) $ vvThickLine (sp:ps)
]
-- case thHit of
-- Nothing ->
-- pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
-- ,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
-- ,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
-- ,fadeLine lp op 0.9 3 white
-- ,fadeLine lp op 0.3 3 yellow
-- ,fadeLine lp op 0.05 (a*20+40) yellow
-- ]
-- _ ->
-- pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
-- ,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
-- ,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
-- ]
-- where lp = last ps
-- lp' = last $ init (sp:ps)
-- op = lp +.+ 50 *.* normalizeV (lp -.- lp')
fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
fadeLine sp ep alph width col =
pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25]
,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5]
,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75]
,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep]
]
where p x = sp +.+ x *.* (ep -.- sp)
fadeLine sp ep alph width col = setLayer 2 $ color yellow $
polygon [sp +.+ n
,sp
,sp -.- n
,ep -.- n
,ep
,ep +.+ n
]
-- polygonCol [(sp +.+ n, col)
-- ,(sp , col)
-- ,(sp -.- n, col)
-- ,(ep -.- n, col)
-- ,(ep , col)
-- ,(ep +.+ n, withAlpha 0 col)
-- ]
where n = width *.* (normalizeV $ normV $ ep -.- sp)
-- pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25]
-- ,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5]
-- ,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75]
-- ,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep]
-- ]
-- where p x = sp +.+ x *.* (ep -.- sp)
closestOfThree :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,b) -> Maybe (Point2,c)
-> Maybe (Point2, Either3 a b c)
+2
View File
@@ -412,6 +412,8 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
textureBinding Texture2D $= Just (_textures pdata !! 1)
drawArrays Points (fromIntegral 0) (fromIntegral 1)
depthFunc $= Just Lequal
-- draw triangles
currentProgram $= Just (_basicShader pdata)
bindVertexArrayObject $= Just (_vao $ _triVAO pdata)