Partial fix of layering
This commit is contained in:
+43
-24
@@ -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)
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user