Rearrange zone sizes
This commit is contained in:
+1
-1
@@ -61,6 +61,6 @@ debugWallZoningPic w = setLayer BloomLayer $ zonesPic `appendPic` wallsPic
|
|||||||
$ wallsAlongLine sp ep w
|
$ wallsAlongLine sp ep w
|
||||||
drawTheWall (a,b) = thickLine 20 [a,b]
|
drawTheWall (a,b) = thickLine 20 [a,b]
|
||||||
zonesPic = setDepth 20 $ drawDDA zones
|
zonesPic = setDepth 20 $ drawDDA zones
|
||||||
zones = ddaExt wallZoneSize sp ep
|
zones = ddaExt wlZoneSize sp ep
|
||||||
sp = _crPos $ you w
|
sp = _crPos $ you w
|
||||||
ep = mouseWorldPos w
|
ep = mouseWorldPos w
|
||||||
|
|||||||
@@ -43,13 +43,13 @@ addBlock (p:ps) wl bl w = w
|
|||||||
}
|
}
|
||||||
) is lns
|
) is lns
|
||||||
wallInZone wl'
|
wallInZone wl'
|
||||||
| uncurry dist (_wlLine wl') <= 2*wallZoneSize
|
| uncurry dist (_wlLine wl') <= 2*wlZoneSize
|
||||||
= insertIMInZone x y wlid wl'
|
= insertIMInZone x y wlid wl'
|
||||||
| otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl')) ips
|
| otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl')) ips
|
||||||
where
|
where
|
||||||
V2 x y = wallZoneOfPoint $ uncurry midPoint (_wlLine wl)
|
V2 x y = wallZoneOfPoint $ uncurry midPoint (_wlLine wl)
|
||||||
wlid = _wlID 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')
|
unv2 (V2 x' y') = (x',y')
|
||||||
addBlock _ _ _ _ = error "Trying to add a block with incomplete polygon"
|
addBlock _ _ _ _ = error "Trying to add a block with incomplete polygon"
|
||||||
|
|
||||||
|
|||||||
@@ -108,7 +108,7 @@ drawInspectWalls w = foldMap (drawInspectWall w)
|
|||||||
drawInspectWall :: World -> Wall -> Picture
|
drawInspectWall :: World -> Wall -> Picture
|
||||||
drawInspectWall _ wl = setLayer DebugLayer $
|
drawInspectWall _ wl = setLayer DebugLayer $
|
||||||
color rose (thickLine 3 [a,b])
|
color rose (thickLine 3 [a,b])
|
||||||
<> foldMap (drawZone wallZoneSize)
|
<> foldMap (drawZone wlZoneSize)
|
||||||
(runIdentity $ S.toList_ $ zoneOfWall wl)
|
(runIdentity $ S.toList_ $ zoneOfWall wl)
|
||||||
where
|
where
|
||||||
(a,b) = _wlLine wl
|
(a,b) = _wlLine wl
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ wallsToDraw w
|
|||||||
<$> L.prefilter wlOpaqueDraw (L.premap f L.list)
|
<$> L.prefilter wlOpaqueDraw (L.premap f L.list)
|
||||||
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
|
||||||
<*> L.premap getWallSPic L.mconcat
|
<*> 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
|
g (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j
|
||||||
|
|
||||||
wlOpaqueDraw :: Wall -> Bool
|
wlOpaqueDraw :: Wall -> Bool
|
||||||
|
|||||||
@@ -11,7 +11,7 @@ import Streaming
|
|||||||
import qualified Streaming.Prelude as S
|
import qualified Streaming.Prelude as S
|
||||||
|
|
||||||
zoneOfWall :: Wall -> Stream (Of (V2 Int)) Identity ()
|
zoneOfWall :: Wall -> Stream (Of (V2 Int)) Identity ()
|
||||||
zoneOfWall = uncurry (zoneOfSeg wallZoneSize) . _wlLine
|
zoneOfWall = uncurry (zoneOfSeg wlZoneSize) . _wlLine
|
||||||
|
|
||||||
insertWallInZones :: Wall -> World -> World
|
insertWallInZones :: Wall -> World -> World
|
||||||
insertWallInZones wl = wallsZone . znObjects
|
insertWallInZones wl = wallsZone . znObjects
|
||||||
|
|||||||
@@ -14,8 +14,6 @@ import Dodge.Base
|
|||||||
import Dodge.Zone
|
import Dodge.Zone
|
||||||
import Geometry
|
import Geometry
|
||||||
|
|
||||||
import qualified Data.IntMap.Strict as IM
|
|
||||||
import Data.List
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Streaming
|
import Streaming
|
||||||
|
|||||||
+7
-12
@@ -11,7 +11,6 @@ module Dodge.Zone
|
|||||||
, cloudZoneOfPoint
|
, cloudZoneOfPoint
|
||||||
, cloudsNearPoint
|
, cloudsNearPoint
|
||||||
, wallsNearZones
|
, wallsNearZones
|
||||||
, wallZoneSize
|
|
||||||
, zoneOfSight
|
, zoneOfSight
|
||||||
, flattenIMIMIM
|
, flattenIMIMIM
|
||||||
, wallZoneOfPoint
|
, wallZoneOfPoint
|
||||||
@@ -20,8 +19,10 @@ module Dodge.Zone
|
|||||||
, creatureNearPoint
|
, creatureNearPoint
|
||||||
, creatureNearPointI
|
, creatureNearPointI
|
||||||
, creaturesAlongLine
|
, creaturesAlongLine
|
||||||
|
, module Dodge.Zone.Size
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
import Dodge.Zone.Size
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
--import Dodge.Base.Window
|
--import Dodge.Base.Window
|
||||||
import Geometry
|
import Geometry
|
||||||
@@ -40,25 +41,19 @@ import Control.Lens
|
|||||||
--flattenZones :: Zone (IM.IntMap a) -> IM.IntMap a
|
--flattenZones :: Zone (IM.IntMap a) -> IM.IntMap a
|
||||||
--flattenZones = flattenIMIMIM . _znObjects
|
--flattenZones = flattenIMIMIM . _znObjects
|
||||||
|
|
||||||
wallZoneSize :: Float
|
|
||||||
wallZoneSize = 50
|
|
||||||
|
|
||||||
sizeZoneOfPoint :: Float -> Point2 -> (Int,Int)
|
sizeZoneOfPoint :: Float -> Point2 -> (Int,Int)
|
||||||
sizeZoneOfPoint s (V2 x y) = (f x, f y)
|
sizeZoneOfPoint s (V2 x y) = (f x, f y)
|
||||||
where
|
where
|
||||||
f = floor . (/ s)
|
f = floor . (/ s)
|
||||||
|
|
||||||
wallZoneOfPoint :: Point2 -> V2 Int
|
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 :: Point2 -> (Int,Int)
|
||||||
cloudZoneOfPoint = sizeZoneOfPoint 20
|
cloudZoneOfPoint = sizeZoneOfPoint 20
|
||||||
|
|
||||||
creatureZoneSize :: Float
|
|
||||||
creatureZoneSize = 15
|
|
||||||
|
|
||||||
crZoneOfPoint :: Point2 -> (Int,Int)
|
crZoneOfPoint :: Point2 -> (Int,Int)
|
||||||
crZoneOfPoint = sizeZoneOfPoint creatureZoneSize
|
crZoneOfPoint = sizeZoneOfPoint crZoneSize
|
||||||
|
|
||||||
zoneOfSeg :: Float -> Point2 -> Point2 -> Stream (Of (V2 Int)) Identity ()
|
zoneOfSeg :: Float -> Point2 -> Point2 -> Stream (Of (V2 Int)) Identity ()
|
||||||
--zoneOfLineStream = ddaSqStream zoneSize
|
--zoneOfLineStream = ddaSqStream zoneSize
|
||||||
@@ -68,7 +63,7 @@ zoneOfCirc :: Monad m => Point2 -> Float -> Stream (Of (V2 Int)) m ()
|
|||||||
zoneOfCirc p = S.each . zoneOfCircle p
|
zoneOfCirc p = S.each . zoneOfCircle p
|
||||||
|
|
||||||
zoneOfCircle :: Point2 -> Float -> Set.Set (V2 Int)
|
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 :: Point2 -> Set.Set (V2 Int)
|
||||||
zoneNearPointS p = Set.fromList [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ]
|
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
|
-- TODO check whether/when nubbing of walls is necessary
|
||||||
wallsAlongLine :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
|
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
|
where
|
||||||
f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j
|
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
|
f i m = fromMaybe IM.empty $ IM.lookup i m
|
||||||
|
|
||||||
creaturesAlongLine :: Point2 -> Point2 -> World -> Stream (Of Creature) Identity ()
|
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
|
where
|
||||||
f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j
|
f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j
|
||||||
|
|||||||
@@ -0,0 +1,10 @@
|
|||||||
|
module Dodge.Zone.Size where
|
||||||
|
|
||||||
|
wlZoneSize :: Float
|
||||||
|
wlZoneSize = 50
|
||||||
|
|
||||||
|
crZoneSize :: Float
|
||||||
|
crZoneSize = 15
|
||||||
|
|
||||||
|
clZoneSize :: Float
|
||||||
|
clZoneSize = 20
|
||||||
Reference in New Issue
Block a user