Partial fix of layering

This commit is contained in:
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)) Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (sp -.- p))
(reflectDir wl) Nothing (reflectDir wl) Nothing
_ -> id _ -> id
pic = case thHit of pic = pictures [ fadeLine sp (head ps) 0.5 40 yellow
Nothing -> , setLayer 2 $ color (withAlpha 0.9 white) $ vThickLine (sp:ps)
pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps) , setLayer 2 $ color (withAlpha 0.5 yellow) $ vvThickLine (sp:ps)
,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps) ]
,color (withAlpha 0.9 white) $ vThickLine (sp:ps) -- case thHit of
,fadeLine lp op 0.9 3 white -- Nothing ->
,fadeLine lp op 0.3 3 yellow -- pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
,fadeLine lp op 0.05 (a*20+40) yellow -- ,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
] -- ,color (withAlpha 0.9 white) $ vThickLine (sp:ps)
_ -> -- ,fadeLine lp op 0.9 3 white
pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps) -- ,fadeLine lp op 0.3 3 yellow
,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps) -- ,fadeLine lp op 0.05 (a*20+40) yellow
,color (withAlpha 0.9 white) $ vThickLine (sp:ps) -- ]
] -- _ ->
where lp = last ps -- pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps)
lp' = last $ init (sp:ps) -- ,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps)
op = lp +.+ 50 *.* normalizeV (lp -.- lp') -- ,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 :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
fadeLine sp ep alph width col = fadeLine sp ep alph width col = setLayer 2 $ color yellow $
pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25] polygon [sp +.+ n
,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5] ,sp
,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75] ,sp -.- n
,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep] ,ep -.- n
] ,ep
where p x = sp +.+ x *.* (ep -.- sp) ,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) closestOfThree :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,b) -> Maybe (Point2,c)
-> Maybe (Point2, Either3 a b 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) textureBinding Texture2D $= Just (_textures pdata !! 1)
drawArrays Points (fromIntegral 0) (fromIntegral 1) drawArrays Points (fromIntegral 0) (fromIntegral 1)
depthFunc $= Just Lequal
-- draw triangles -- draw triangles
currentProgram $= Just (_basicShader pdata) currentProgram $= Just (_basicShader pdata)
bindVertexArrayObject $= Just (_vao $ _triVAO pdata) bindVertexArrayObject $= Just (_vao $ _triVAO pdata)