This commit is contained in:
2023-04-15 10:55:59 +01:00
parent 44f64f4b47
commit 8ab75fb24a
11 changed files with 64 additions and 62 deletions
+1
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE TupleSections #-}
--{-# OPTIONS_GHC -fno-full-laziness #-}
module Dodge.DisplayInventory (
toggleCombineInv,
+5 -5
View File
@@ -20,11 +20,11 @@ initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
initialRoomTree = annoToRoomTree initialAnoTree
--initialRoomTree = annoToRoomTree startWorldTreeTest
startWorldTreeTest :: Annotation
startWorldTreeTest =
OnwardList $
[ IntAnno $ AnTree . startRoom
]
--startWorldTreeTest :: Annotation
--startWorldTreeTest =
-- OnwardList $
-- [ IntAnno $ AnTree . startRoom
-- ]
initialAnoTree :: Annotation
initialAnoTree =
-3
View File
@@ -341,9 +341,6 @@ zoneCreatures w =
w & crZoning
.~ foldl' (flip zoneCreature) mempty (w ^. cWorld . lWorld . creatures)
-- foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr))
-- zn (_creatures w)
updateCreatureSoundPositions :: World -> World
updateCreatureSoundPositions w =
M.foldlWithKey' insertSound w
-5
View File
@@ -6,7 +6,6 @@ module Dodge.Zoning.Base
, zoneOfRect
, zoneMonoid
, deZoneIX
, zoneOfPoint''
, zoneOfCirc
, zonesAroundPoint
, xIntercepts
@@ -87,10 +86,6 @@ zoneMonoid (V2 x y) a = IM.insertWith f x $! IM.singleton y a
deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 -> IM.IntMap (IM.IntMap IS.IntSet)
deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i
zoneOfPoint'' :: Float -> Point2 -> Int2
{-# INLINE zoneOfPoint'' #-}
zoneOfPoint'' s = fmap (divTo s)
zonesAroundPoint :: Float -> Point2 -> [Int2]
zonesAroundPoint s p = [V2 a b | a <- [x -1 .. x + 1], b <- [y -1 .. y + 1]]
where
+4 -4
View File
@@ -7,13 +7,13 @@ import qualified IntMapHelp as IM
import Dodge.Zoning.Common
clsNearPoint :: Point2 -> World -> [Cloud]
clsNearPoint = nearPoint' clZoneSize _clZoning
clsNearPoint = nearPoint clZoneSize _clZoning
clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
clsNearSeg = nearSeg' clZoneSize _clZoning
clsNearSeg = nearSeg clZoneSize _clZoning
clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
clsNearRect = nearRect' clZoneSize _clZoning
clsNearRect = nearRect clZoneSize _clZoning
clsNearCirc :: Point2 -> Float -> World -> [Cloud]
clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -22,7 +22,7 @@ clZoneSize :: Float
clZoneSize = 20
zoneOfCl :: Cloud -> Int2
zoneOfCl = zoneOfPoint'' clZoneSize . xyV3 . _clPos
zoneOfCl = zoneOfPoint clZoneSize . xyV3 . _clPos
zoneCloud :: Cloud -> IM.IntMap (IM.IntMap [Cloud]) -> IM.IntMap (IM.IntMap [Cloud])
zoneCloud cl = zoneMonoid (zoneOfCl cl) [cl]
+9 -9
View File
@@ -5,14 +5,14 @@ import Dodge.Zoning.Base
import Geometry
import qualified IntMapHelp as IM
nearPoint' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
{-# INLINE nearPoint' #-}
nearPoint' size f p w = zoneExtract (zoneOfPoint size p) (f w)
nearPoint :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
{-# INLINE nearPoint #-}
nearPoint size f p = zoneExtract (zoneOfPoint size p) . f
nearSeg' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearSeg' #-}
nearSeg' size f sp ep w = zonesExtract (f w) (zoneOfSeg size sp ep)
nearSeg :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearSeg #-}
nearSeg size f sp ep w = zonesExtract (f w) (zoneOfSeg size sp ep)
nearRect' :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearRect' #-}
nearRect' size f sp ep w = zonesExtract (f w) (zoneOfRect size sp ep)
nearRect :: Monoid m => Float -> (World -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearRect #-}
nearRect size f sp ep w = zonesExtract (f w) (zoneOfRect size sp ep)
+4 -3
View File
@@ -12,7 +12,7 @@ import Dodge.Zoning.Common
crIXsNearPoint :: Point2 -> World -> IS.IntSet
--crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
crIXsNearPoint = nearPoint' crZoneSize _crZoning
crIXsNearPoint = nearPoint crZoneSize _crZoning
crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
@@ -24,7 +24,7 @@ crsNearSeg sp ep w =
$ crixsNearSeg sp ep w
crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crixsNearSeg = nearSeg' crZoneSize _crZoning
crixsNearSeg = nearSeg crZoneSize _crZoning
--crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
@@ -34,7 +34,7 @@ crsNearCirc :: Point2 -> Float -> World -> [Creature]
crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
crsNearRect = nearRect' crZoneSize _crZoning
crsNearRect = nearRect crZoneSize _crZoning
crZoneSize :: Float
crZoneSize = 15
@@ -50,6 +50,7 @@ minCrIXOn f is w = fst <$> IS.foldl' g Nothing is
h cr = (cr, f cr)
zoneCreature :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
{-# INLINE zoneCreature #-}
zoneCreature cr im = foldl' f im (zoneOfCr cr)
where
f im' i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im'
+7 -7
View File
@@ -10,13 +10,13 @@ import qualified Data.Set as Set
import Dodge.Zoning.Common
pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
pnsNearPoint = nearPoint' pnZoneSize _pnZoning
pnsNearPoint = nearPoint pnZoneSize _pnZoning
pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearSeg = nearSeg' pnZoneSize _pnZoning
pnsNearSeg = nearSeg pnZoneSize _pnZoning
pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearRect = nearRect' pnZoneSize _pnZoning
pnsNearRect = nearRect pnZoneSize _pnZoning
pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)]
pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -25,20 +25,20 @@ pnZoneSize :: Float
pnZoneSize = 50
zoneOfPn :: (Int, Point2) -> Int2
zoneOfPn = zoneOfPoint'' pnZoneSize . snd
zoneOfPn = zoneOfPoint pnZoneSize . snd
zonePn :: (Int, Point2) -> IM.IntMap (IM.IntMap [(Int, Point2)]) -> IM.IntMap (IM.IntMap [(Int, Point2)])
zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
pesNearPoint :: Point2 -> World -> Set PathEdgeNodes
pesNearPoint = nearPoint' peZoneSize _peZoning
pesNearPoint = nearPoint peZoneSize _peZoning
--pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . lWorld . peZoning)
pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
pesNearSeg = nearSeg' peZoneSize _peZoning
pesNearSeg = nearSeg peZoneSize _peZoning
pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes
pesNearRect = nearRect' peZoneSize _peZoning
pesNearRect = nearRect peZoneSize _peZoning
pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes
pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
+3 -3
View File
@@ -20,14 +20,14 @@ import qualified IntMapHelp as IM
import Dodge.Zoning.Common
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
wlIXsNearPoint = nearPoint' wlZoneSize _wlZoning
wlIXsNearPoint = nearPoint wlZoneSize _wlZoning
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
{-# INLINE wlIXsNearSeg #-}
wlIXsNearSeg = nearSeg' wlZoneSize _wlZoning
wlIXsNearSeg = nearSeg wlZoneSize _wlZoning
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
wlIXsNearRect = nearRect' wlZoneSize _wlZoning
wlIXsNearRect = nearRect wlZoneSize _wlZoning
wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)