Tweak drawing order, text now blocks window shadows

This commit is contained in:
2021-02-24 23:08:20 +01:00
parent 8a4169653f
commit 1969aa4f4a
6 changed files with 28 additions and 19 deletions
+8 -6
View File
@@ -173,7 +173,7 @@ drawCursor :: World -> Picture
drawCursor w = translate (105-halfWidth w) drawCursor w = translate (105-halfWidth w)
(halfHeight w - (25* (fromIntegral iPos)) - 20 (halfHeight w - (25* (fromIntegral iPos)) - 20
) )
$ setLayer 2 $ setLayer 1
$ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)] $ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)]
where iPos = _crInvSel $ _creatures w IM.! _yourID w where iPos = _crInvSel $ _creatures w IM.! _yourID w
@@ -340,17 +340,19 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
drawWallShadow :: World -> Wall -> Drawing drawWallShadow :: World -> Wall -> Drawing
drawWallShadow w wall drawWallShadow w wall
| isRHS sightFrom x y = blank | isRHS sightFrom x y = blank
| otherwise = onLayerL l $ color shadCol $ polygon $ points -- | otherwise = onLayerL l $ color shadCol $ polygon $ points
| otherwise = colorAndLayer $ polygon $ points
where where
l | _wlIsSeeThrough wall = [levLayer ShadowLayer] colorAndLayer | _wlIsSeeThrough wall = setLayer 2
| otherwise = [levLayer ShadowLayer, 0] . onLayerL [levLayer ShadowLayer]
. color (withAlpha 0.2 $ _wlColor wall)
| otherwise = onLayerL [levLayer ShadowLayer,2]
. color black
(x:y:_) = _wlLine wall (x:y:_) = _wlLine wall
ps = linePointsBetween x y ps = linePointsBetween x y
ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps
p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps
sightFrom = _cameraCenter w sightFrom = _cameraCenter w
shadCol = if _wlIsSeeThrough wall then withAlpha 0.2 $ _wlColor wall
else black
corns = screenPolygon w corns = screenPolygon w
borders = filter g $ zip corns (tail corns ++ [head corns]) borders = filter g $ zip corns (tail corns ++ [head corns])
g (a,b) = isLHS a b sightFrom g (a,b) = isLHS a b sightFrom
+6 -1
View File
@@ -48,6 +48,7 @@ lev1 = do
-- [randomiseLinks =<< pistolerRoom] -- [randomiseLinks =<< pistolerRoom]
[return $ return $ Right deadEndRoom [return $ return $ Right deadEndRoom
] ]
++ [roomMiniIntro]
++ [return $ connectRoom corridor ++ [return $ connectRoom corridor
,return $ connectRoom door] ,return $ connectRoom door]
-- ++ [randomiseLinks =<< longRoom] -- ++ [randomiseLinks =<< longRoom]
@@ -342,9 +343,11 @@ glassLesson = do
botplmnts = [PS (0,0) 0 $ PutWindow (rectNSWE (200) 0 (90) (110)) botplmnts = [PS (0,0) 0 $ PutWindow (rectNSWE (200) 0 (90) (110))
$ withAlpha 0.5 aquamarine $ withAlpha 0.5 aquamarine
,PS (50,100) 0 $ PutCrit miniGunCrit ,PS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 basicLS
] ]
topplmnts = [PS (0,0) 0 $ PutWindowBlock (100,200) (100,0) topplmnts = [PS (0,0) 0 $ PutWindowBlock (100,200) (100,0)
,PS (50,100) 0 $ PutCrit miniGunCrit ,PS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 basicLS
] ]
miniRoom1 :: RandomGen g => State g Room miniRoom1 :: RandomGen g => State g Room
@@ -689,6 +692,7 @@ slowDoorRoom = do
xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10) xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10)
ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y) ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y)
let crits = zipWith (\p r -> PS p r randC1) ps rs let crits = zipWith (\p r -> PS p r randC1) ps rs
lsources = [PS (x/2,30) 0 basicLS, PS (x/2,y-30) 0 basicLS]
let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys' let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
let pillarsa = [] let pillarsa = []
let pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20) let pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
@@ -704,7 +708,7 @@ slowDoorRoom = do
-- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h) -- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
] ]
fmap connectRoom (filterLinks cond =<< (changeLinkTo cond2 fmap connectRoom (filterLinks cond =<< (changeLinkTo cond2
$ set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels) $ set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
$ roomRect x y $ roomRect x y
)) ))
longRoom :: RandomGen g => State g Room longRoom :: RandomGen g => State g Room
@@ -877,6 +881,7 @@ spawnerRoom = do
let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
-- ,PS (0,0) 0 $ PutWindowBlock (x/2,0) (x/2,y-60) -- ,PS (0,0) 0 $ PutWindowBlock (x/2,0) (x/2,y-60)
,wl ,wl
,PS (x/2, y-10) 0 basicLS
] ]
let f ((lx,_),_) = lx < x/2-5 let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- randomiseLinks =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2) roomWithSpawner <- randomiseLinks =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2)
+6 -6
View File
@@ -1020,7 +1020,7 @@ moveFlame rotd w pt =
((:) $ Flaming (div time 10) sp p ep) ((:) $ Flaming (div time 10) sp p ep)
hiteff = _btHitEffect' pt pt hiteff = _btHitEffect' pt pt
thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ] thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ]
pic p' = setLayer 2 $ onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p') pic p' = setLayer 1 $ onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p')
$ rotate (pi * 0.5 + argV rotd) $ rotate (pi * 0.5 + argV rotd)
$ scale scaleChange 1 $ scale scaleChange 1
-- $ color white -- $ color white
@@ -1030,7 +1030,7 @@ moveFlame rotd w pt =
] ]
-- $ rotate (radToDeg (fromIntegral time * 10)) -- $ rotate (radToDeg (fromIntegral time * 10))
-- $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)] -- $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)]
pi2 p' = setLayer 2 $ onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p') pi2 p' = setLayer 1 $ onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p')
-- $ rotate ( (fromIntegral time * 5)) -- $ rotate ( (fromIntegral time * 5))
$ rotate (pi * 0.5 + argV rotd) $ rotate (pi * 0.5 + argV rotd)
-- $ color (mixColors 0.5 0.5 orange white) -- $ color (mixColors 0.5 0.5 orange white)
@@ -1659,8 +1659,8 @@ moveLaser phaseV pos dir mcid w pt
(reflectDir wl) Nothing (reflectDir wl) Nothing
_ -> id _ -> id
pic = pictures [ fadeLine sp (head ps) 0.2 40 yellow pic = pictures [ fadeLine sp (head ps) 0.2 40 yellow
, setLayer 2 $ color (withAlpha 0.9 white) $ vThickLine (sp:ps) , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (sp:ps)
, setLayer 2 $ color (withAlpha 0.5 yellow) $ vvThickLine (sp:ps) , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (sp:ps)
] ]
-- case thHit of -- case thHit of
-- Nothing -> -- Nothing ->
@@ -1681,7 +1681,7 @@ moveLaser phaseV pos dir mcid w pt
-- op = lp +.+ 50 *.* normalizeV (lp -.- lp') -- 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 = setLayer 2 $ fadeLine sp ep alph width col = setLayer 1 $
polygonCol [(sp , ca) polygonCol [(sp , ca)
,(sp +.+ n , cb) ,(sp +.+ n , cb)
,(ep +.+ n , cb) ,(ep +.+ n , cb)
@@ -2071,7 +2071,7 @@ moveTeslaArc p d i w =
$ set randGen g $ set randGen g
$ createSpark 8 nc q2 (argV sv + d1) Nothing $ createSpark 8 nc q2 (argV sv + d1) Nothing
$ foldr damCrs w hitCrs $ foldr damCrs w hitCrs
where pic = setLayer 2 $ pictures where pic = setLayer 1 $ pictures
[ onLayer PtLayer $ color (f2 nc) $ line ps' [ onLayer PtLayer $ color (f2 nc) $ line ps'
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps'
, onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps'
+1 -1
View File
@@ -595,7 +595,7 @@ mvGenBullet' w bt
wth = _btWidth' bt wth = _btWidth' bt
t = _btTimer' bt t = _btTimer' bt
bulLine c w = setLayer 2 . bulLinea c w bulLine c w = setLayer 1 . bulLinea c w
bulLinea :: Color -> Float -> [Point2] -> Picture bulLinea :: Color -> Float -> [Point2] -> Picture
bulLinea _ _ [] = blank bulLinea _ _ [] = blank
+1 -1
View File
@@ -158,7 +158,7 @@ circle rad = thickArc 0 (2*pi) rad 1
text :: String -> Picture text :: String -> Picture
{-# INLINE text #-} {-# INLINE text #-}
text = Text 2 text = Text 1
line :: [Point2] -> Picture line :: [Point2] -> Picture
{-# INLINE line #-} {-# INLINE line #-}
+6 -4
View File
@@ -309,17 +309,19 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
-- draw picture -- draw picture
-- set drawing for on top -- set drawing for on top
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
clear [DepthBuffer] clear [DepthBuffer]
-- draw layer 0 -- draw layer 0
renderTree pdata rot zoom (tranx,trany) (winx,winy) (picToFTree 0 pic) renderTree pdata rot zoom (tranx,trany) (winx,winy) (picToFTree 0 pic)
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 1 pic
-- reset blend so that light map doesn't apply -- reset blend so that light map doesn't apply
blendFunc $= (SrcAlpha,OneMinusSrcAlpha) blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 1 pic
-- set drawing for on top
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 2 pic renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 2 pic
-- --
---- poke necessary data ---- poke necessary data