diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 0f59f370d..0d86674b5 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -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' diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index a6db21d98..7563d045e 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -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)] diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 08cc71796..a97e5aea4 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -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 -- ] diff --git a/src/Geometry/Zone.hs b/src/Geometry/Zone.hs index 72d04b725..02ec4b978 100644 --- a/src/Geometry/Zone.hs +++ b/src/Geometry/Zone.hs @@ -9,15 +9,15 @@ import Data.Foldable import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS -foldl2' - :: (b -> a -> a -> b) - -> b - -> [a] - -> b -foldl2' f s (t:ts) = fst $ foldl' g (s, t) ts - where - g (r,x) y = (f r x y,y) -foldl2' _ s _ = s +--foldl2' +-- :: (b -> a -> a -> b) +-- -> b +-- -> [a] +-- -> b +--foldl2' f s (t:ts) = fst $ foldl' g (s, t) ts +-- where +-- g (r,x) y = (f r x y,y) +--foldl2' _ s _ = s sortArguments :: Ord a @@ -82,6 +82,35 @@ increasingInterval x y -- point. ddaExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet ddaExt s sp@(V2 sx sy) ep@(V2 ex ey) + | x1 <= x2 = addsp . addys . IM.fromDistinctAscList $ zip [x1 .. x2] + $ map (IS.singleton . divTo s) [x1y,x1y+ydx..] + | otherwise = addsp . addys . IM.fromDistinctAscList $ zip [x2-1 .. x1-1] + $ map (IS.singleton . divTo s) [x2y,x2y+ydx..] + where + addsp im = let V2 x y = sizeZoneOfPoint' s sp + in insertXY im (x,y) + x1 = divTo s sx + x2 = divTo s ex + x1y = fx' sp ep $ s * (fromIntegral x1) + x2y = fx' sp ep $ s * (fromIntegral x2) + ydx = s * ydx' sp ep + addys m = add2s m ypairs + y1 = divTo s sy + y2 = divTo s ey + y1x = fy' sp ep $ s * (fromIntegral y1) + y2x = fy' sp ep $ s * (fromIntegral y2) + xdy = s * xdy' sp ep + ypairs + | y1 <= y2 = zip (map (divTo s) [y1x,y1x+xdy..]) + [y1 .. y2] + | otherwise = zip (map (divTo s) [y2x,y2x+xdy..]) + [y2-1 .. y1-1] +-- | Determines which horizontal and vertical lines on a grid are crossed by a +-- line. For each adds the x-y index of the square to the right or above the +-- crossed grid line. Also adds the index of the square containing the start +-- point. +ddaExtExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet +ddaExtExt s sp@(V2 sx sy) ep@(V2 ex ey) | x1 <= x2 = addys . IM.fromDistinctAscList $ zip [x1 .. x2] $ map (IS.singleton . divTo s) [x1y,x1y+ydx..] | otherwise = addys . IM.fromDistinctAscList $ zip [x2-1 .. x1-1] @@ -137,6 +166,9 @@ add2s imis = foldl' (\m (k,x) -> IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m) imis +insertXY :: IM.IntMap IS.IntSet -> (Int,Int) -> IM.IntMap IS.IntSet +insertXY m (k,x) = IM.insertWith (\_ old -> IS.insert x old) k (IS.singleton x) m + addV2s :: IM.IntMap IS.IntSet -> [V2 Int] -> IM.IntMap IS.IntSet {-# INLINE addV2s #-} addV2s imis = foldl'