From e8849eb8d50070c8b8f58370557b2cb43364fa12 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 28 Jun 2022 09:38:24 +0100 Subject: [PATCH] Rearrange zone sizes --- src/Dodge/Debug.hs | 2 +- src/Dodge/Placement/PlaceSpot/Block.hs | 4 ++-- src/Dodge/Render/ShapePicture.hs | 2 +- src/Dodge/Render/Walls.hs | 2 +- src/Dodge/Wall/Zone.hs | 2 +- src/Dodge/WorldEvent/ThingsHit.hs | 2 -- src/Dodge/Zone.hs | 19 +++++++------------ src/Dodge/Zone/Size.hs | 10 ++++++++++ 8 files changed, 23 insertions(+), 20 deletions(-) create mode 100644 src/Dodge/Zone/Size.hs diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index a3c48cd54..b5742c63c 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -61,6 +61,6 @@ debugWallZoningPic w = setLayer BloomLayer $ zonesPic `appendPic` wallsPic $ wallsAlongLine sp ep w drawTheWall (a,b) = thickLine 20 [a,b] zonesPic = setDepth 20 $ drawDDA zones - zones = ddaExt wallZoneSize sp ep + zones = ddaExt wlZoneSize sp ep sp = _crPos $ you w ep = mouseWorldPos w diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index 2b53ce3da..95c633c72 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -43,13 +43,13 @@ addBlock (p:ps) wl bl w = w } ) is lns wallInZone wl' - | uncurry dist (_wlLine wl') <= 2*wallZoneSize + | uncurry dist (_wlLine wl') <= 2*wlZoneSize = insertIMInZone x y wlid wl' | otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl')) ips where V2 x y = wallZoneOfPoint $ uncurry midPoint (_wlLine wl) wlid = _wlID wl - ips = map (unv2 . wallZoneOfPoint) $ uncurry (divideLine (2*wallZoneSize)) (_wlLine wl) + ips = map (unv2 . wallZoneOfPoint) $ uncurry (divideLine (2*wlZoneSize)) (_wlLine wl) unv2 (V2 x' y') = (x',y') addBlock _ _ _ _ = error "Trying to add a block with incomplete polygon" diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index e3ac052c4..58238b2aa 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -108,7 +108,7 @@ drawInspectWalls w = foldMap (drawInspectWall w) drawInspectWall :: World -> Wall -> Picture drawInspectWall _ wl = setLayer DebugLayer $ color rose (thickLine 3 [a,b]) - <> foldMap (drawZone wallZoneSize) + <> foldMap (drawZone wlZoneSize) (runIdentity $ S.toList_ $ zoneOfWall wl) where (a,b) = _wlLine wl diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index a37d3a10d..e677dfe79 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -25,7 +25,7 @@ wallsToDraw w <$> L.prefilter wlOpaqueDraw (L.premap f L.list) <*> L.prefilter wlSeeThroughDraw (L.premap f L.list) <*> L.premap getWallSPic L.mconcat - ) (S.concat $ S.mapMaybe g $ zoneOfSight wallZoneSize w) + ) (S.concat $ S.mapMaybe g $ zoneOfSight wlZoneSize w) g (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j wlOpaqueDraw :: Wall -> Bool diff --git a/src/Dodge/Wall/Zone.hs b/src/Dodge/Wall/Zone.hs index d93eac46d..d2f91ff4d 100644 --- a/src/Dodge/Wall/Zone.hs +++ b/src/Dodge/Wall/Zone.hs @@ -11,7 +11,7 @@ import Streaming import qualified Streaming.Prelude as S zoneOfWall :: Wall -> Stream (Of (V2 Int)) Identity () -zoneOfWall = uncurry (zoneOfSeg wallZoneSize) . _wlLine +zoneOfWall = uncurry (zoneOfSeg wlZoneSize) . _wlLine insertWallInZones :: Wall -> World -> World insertWallInZones wl = wallsZone . znObjects diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index bac81526e..65a7fc7a1 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -14,8 +14,6 @@ import Dodge.Base import Dodge.Zone import Geometry -import qualified Data.IntMap.Strict as IM -import Data.List import Data.Maybe import Data.Bifunctor import Streaming diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index 2a0a257a6..a71ccd088 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -11,7 +11,6 @@ module Dodge.Zone , cloudZoneOfPoint , cloudsNearPoint , wallsNearZones - , wallZoneSize , zoneOfSight , flattenIMIMIM , wallZoneOfPoint @@ -20,8 +19,10 @@ module Dodge.Zone , creatureNearPoint , creatureNearPointI , creaturesAlongLine + , module Dodge.Zone.Size ) where +import Dodge.Zone.Size import Dodge.Data --import Dodge.Base.Window import Geometry @@ -40,25 +41,19 @@ import Control.Lens --flattenZones :: Zone (IM.IntMap a) -> IM.IntMap a --flattenZones = flattenIMIMIM . _znObjects -wallZoneSize :: Float -wallZoneSize = 50 - sizeZoneOfPoint :: Float -> Point2 -> (Int,Int) sizeZoneOfPoint s (V2 x y) = (f x, f y) where f = floor . (/ s) wallZoneOfPoint :: Point2 -> V2 Int -wallZoneOfPoint (V2 x y) = V2 (divTo wallZoneSize x) (divTo wallZoneSize y) +wallZoneOfPoint (V2 x y) = V2 (divTo wlZoneSize x) (divTo wlZoneSize y) cloudZoneOfPoint :: Point2 -> (Int,Int) cloudZoneOfPoint = sizeZoneOfPoint 20 -creatureZoneSize :: Float -creatureZoneSize = 15 - crZoneOfPoint :: Point2 -> (Int,Int) -crZoneOfPoint = sizeZoneOfPoint creatureZoneSize +crZoneOfPoint = sizeZoneOfPoint crZoneSize zoneOfSeg :: Float -> Point2 -> Point2 -> Stream (Of (V2 Int)) Identity () --zoneOfLineStream = ddaSqStream zoneSize @@ -68,7 +63,7 @@ zoneOfCirc :: Monad m => Point2 -> Float -> Stream (Of (V2 Int)) m () zoneOfCirc p = S.each . zoneOfCircle p zoneOfCircle :: Point2 -> Float -> Set.Set (V2 Int) -zoneOfCircle p r = foldMap zoneNearPointS $ divideCircle (1.5 * wallZoneSize) p r +zoneOfCircle p r = foldMap zoneNearPointS $ divideCircle (1.5 * wlZoneSize) p r zoneNearPointS :: Point2 -> Set.Set (V2 Int) zoneNearPointS p = Set.fromList [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ] @@ -153,7 +148,7 @@ cloudsNearPoint p w = S.each . f $ w ^? cloudsZone . znObjects . ix x . ix y -- TODO check whether/when nubbing of walls is necessary wallsAlongLine :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity () -wallsAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg wallZoneSize sp ep +wallsAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg wlZoneSize sp ep where f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j @@ -197,6 +192,6 @@ creaturesNearPointI n p w = IM.unions f i m = fromMaybe IM.empty $ IM.lookup i m creaturesAlongLine :: Point2 -> Point2 -> World -> Stream (Of Creature) Identity () -creaturesAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg creatureZoneSize sp ep +creaturesAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg crZoneSize sp ep where f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j diff --git a/src/Dodge/Zone/Size.hs b/src/Dodge/Zone/Size.hs new file mode 100644 index 000000000..16fda43e3 --- /dev/null +++ b/src/Dodge/Zone/Size.hs @@ -0,0 +1,10 @@ +module Dodge.Zone.Size where + +wlZoneSize :: Float +wlZoneSize = 50 + +crZoneSize :: Float +crZoneSize = 15 + +clZoneSize :: Float +clZoneSize = 20