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))
|
||||
(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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user