Fix wall zoning bug

This commit is contained in:
2021-08-16 16:54:27 +02:00
parent c58ee6d56c
commit 37db056f23
4 changed files with 63 additions and 11 deletions
+9
View File
@@ -3,8 +3,10 @@ import Dodge.Data
import Dodge.Picture
import Dodge.Picture.Layer
import Geometry.Data
import Geometry
import Picture
import qualified IntMapHelp as IM
import qualified Data.IntSet as IS
import Control.Lens
@@ -49,3 +51,10 @@ pjTimerF :: Int -> Int -> World -> World
pjTimerF 0 i = projectiles %~ IM.delete i
pjTimerF time i = projectiles . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
drawDDA :: IM.IntMap IS.IntSet -> Picture
drawDDA = setLayer 1 . color (withAlpha 0.5 green) . IM.foldlWithKey' f []
where
f pic x' ys' = concatMap (\y -> polygon (rectNSEW (y+50) y (x+50) x)) ys ++ pic
where
x = 50 * fromIntegral x'
ys = map ((50 *) . fromIntegral) $ IS.toList ys'
+1 -1
View File
@@ -95,7 +95,7 @@ updateWallZoning w = set wallsZone (foldl' (flip wallInZone) IM.empty (_walls w)
where
(x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
wlid = _wlID wl
ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
ips = map zoneOfPoint $ uncurry (divideLine (zoneSize)) (_wlLine wl)
makePath :: Tree Room -> [(Point2,Point2)]
+12 -1
View File
@@ -8,7 +8,9 @@ import Dodge.Picture
import Dodge.Picture.Layer
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Dodge.Debug
import Geometry
import Geometry.Zone
--import Geometry.Data
import Picture
import Polyhedra.Data
@@ -56,7 +58,16 @@ customMouseCursor w =
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
testPic :: World -> Picture
testPic _ = blank
testPic w = setLayer 1 $ zonesPic ++ wallsPic
where
wallsPic = setDepth 25 . color yellow . concatMap (drawTheWall . _wlLine) $ IM.elems theWalls
drawTheWall (a,b) = lineOfThickness 20 [a,b]
theWalls = wallsAlongLine sp ep w
zonesPic = setDepth 20 $ drawDDA zones
zones = ddaExt zoneSize sp ep
sp = _crPos $ you w
ep = mouseWorldPos w
-- [ setDepth (-1) . translate 0 0.8
-- . scale 0.001 0.001 . text . show $ _crMvDir $ you w
-- ]