justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Stop bullets drawing over extended top of walls

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