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

Refactor creature zoning

Browse Source
This commit is contained in:
justin
2022-07-22 17:53:08 +01:00
parent 43e7d20b21
commit 39f4555697
17 changed files with 209 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+13 -6
View File
@@ -40,6 +40,7 @@ module Dodge.Base.Collide
) where
import Dodge.Data
import Dodge.Zone
import Dodge.Zoning
import Dodge.Base.Wall
import Geometry
@@ -49,6 +50,7 @@ import Control.Lens
import Control.Monad
import StreamingHelp
import qualified Streaming.Prelude as S
import qualified Data.IntSet as IS
collidePoint :: Point2 -> Point2
-> StreamOf Wall
@@ -59,10 +61,10 @@ collidePoint sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id
findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
overlap1SegCrs :: Point2 -> Point2
-> StreamOf Creature
-> StreamOf (Point2, Creature)
-> [Creature]
-> [(Point2, Creature)]
{-# INLINE overlap1SegCrs #-}
overlap1SegCrs sp ep = S.mapMaybe
overlap1SegCrs sp ep = mapMaybe
(\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep ))
overlapSegCrs :: Point2 -> Point2
@@ -172,8 +174,9 @@ circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine
circOnAnyCr :: Point2 -> Float -> World -> Bool
{-# INLINE circOnAnyCr #-}
circOnAnyCr p r = runIdentity . S.any_ (\cr -> dist p (_crPos cr) < r + _crRad cr)
. crsNearPoint p
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
where
f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? creatures . ix cid) || bl
{- | More general collision tests follow -}
@@ -218,6 +221,10 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
where
hitCr = runIdentity $ S.any_ (const True) $ overlap1SegCrs sp ep $ crsNearSeg sp ep w
hitCr = IS.foldr f False $ crsNearSeg sp ep w
f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
(w ^? creatures . ix cid)
|| bl
hitWl = collideCircWallsStream sp ep rad $ wlsNearPoint ep w
-- this should probably be wallsOnLine or something
src/Dodge/Creature/ReaderUpdate.hs
+6 -1
View File
@@ -14,12 +14,15 @@ module Dodge.Creature.ReaderUpdate
, setMvPos
, setViewPos
) where
import Dodge.Zoning.Creature
import FoldableHelp
import Dodge.Data
import Dodge.Creature.Volition
import Dodge.Base
import Dodge.Zone
import Geometry
import qualified Data.IntSet as IS
import qualified IntMapHelp as IM
import Control.Lens
import Control.Applicative
@@ -76,7 +79,9 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
isFarACC cr' = _crGroup cr' == _crGroup cr
&& _crID cr' /= _crID cr
&& dist (_crPos cr') tpos > dist cpos tpos
macr = minStreamOn (dist cpos . _crPos) . S.filter isFarACC $ crsInsideCirc cpos 50 w
macr = safeMinimumOn (dist cpos . _crPos)
. filter isFarACC
$ crsNearCirc cpos 50 w
in case macr of
Nothing -> cr
Just acr ->
src/Dodge/DamageCircle.hs
+2 -1
View File
@@ -6,6 +6,7 @@ import Dodge.WorldEvent.ThingsHit
import Geometry
import LensHelp
import Data.Foldable
import qualified Streaming.Prelude as S
import qualified IntMapHelp as IM
damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
@@ -16,7 +17,7 @@ damageCircle r sp dt da w = w
addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam
wlstodam = wlsHitRadial sp r w
wldam p = Damage dt da sp p (sp +.+ r *.* normalizeV (p -.- sp)) NoDamageEffect
addcreaturedamages crs = runIdentity $ S.fold_ (damageCrCircle crdam) crs id crstodam
addcreaturedamages crs = foldl' (damageCrCircle crdam) crs crstodam
crdam p cr = Damage dt da sp p (_crPos cr) NoDamageEffect
crstodam = crsHitRadial sp r w
src/Dodge/Data.hs
+1 -1
View File
@@ -186,7 +186,7 @@ data World = World
, _boundBox :: [Point2]
, _boundDist :: (Float,Float,Float,Float) -- NSEW, S and W negative
, _creatures :: IM.IntMap Creature
, _crZoning :: Zoning IM.IntMap Creature
, _crZoning :: CrZoning --Zoning IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
src/Dodge/Data/Zoning.hs
+3
View File
@@ -4,6 +4,7 @@ module Dodge.Data.Zoning where
import Geometry.Data
import Control.Lens
import qualified IntMapHelp as IM
import qualified Data.IntSet as IS
import StreamingHelp
data Zoning t a = Zoning
@@ -12,5 +13,7 @@ data Zoning t a = Zoning
, _znFunc :: Float -> a -> StreamOf Int2
-- , _znInsert :: a -> t a -> t a
}
newtype CrZoning = CrZoning {_getCrZoning :: IM.IntMap (IM.IntMap IS.IntSet)}
makeLenses ''Zoning
makeLenses ''CrZoning
src/Dodge/Default/World.hs
+1 -1
View File
@@ -27,7 +27,7 @@ defaultWorld = World
, _viewDistance = 1000
, _modifications = IM.empty
, _creatures = IM.empty
, _crZoning = Zoning IM.empty crZoneSize zoneOfCreature
, _crZoning = CrZoning mempty --Zoning IM.empty crZoneSize zoneOfCreature
, _creatureGroups = IM.empty
, _clouds = mempty
, _clZoning = Zoning IM.empty clZoneSize (zonePos (stripZ . _clPos))
src/Dodge/Item/Weapon/ExtraEffect.hs
+5 -3
View File
@@ -18,6 +18,8 @@ module Dodge.Item.Weapon.ExtraEffect
, targetCursorUpdate
-- , rbSetTarget
) where
import Dodge.Zoning.Creature
import FoldableHelp
import Dodge.Data
import Dodge.Base
import Dodge.Zone
@@ -93,9 +95,9 @@ targetRBCreatureUp it cr w t
& tgActive .~ False
)
where
newtarg = minStreamOn (dist mwp . _crPos)
. S.filter (canseepos . _crPos)
$ crsInsideCirc mwp 40 w
newtarg = safeMinimumOn (dist mwp . _crPos)
. filter (canseepos . _crPos)
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
mwp = mouseWorldPos w
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
src/Dodge/Update.hs
+23 -22
View File
@@ -4,6 +4,7 @@ Module : Dodge.Update
Description : Simulation update
-}
module Dodge.Update ( updateUniverse ) where
import Dodge.Zoning.Creature
import Dodge.WorldEffect
import Dodge.Data
import Dodge.Beam
@@ -73,28 +74,28 @@ functionalUpdate w = over uvWorld checkEndGame
. over uvWorld ppEvents
. updateCamera
. colCrsWalls
. over uvWorld (simpleCrSprings )
. over uvWorld (zoneCreatures )
. over uvWorld simpleCrSprings
. over uvWorld zoneCreatures
. over uvWorld (updateIMl _doors _drMech )
. over uvWorld doWorldEvents
. over uvWorld (updateDelayedEvents )
. over uvWorld updateDelayedEvents
. over uvWorld (updateIMl _modifications _mdUpdate )
. over uvWorld (updateSparks )
. over uvWorld (updateRadarSweeps )
. over uvWorld (updatePosEvents )
. over uvWorld (updateFlames )
. over uvWorld (updateEnergyBalls )
. over uvWorld (updateParticles )
. over uvWorld (updateBullets )
. over uvWorld (updateRadarBlips )
. over uvWorld (updateFlares )
. over uvWorld (updateBeams )
. over uvWorld updateSparks
. over uvWorld updateRadarSweeps
. over uvWorld updatePosEvents
. over uvWorld updateFlames
. over uvWorld updateEnergyBalls
. over uvWorld updateParticles
. over uvWorld updateBullets
. over uvWorld updateRadarBlips
. over uvWorld updateFlares
. over uvWorld updateBeams
. over uvWorld (updateIMl _props _pjUpdate )
. over uvWorld (updateIMl' _projectiles updateProjectile)
. over uvWorld (updateLightSources )
. over uvWorld (updateClouds )
. over uvWorld (updateGusts )
. over uvWorld (zoneClouds )
. over uvWorld updateLightSources
. over uvWorld updateClouds
. over uvWorld updateGusts
. over uvWorld zoneClouds
. over uvWorld (updateMIM magnets _mgUpdate )
. over uvWorld (updateIMl' _terminals tmUpdate )
-- . updateIMl _machines mcChooseUpdate
@@ -173,10 +174,10 @@ doRewind w = case _maybeWorld w of
zoneCreatures :: World -> World
zoneCreatures w = w
& crZoning . znObjects .~ mempty
& crZoning %~ \zn ->
foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
zn (_creatures w)
& crZoning . getCrZoning .~ mempty
& crZoning %~ \zn -> foldl' (flip zoneCreature) zn (_creatures w)
-- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
-- zn (_creatures w)
updateCreatureSoundPositions :: World -> World
updateCreatureSoundPositions w = M.foldlWithKey' insertSound w
@@ -428,7 +429,7 @@ simpleCrSprings w = IM.foldl' (flip crSpring) w $ _creatures w
-- note that this may in rare cases not push creatures away from each other
crSpring :: Creature -> World -> World
crSpring c w = runIdentity $ S.fold_ (flip $ crCrSpring c) w id cs
crSpring c w = foldl' (flip $ crCrSpring c) w cs
where
cs = crsNearPoint (_crPos c) w
src/Dodge/Update/Cloud.hs
+5 -3
View File
@@ -1,15 +1,17 @@
module Dodge.Update.Cloud where
import Dodge.Zoning.Creature
import Dodge.Data
import Dodge.Zone
import Geometry.Vector3D
import LensHelp
import StreamingHelp
import qualified Streaming.Prelude as S
import Data.Foldable
cloudPoisonDamage :: Cloud -> World -> World
cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w)
cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w)
where
dodamagesto :: StreamOf Creature -> World -> World
dodamagesto scrs mcrs = runIdentity $ S.fold_ (flip doDam) mcrs id scrs
dodamagesto :: [Creature] -> World -> World
dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs
doDam cr = creatures . ix (_crID cr) . crState . csDamage
.:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
src/Dodge/WorldEvent/ThingsHit.hs
+15 -8
View File
@@ -11,15 +11,19 @@ module Dodge.WorldEvent.ThingsHit
, wlsHitRadial
)
where
import Dodge.Zoning.Creature
import Dodge.Data
import Dodge.Base
import Dodge.Zone
import Geometry
--import Data.Maybe
import Control.Lens
import Data.Maybe
import Data.List (sortOn)
import Data.Functor
import Data.Bifunctor
import StreamingHelp
import qualified Data.IntSet as IS
import qualified Streaming.Prelude as S
{- List those objects that appear on a line. -}
@@ -29,15 +33,18 @@ thingsHit
-> World
-> StreamOf (Point2, Either Creature Wall)
thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
(S.map (second Left) (crsHit sp ep w))
(S.map (second Left) (S.each $ crsHit sp ep w))
(S.map (second Right) (wlsHit sp ep w))
crsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Creature)
crsHit sp ep
| sp == ep = const mempty
| otherwise = sortStreamOn (dist sp . fst)
crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
crsHit sp ep w
| sp == ep = mempty
| otherwise = sortOn (dist sp . fst)
. overlap1SegCrs sp ep
. mapMaybe (\cid -> w ^? creatures . ix cid)
. IS.toList
. crsNearSeg sp ep
$ w
thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
-> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
@@ -77,8 +84,8 @@ wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
where
v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
crsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Creature)
crsHitRadial p r = S.mapMaybe f . crsInsideCirc p r
crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
crsHitRadial p r = mapMaybe f . crsNearCirc p r
where
f cr
| dist cpos p <= r = Just (cpos +.+ r *.* normalizeV (p -.- cpos), cr)
src/Dodge/Zone.hs
+16 -16
View File
@@ -5,14 +5,14 @@ module Dodge.Zone
, nearPoint
, nearSeg
, wlsNearPoint
, crsNearPoint
--, crsNearPoint
, clsNearPoint
, wlsNearSeg
, crsNearSeg
--, crsNearSeg
, wlsInsideCirc
, crsInsideCirc
--, crsInsideCirc
, clZoneOfPoint
, crZoneOfPoint
--, crZoneOfPoint
, wlZoneOfPoint
, module Dodge.Zone.Size
, module Dodge.Zone.Object
@@ -82,9 +82,9 @@ wlsNearPoint :: Point2 -> World -> StreamOf Wall
{-# INLINE wlsNearPoint #-}
wlsNearPoint = nearPoint _wlZoning
crsNearPoint :: Point2 -> World -> StreamOf Creature
{-# INLINE crsNearPoint #-}
crsNearPoint = nearPoint _crZoning
--crsNearPoint :: Point2 -> World -> StreamOf Creature
--{-# INLINE crsNearPoint #-}
--crsNearPoint = nearPoint _crZoning
nearSeg :: Foldable t => (World -> Zoning t a) -> Point2 -> Point2 -> World -> StreamOf a
{-# INLINE nearSeg #-}
@@ -96,9 +96,9 @@ wlsNearSeg :: Point2 -> Point2 -> World -> StreamOf Wall
{-# INLINE wlsNearSeg #-}
wlsNearSeg = nearSeg _wlZoning
crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature
{-# INLINE crsNearSeg #-}
crsNearSeg = nearSeg _crZoning
--crsNearSeg :: Point2 -> Point2 -> World -> StreamOf Creature
--{-# INLINE crsNearSeg #-}
--crsNearSeg = nearSeg _crZoning
insideCirc :: Foldable t => (World -> Zoning t a) -> Point2 -> Float -> World -> StreamOf a
{-# INLINE insideCirc #-}
@@ -110,9 +110,9 @@ wlsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity ()
{-# INLINE wlsInsideCirc #-}
wlsInsideCirc = insideCirc _wlZoning
crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature
{-# INLINE crsInsideCirc #-}
crsInsideCirc = insideCirc _crZoning
--crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature
--{-# INLINE crsInsideCirc #-}
--crsInsideCirc = insideCirc _crZoning
wlZoneOfPoint :: Point2 -> Int2
{-# INLINE wlZoneOfPoint #-}
@@ -122,6 +122,6 @@ clZoneOfPoint :: Point2 -> Int2
{-# INLINE clZoneOfPoint #-}
clZoneOfPoint = zoneOfPoint clZoneSize
crZoneOfPoint :: Point2 -> Int2
{-# INLINE crZoneOfPoint #-}
crZoneOfPoint = zoneOfPoint crZoneSize
--crZoneOfPoint :: Point2 -> Int2
--{-# INLINE crZoneOfPoint #-}
--crZoneOfPoint = zoneOfPoint crZoneSize
src/Dodge/Zone/Size.hs
-3
View File
@@ -6,8 +6,5 @@ pnZoneSize = 100
wlZoneSize :: Float
wlZoneSize = 50
crZoneSize :: Float
crZoneSize = 15
clZoneSize :: Float
clZoneSize = 20
src/Dodge/Zoning.hs
+4 -1
View File
@@ -1,2 +1,5 @@
module Dodge.Zoning where
module Dodge.Zoning
( module Dodge.Zoning.Creature
) where
import Dodge.Zoning.Creature
src/Dodge/Zoning/Base.hs
+59 -17
View File
@@ -1,20 +1,62 @@
module Dodge.Zoning.Base where
import Geometry
import Geometry.Zone
import qualified IntMapHelp as IM
--zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
--zoneOfCirc zsize p r = zoneOfRect' x (p +.+ V2 r r) (p -.- V2 r r)
import Control.Lens
import Data.Maybe
zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
zoneOfCirc zsize p r = zoneOfRect' zsize (p +.+ V2 r r) (p -.- V2 r r)
zoneOfRect' :: Float -> Point2 -> Point2 -> [Int2]
zoneOfRect' s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey]
where
V2 sx sy = zoneOfPoint' s sp
V2 ex ey = zoneOfPoint' s ep
makeIntInterval :: Int -> Int -> [Int]
makeIntInterval x y
| x < y = [x..y]
| otherwise = [y..x]
makeInt2Interval :: Int2 -> Int2 -> [Int2]
makeInt2Interval (V2 x1 y1) (V2 x2 y2)
= [(V2 x y) | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
zoneOfPoint' :: Float -> Point2 -> Int2
zoneOfPoint' s = fmap (divTo s)
zoneOfSeg' :: Float -> Point2 -> Point2 -> [Int2]
zoneOfSeg' s sp ep = map (zoneOfPoint' s) (sp : xIntercepts' s sp ep ++ yIntercepts' s sp ep)
zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
zoneExtract (V2 x y) = fromMaybe mempty . (^? ix x . ix y)
--
--zoneOfRect' :: Float -> Point2 -> Point2 -> [Int2]
--zoneOfRect' s sp ep = [V2 x y | x <- makeInterval sx ex, y <- makeInterval sy ey]
-- where
-- V2 sx sy = zoneOfPoint s sp
-- V2 ex ey = zoneOfPoint s ep
--
--zoneOfPoint :: Float -> Point2 -> Int2
--{-# INLINE zoneOfPoint #-}
--zoneOfPoint s = fmap (divTo s)
--
--zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
--zoneExtract (x,y) = ix x . ix y
--
--zonesExtract :: Monoid m => [Int2] -> IM.IntMap (IM.IntMap m) -> m
--zonesExtract xs = fold (flip zoneExtract xs)
zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m
zonesExtract im = foldMap (flip zoneExtract im)
xIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE xIntercepts' #-}
xIntercepts' s (V2 sx sy) (V2 ex ey)
| xdx == 0 = []
| xdx > 0 = zipWith V2 [sx',sx'+xdx*50..ex] ([sy',sy'+ydx*50..ey] ++ repeat ey)
| otherwise = zipWith V2 [sx'-50,sx'+xdx*50-50..ex-50] ([sy',sy'+ydx*50..ey] ++ repeat ey)
where
xdx = signum (ex - sx)
ydx = (ey - sy) / abs (ex - sx) -- carefull: if this is zero
sy' = sy + ydx * abs (sx - sx')
sx' | xdx < 0 = sx - modTo s sx
| otherwise = s + sx - modTo s sx
yIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE yIntercepts' #-}
yIntercepts' s sp ep = map f $ xIntercepts' s (f sp) (f ep)
where
f (V2 x y) = V2 y x
zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m)
zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a
where
f _ = IM.insertWith (<>) y a
src/Dodge/Zoning/Creature.hs
+49 -2
View File
@@ -1,7 +1,54 @@
module Dodge.Zoning.Creature where
import FoldableHelp
import Dodge.Data
import Geometry
import Dodge.Zoning.Base
import qualified FoldlHelp as L
import qualified IntMapHelp as IM
--zoneOfCr :: Creature -> [Int2]
--zoneOfCr cr = zoneOfCirc crZoneSize (_crPos cr) (_crRad cr)
import Data.Maybe
import Data.Function
import qualified Data.IntSet as IS
import Control.Lens
crIXsNearPoint :: Point2 -> World -> IS.IntSet
crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. crZoning . getCrZoning)
crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearPoint p w
crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crsNearSeg sp ep w = zonesExtract (w ^. crZoning . getCrZoning) (zoneOfSeg' crZoneSize sp ep)
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
crsNearCirc :: Point2 -> Float -> World -> [Creature]
crsNearCirc p r w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
crsNearRect sp ep w = zonesExtract (w ^. crZoning . getCrZoning) $ zoneOfRect' crZoneSize sp ep
crZoneSize :: Float
crZoneSize = 15
zoneOfCr :: Creature -> [Int2]
zoneOfCr cr = zoneOfCirc crZoneSize (_crPos cr) (_crRad cr)
minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature
minCrIXOn f is w = fmap fst $ IS.foldl' (g w) Nothing is
where
g w mcrx cid = minOn snd <$> getpair cid <*> mcrx
getpair cid = fmap h $ w ^? creatures . ix cid
h cr = (cr, f cr)
zoneCreature :: Creature -> CrZoning -> CrZoning
zoneCreature cr = over getCrZoning (zoneCr' cr)
zoneCr' :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
zoneCr' cr im = foldl' f im (zoneOfCr cr)
where
f im i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im
--crsInZones :: [Int2] -> CrZoning -> IS.IntSet
--crsInZones is
src/FoldableHelp.hs
+6
View File
@@ -8,6 +8,7 @@ module FoldableHelp
, filter3
, takeUntil
, ssfold
, minOn
, module Data.Foldable
)
where
@@ -29,6 +30,11 @@ safeMinimumOn f = foldl' g Nothing
| f x < f y = Just x
| otherwise = Just y
g Nothing y = Just y
minOn :: Ord b => (a -> b) -> a -> a -> a
minOn f x y
| f x < f y = x
| otherwise = y
safeMinimumOnMaybeF :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
safeMinimumOnMaybeF f = L.fold $ L.Fold step initial extract
where
src/Geometry/Zone.hs
+1
View File
@@ -9,6 +9,7 @@ module Geometry.Zone
, zoneOfPoint
, zoneOfSeg
, zoneInsideCirc
, makeInterval
) where
import Geometry.Data
import Geometry.Vector