Stop bullets drawing over extended top of walls

This commit is contained in:
jgk
2021-03-22 00:46:54 +01:00
parent f19f879945
commit 5c23e0a348
3 changed files with 6 additions and 16 deletions
-3
View File
@@ -724,9 +724,6 @@ crInPolygon cr xs = errorPointInPolygon 3 (_crPos cr) xs
onLayer :: Layer -> Picture -> Picture
onLayer l = setDepth $ 1 - fromIntegral (levLayer l) / 100
--onLayer :: Layer -> Picture -> [(Picture, [Int])]
--onLayer l p = [(p, [levLayer l])]
onLayerL :: [Int] -> Picture -> Picture
onLayerL is = setDepth (1 - (sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
+6 -6
View File
@@ -67,11 +67,11 @@ worldPictures w
, ptPicts'
, afterPtPicts'
, wlPicts
, map (color $ withAlpha 0 black) wlPicts'
, smokeShadows
, ppLabels
, btLabels
, testPic w
, wallsToSetDepth
]
where
decPicts = IM.elems $ _decorations w
@@ -83,8 +83,8 @@ worldPictures w
crPicts = map crDraw $ IM.elems $ _creatures w
clPicts = map clDraw $ IM.elems $ _clouds w
smokeShadows = map (drawSmokeShadow w) $ _smoke w
wlPicts' = map (drawWallFace w) (wallShadowsToDraw w)
wlPicts = map drawWallFloor (wallFloorsToDraw w)
wallsToSetDepth = map (drawWallFace w) (wallShadowsToDraw w)
itFloorPicts = map drawItem (IM.elems (_floorItems w))
yourPos = _crPos $ you w
yourRot = _crDir $ you w
@@ -241,7 +241,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
drawWallFloor :: Wall -> Picture
drawWallFloor wl = if _wlIsSeeThrough wl
then onLayerL [0] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
else blank
where
(x:y:_) = _wlLine wl
@@ -300,7 +300,7 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
drawWallFace :: World -> Wall -> Picture
drawWallFace w wall
| isRHS sightFrom x y || _wlIsSeeThrough wall = blank
| otherwise = setLayer 3 . setDepth (-1) . polygon $ points
| otherwise = setDepth (-0.1) . polygon $ points
where
(x:y:_) = _wlLine wall
points = extendConeToScreenEdge w sightFrom (x,y)
@@ -311,7 +311,7 @@ drawWallFace w wall
-- it is not obvious which will be returned
intersectLinefromScreen :: World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen w a b = listToMaybe
. mapMaybe (\(x,y) -> intersectSegLineext x y a b)
. mapMaybe (\(x,y) -> intersectSegLineFrom' x y b (b +.+ b -.- a))
. makeLoopPairs
$ screenPolygon w
@@ -319,7 +319,7 @@ extendConeToScreenEdge :: World -> Point2 -> (Point2,Point2) -> [Point2]
extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
where borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' x y)
wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' y ((2*.*y) -.- x))
. makeLoopPairs $ screenPolygon w
displayInv :: Int -> World -> Picture
-7
View File
@@ -85,17 +85,10 @@ doLoop setup window startWorld
newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
glSwapWindow window
endSideTicks <- ticks
--worldSideEffects setup updatedWorld
events <- pollEvents
--let-- maybeUpdatedWorld :: Maybe (WorldView world0)
-- maybeUpdatedWorld = applyEvents eventFn startWorld events worldUpdate
maybeUpdatedWorld <- applyEventsIO eventFn startWorld events
case maybeUpdatedWorld >>= worldUpdate of
Just updatedWorld -> do
--GL.clear [GL.ColorBuffer,GL.DepthBuffer]
--worldSideEffects setup updatedWorld
--glSwapWindow window
--GL.flush
endSimTicks <- ticks
performGC
endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)