Make item display universal

src/Dodge/Base.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE BangPatterns #-}
 {- |
 Basic helpers.
-Consider splitting. -}
+These modules should have few dependencies.  -}
 module Dodge.Base 
     ( module Dodge.Base
     , module Dodge.Base.Arithmetic
@@ -20,20 +20,17 @@ import Dodge.Base.Arithmetic
 import Dodge.Base.NewID
 import Dodge.Base.Coordinate
 import Dodge.Base.CardinalPoint
-import Dodge.Zone
+--import Dodge.Zone
 --import Dodge.Zone.Data
 import Dodge.Base.Window
 import Dodge.Base.Collide
 import Geometry
 --import Picture
 import qualified IntMapHelp as IM
-import FoldableHelp
-import qualified FoldlHelp as L
+--import FoldableHelp
 import Dodge.Base.You
 
 import Control.Lens
-import Data.Monoid
-import Data.Maybe
 --import Data.Bifunctor
 --import qualified Data.IntSet as IS
 --import qualified Data.Set as S
@@ -42,34 +39,6 @@ import Data.Maybe
 allWalls :: World -> IM.IntMap Wall
 allWalls = IM.unions . concatMap IM.elems . IM.elems . _znObjects . _wallsZone
 
-creatureNearPoint :: Point2 -> World -> Maybe Creature
-creatureNearPoint = creatureNearPointI 1
-
-creatureNearPointI :: Int -> Point2 -> World -> Maybe Creature
-creatureNearPointI n p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPointI n p
-
-creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
-creaturesNearPoint = creaturesNearPointI 1
-
-creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature
-creaturesNearPointI n p w =  IM.unions 
-    [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]]
-  where 
-    (x,y) = crZoneOfPoint p
-    f i m = fromMaybe IM.empty $ IM.lookup i m
-
--- possible BUG, occurs when used in thingsHitLongLine
-creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
---creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b]
---    where f i m = case IM.lookup i m of Just val -> val
---                                        _        -> IM.empty
-
-creaturesAlongLine a b w = IM.foldrWithKey' g IM.empty (zoneOfLineIntMap a b)
-  where 
-    g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _creaturesZone w) s))
-    f i = fromMaybe IM.empty . IM.lookup i
---    f i m = case IM.lookup i m of Just val -> val
---                                  _        -> IM.empty
 
 {- | Expands a line out to a given thickness. -}
 lineGeom :: Float -> Point2 -> Point2 -> [Point2]
@@ -131,225 +100,6 @@ adjustIMZone f x y n = IM.adjust f' x
   where 
     f'  = IM.adjust f'' y
     f'' = IM.adjust f n
---{- | Finds unused projectile key. -}
---newProjectileKey :: World -> Int
---newProjectileKey = IM.newKey . _props
---{- | Finds unused creature key. -}
---newCrKey :: World -> Int
---newCrKey = IM.newKey .  _creatures
--- | Looks for overlap of a circle with walls.
--- If found, gives wall
-overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall
-overlapCircWallsReturnWall p rad
-    = L.fold (safeMinimumOnMaybeL (fmap (dist p) . f . _wlLine))
-  where 
-    f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b
-
--- | Looks for any collision of a circle with walls.
--- If found, gives point and reflection velocity, reflection damped in normal.
--- note that in this version the circle can overlap the wall
-collidePointAnyWallsReflect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
-collidePointAnyWallsReflect p1 p2 
-    = getFirst
-    . foldMap (First . findPoint . _wlLine)
-  where 
-    findPoint (x,y) = case intersectSegSeg p1 p2 x y of
-        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
-        Nothing -> Nothing
-
--- | Looks for collision of a point with walls.
--- If found, gives collision point
--- If not found, returns point
-collidePointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
-collidePointWalls p1 p2 
-    = foldr findPoint p2 . fmap _wlLine
-  where
-    findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
-
-collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
-collidePointWallsFilter t p1 p2 = foldr findPoint p2 . fmap _wlLine . IM.filter t
-  where
-    findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
-collidePointWallsFilter' :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
-collidePointWallsFilter' t p1 p2 = foldl' findPoint p2 . fmap _wlLine . IM.filter t
-  where
-    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p)
-
--- | Looks for first collision of a circle with walls.
--- If found, gives point and reflection velocity, reflection damped in normal.
--- note that the "intersection" point is the center of the circle flush against the wall
-collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
-collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
-  where 
-    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
-    getp (Left p) = p
-    getp (Right (p,_)) = p
-    doReflection p (x,y) = case intersectSegSeg p1 p x y of
-        Nothing -> Nothing
-        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
-    shiftByRad (a,b) =
-        (g $ a +.+ rad *.* normalizeV (a -.-b)
-        ,g $ b +.+ rad *.* normalizeV (b -.-a)
-        )
-      where
-        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
-
--- | Looks for first collision of a circle with walls.
--- If found, gives point and reflection velocity, reflection damped in normal.
-collideCircWalls :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
-collideCircWalls p1 p2 rad
-    = safeMinimumOn (dist p1 . fst) 
-    . IM.mapMaybe 
-        (( \(x:y:_) -> fmap 
-            ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
-            . (+.+ normalizeV (vNormal (x -.- y)))
-            ) 
-            (intersectSegSeg p1 p2 x y)
-         ) 
-         . shiftByRad . _wlLine
-        )
-  where 
-    shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
-        [a +.+ rad *.* normalizeV (a -.-b)
-        ,b +.+ rad *.* normalizeV (b -.-a)
-        ]
--- this shifts the wall out, and for outer corners extends the wall
--- not sure what this does for inner corners, hopefully won't cause a problem
--- the alternative would be to separately bounce off corner points...
--- unfortunately, doesn't allow for collisions when the circle spawns on the
--- wall
-
--- | Looks for first collision of a point with a list of lines.
--- If found, gives point and normal of wall.
---collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
---collidePointLines p1 p2 ws 
---    = safeMinimumOn f
---    $ mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
---        . _wlLine') ws
---  where 
---    f (a,_) = magV (p1 -.- a)
---
-
--- | Looks for first collision of a point with walls.
--- If found, gives point and normal of wall.
-collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
-collidePointWallsNorm p1 p2 ws 
-    = safeMinimumOn (dist p1 . fst)
-    $ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
-        . _wlLine) ws
--- | Returns the first creature, if any, that a point intersects with.
-collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
-collidePointCreatures p1 p2 = fmap fst 
-    . safeMinimumOn snd
-    . IM.toList 
-    . IM.mapMaybe (\x -> dist p1 <$> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
--- | As for 'collidePointCreatures', only increases the radius of creatures by a
---fixed amount, thus collides a moving circle with creaures.
-collideCircCreatures :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe Int
-collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ rad)
-
--- | Returns the first creature id, if any, that a point intersects with, gives point
---in creature on line.
-collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
-collidePointCrsPoint p1 p2 = fmap f 
-    . safeMinimumOn (dist p1 . snd)
-    . IM.toList 
-    . IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
-  where 
-    f (cID,p) = (p,cID)
-{- | Finds the first creature hit on a line.
-Maybe evaluates the creature id and hit point. -}
-collideCircCrsPoint :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe (Point2,Int)
-collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
-
----- | Makes a creature not hittable.
---collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
---collidePointCrsWithoutPoint cid p1 p2 w 
---    = fmap f 
---    . safeMinimumOn (snd . snd)
---    . IM.toList 
---    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
---    . IM.delete cid 
---    $ _creatures w
---  where 
---    f (cID,(p,_)) = (p,cID)
-{- | Test if a circle collides with any wall. 
- - Note no check on whether the wall is walkable. -}
-circOnSomeWall :: Point2 -> Float -> World -> Bool
-circOnSomeWall p rad
-    = any (\(x,y) -> circOnSeg x y p rad) 
-    . fmap _wlLine 
-    . IM.elems 
-    . wallsNearPoint p
-{- | Test whether there is a creature of weight 4 or greater near a line. -}
-isHeavyCrNearLine 
-    :: Float 
-    -> [Point2] 
-    -> World 
-    -> Bool
-isHeavyCrNearLine d (p1:p2:_) 
-    = any (\c -> circOnSeg p1 p2 (_crPos c) (d + _crRad c)) 
-    . IM.filter (\cr -> _crMass cr > 4) 
-    . _creatures
-isHeavyCrNearLine _ _ = error "Testing whether creature is near empty line"
-{- | Adds the distance to the creature radius, tests whether the center is in
-the circle of this size centered at the point -}
-crsNearPoint :: Float -> Point2 -> World -> Bool
-crsNearPoint d p = any (\c -> dist (_crPos c) p < (d + _crRad c)) . _creatures
-{- | Produce an unordered list of creatures on a line. -}
-crsOnLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
-crsOnLine p1 p2
-    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
-    . _creatures
-{- | Produce an unordered list of creatures on a wide line. -}
-crsOnThickLine :: Float -> Point2 -> Point2 -> World -> IM.IntMap Creature
-crsOnThickLine thickness p1 p2
-    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr + thickness))
-    . _creatures
-{- | Find 'Maybe' the closest creature to a point, within a circle.
- -}
-nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature
-nearestCrInRad p r
-    = safeMinimumOn (dist p . _crPos)
-    . IM.filter (\cr -> dist p (_crPos cr) < r) 
-    . _creatures
-{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape.  -}
-nearestCrInTri 
-    :: Point2 
-    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
-    -> Float    -- ^ Distance. 
-    -> World -> Maybe Creature
-nearestCrInTri p dir x
-    = safeMinimumOn (dist p . _crPos)
-    . IM.filter (\cr -> pointInPolygon (_crPos cr) tri) 
-    . _creatures
- where 
-    tri = 
-        [p 
-        ,p +.+ rotateV (dir-pi/4) (V2 x 0)
-        ,p +.+ rotateV (dir+pi/4) (V2 x 0)
-        ]
-{- | Find 'Maybe' the closes creature in front of a point in a given direction for
-a given distance.
-The shapes within which creatures are searched are a triangle then rectangle.  -}
-nearestCrInFront 
-    :: Point2
-    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
-    -> Float    -- ^ Distance.
-    -> World -> Maybe Creature
-nearestCrInFront p dir x
-    = safeMinimumOn (dist p . _crPos)
-    . IM.filter (\cr -> pointInPolygon (_crPos cr) rec)
-    . _creatures
-  where 
-    rec = [p, pR, pR1, pL1, pL ]
-    pR  = p +.+ rotateV (dir - pi*(3/8)) (V2 (x/2) 0)
-    pL  = p +.+ rotateV (dir + pi*(3/8)) (V2 (x/2) 0)
-    pR1 = pR +.+ rotateV dir (V2 (x/2) 0)
-    pL1 = pL +.+ rotateV dir (V2 (x/2) 0)
-{- | Test whether a creature is in a polygon.  -}
-crInPolygon :: Creature -> [Point2] -> Bool
-crInPolygon = pointInPolygon . _crPos
 
 {- | Create a logistic function given three parameters.  -}
 logistic :: Float -> Float -> Float -> (Float -> Float)
@@ -375,11 +125,6 @@ mvPointToward !ep !p
     | dist p ep < 1 = ep
     | otherwise     = p +.+ normalizeV (ep -.- p)
 
-isAnimate :: Creature -> Bool
-{-# INLINE isAnimate #-}
-isAnimate cr = case _crActionPlan cr of
-    Inanimate -> False
-    _   -> True
 
 sigmoid :: Floating a => a -> a
 sigmoid x = x/sqrt(1+x^(2::Int))

src/Dodge/Base/Collide.hs

@@ -16,6 +16,23 @@ module Dodge.Base.Collide
     , wlIsSeeThrough
     , wallsOnCirc
     , wallsOnLineHit
+    , collideCircWalls
+    , collideCircWalls'
+    , circOnSomeWall
+    , collidePointWalls
+    , collidePointWallsNorm
+    , collidePointWalls'
+    , overlapCircWallsReturnWall
+    , collideCircCrsPoint
+    , collideCircCreatures
+    , collidePointCreatures
+    , collidePointAnyWallsReflect
+    , crsNearPoint
+    , crsOnLine
+    , crsOnThickLine
+    , nearestCrInRad
+    , nearestCrInTri
+    , nearestCrInFront
     ) where
 import Dodge.Data
 import Dodge.Zone
@@ -28,6 +45,7 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import qualified FoldlHelp as L
+import Data.Monoid
 
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
@@ -323,3 +341,196 @@ wallsOnCirc p r = IM.filter f
 
 --wallNormal :: Wall -> Point2
 --wallNormal = normalizeV . vNormal . uncurry (-.-) . _wlLine
+-- | Looks for overlap of a circle with walls.
+-- If found, gives wall
+overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall
+overlapCircWallsReturnWall p rad
+    = L.fold (safeMinimumOnMaybeL (fmap (dist p) . f . _wlLine))
+  where 
+    f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b
+
+-- | Looks for any collision of a circle with walls.
+-- If found, gives point and reflection velocity, reflection damped in normal.
+-- note that in this version the circle can overlap the wall
+collidePointAnyWallsReflect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collidePointAnyWallsReflect p1 p2 
+    = getFirst
+    . foldMap (First . findPoint . _wlLine)
+  where 
+    findPoint (x,y) = case intersectSegSeg p1 p2 x y of
+        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+        Nothing -> Nothing
+
+-- | Looks for collision of a point with walls.
+-- If found, gives collision point
+-- If not found, returns point
+collidePointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
+collidePointWalls p1 p2 = foldr findPoint p2 . fmap _wlLine
+  where
+    findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
+collidePointWalls' :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
+collidePointWalls' p1 p2 = foldl' findPoint p2 . fmap _wlLine
+  where
+    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p)
+
+-- | Looks for first collision of a circle with walls.
+-- If found, gives point and reflection velocity, reflection damped in normal.
+-- note that the "intersection" point is the center of the circle flush against the wall
+collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
+  where 
+    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
+    getp (Left p) = p
+    getp (Right (p,_)) = p
+    doReflection p (x,y) = case intersectSegSeg p1 p x y of
+        Nothing -> Nothing
+        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+    shiftByRad (a,b) =
+        (g $ a +.+ rad *.* normalizeV (a -.-b)
+        ,g $ b +.+ rad *.* normalizeV (b -.-a)
+        )
+      where
+        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
+
+-- | Looks for first collision of a circle with walls.
+-- If found, gives point and reflection velocity, reflection damped in normal.
+collideCircWalls :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collideCircWalls p1 p2 rad
+    = safeMinimumOn (dist p1 . fst) 
+    . IM.mapMaybe 
+        (( \(x:y:_) -> fmap 
+            ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
+            . (+.+ normalizeV (vNormal (x -.- y)))
+            ) 
+            (intersectSegSeg p1 p2 x y)
+         ) 
+         . shiftByRad . _wlLine
+        )
+  where 
+    shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
+        [a +.+ rad *.* normalizeV (a -.-b)
+        ,b +.+ rad *.* normalizeV (b -.-a)
+        ]
+-- this shifts the wall out, and for outer corners extends the wall
+-- not sure what this does for inner corners, hopefully won't cause a problem
+-- the alternative would be to separately bounce off corner points...
+-- unfortunately, doesn't allow for collisions when the circle spawns on the
+-- wall
+
+-- | Looks for first collision of a point with a list of lines.
+-- If found, gives point and normal of wall.
+--collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
+--collidePointLines p1 p2 ws 
+--    = safeMinimumOn f
+--    $ mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
+--        . _wlLine') ws
+--  where 
+--    f (a,_) = magV (p1 -.- a)
+--
+
+-- | Looks for first collision of a point with walls.
+-- If found, gives point and normal of wall.
+collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collidePointWallsNorm p1 p2 ws 
+    = safeMinimumOn (dist p1 . fst)
+    $ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) ) 
+        . _wlLine) ws
+-- | Returns the first creature, if any, that a point intersects with.
+collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
+collidePointCreatures p1 p2 = fmap fst 
+    . safeMinimumOn snd
+    . IM.toList 
+    . IM.mapMaybe (\x -> dist p1 <$> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
+-- | As for 'collidePointCreatures', only increases the radius of creatures by a
+--fixed amount, thus collides a moving circle with creaures.
+collideCircCreatures :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe Int
+collideCircCreatures p1 p2 rad = collidePointCreatures p1 p2 . fmap (crRad +~ rad)
+
+-- | Returns the first creature id, if any, that a point intersects with, gives point
+--in creature on line.
+collidePointCrsPoint :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe (Point2,Int)
+collidePointCrsPoint p1 p2 = fmap f 
+    . safeMinimumOn (dist p1 . snd)
+    . IM.toList 
+    . IM.mapMaybe (\x -> intersectCircSegFirst (_crPos x) (_crRad x) p1 p2) 
+  where 
+    f (cID,p) = (p,cID)
+{- | Finds the first creature hit on a line.
+Maybe evaluates the creature id and hit point. -}
+collideCircCrsPoint :: Point2 -> Point2 -> Float -> IM.IntMap Creature -> Maybe (Point2,Int)
+collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
+
+---- | Makes a creature not hittable.
+--collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
+--collidePointCrsWithoutPoint cid p1 p2 w 
+--    = fmap f 
+--    . safeMinimumOn (snd . snd)
+--    . IM.toList 
+--    . IM.mapMaybe (\x -> collidePointCirc'' p1 p2 (_crRad x) (_crPos x)) 
+--    . IM.delete cid 
+--    $ _creatures w
+--  where 
+--    f (cID,(p,_)) = (p,cID)
+{- | Test if a circle collides with any wall. 
+ - Note no check on whether the wall is walkable. -}
+circOnSomeWall :: Point2 -> Float -> World -> Bool
+circOnSomeWall p rad
+    = any (\(x,y) -> circOnSeg x y p rad) 
+    . fmap _wlLine 
+    . IM.elems 
+    . wallsNearPoint p
+{- | Adds the distance to the creature radius, tests whether the center is in
+the circle of this size centered at the point -}
+crsNearPoint :: Float -> Point2 -> World -> Bool
+crsNearPoint d p = any (\c -> dist (_crPos c) p < (d + _crRad c)) . _creatures
+{- | Produce an unordered list of creatures on a line. -}
+crsOnLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
+crsOnLine p1 p2
+    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
+    . _creatures
+{- | Produce an unordered list of creatures on a wide line. -}
+crsOnThickLine :: Float -> Point2 -> Point2 -> World -> IM.IntMap Creature
+crsOnThickLine thickness p1 p2
+    = IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr + thickness))
+    . _creatures
+{- | Find 'Maybe' the closest creature to a point, within a circle.
+ -}
+nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature
+nearestCrInRad p r
+    = safeMinimumOn (dist p . _crPos)
+    . IM.filter (\cr -> dist p (_crPos cr) < r) 
+    . _creatures
+{- | Find 'Maybe' the closest creature in front of a point in a right-angle-triangle shape.  -}
+nearestCrInTri 
+    :: Point2 
+    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
+    -> Float    -- ^ Distance. 
+    -> World -> Maybe Creature
+nearestCrInTri p dir x
+    = safeMinimumOn (dist p . _crPos)
+    . IM.filter (\cr -> pointInPolygon (_crPos cr) tri) 
+    . _creatures
+ where 
+    tri = 
+        [p 
+        ,p +.+ rotateV (dir-pi/4) (V2 x 0)
+        ,p +.+ rotateV (dir+pi/4) (V2 x 0)
+        ]
+{- | Find 'Maybe' the closes creature in front of a point in a given direction for
+a given distance.
+The shapes within which creatures are searched are a triangle then rectangle.  -}
+nearestCrInFront 
+    :: Point2
+    -> Float    -- ^ Direction (radians +ve anticlockwise from x-axis).
+    -> Float    -- ^ Distance.
+    -> World -> Maybe Creature
+nearestCrInFront p dir x
+    = safeMinimumOn (dist p . _crPos)
+    . IM.filter (\cr -> pointInPolygon (_crPos cr) rec)
+    . _creatures
+  where 
+    rec = [p, pR, pR1, pL1, pL ]
+    pR  = p +.+ rotateV (dir - pi*(3/8)) (V2 (x/2) 0)
+    pL  = p +.+ rotateV (dir + pi*(3/8)) (V2 (x/2) 0)
+    pR1 = pR +.+ rotateV dir (V2 (x/2) 0)
+    pL1 = pL +.+ rotateV dir (V2 (x/2) 0)

src/Dodge/Creature/ReaderUpdate.hs

@@ -18,6 +18,7 @@ import Dodge.Data
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
 import Dodge.Base
+import Dodge.Zone
 import Geometry
 import FoldableHelp
 

src/Dodge/Creature/Test.hs

@@ -108,3 +108,9 @@ crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d)
 
 crNearPoint :: Float -> Point2 -> Creature -> Bool
 crNearPoint d p cr = dist (_crPos cr) p < d + _crRad cr
+
+isAnimate :: Creature -> Bool
+{-# INLINE isAnimate #-}
+isAnimate cr = case _crActionPlan cr of
+    Inanimate -> False
+    _   -> True

src/Dodge/Data.hs

@@ -506,7 +506,6 @@ data Item = Item
     , _itIsHeld     :: Bool
     , _itEffect     :: ItEffect
     , _itInvSize    :: Float
-    , _itInvDisplay :: Item -> [String]
     , _itInvColor   :: Color
     , _itTargeting  :: Targeting
     , _itDimension  :: ItemDimension
@@ -1400,7 +1399,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutButton {_putButton :: Button}
     | PutProp Prop
     | PutTerminal {_unputTerminal :: Terminal}
-    | PutFlIt Item
+    | PutFlIt {_putItem :: Item}
     | PutPPlate PressPlate
     | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2] }
     | PutCoord Point2

src/Dodge/Default/Item.hs

@@ -1,21 +1,10 @@
 module Dodge.Default.Item
-    ( basicItemDisplay
-    , maybeWarmupStatus
-    , maybeRateStatus
-    , moduleStrings
-    , defaultItem
+    ( defaultItem
     ) where
 import Dodge.Data
-import Padding
-import Dodge.Inventory.ItemSpace
-import Dodge.Module
 import Picture
 import Shape
 
-import Data.Maybe
-import Data.Sequence
-import Control.Lens
-
 defaultItem :: Item
 defaultItem = Item
     { _itCurseStatus = Uncursed
@@ -25,7 +14,6 @@ defaultItem = Item
     , _itID = Nothing
     , _itIsHeld = False
     , _itInvColor = yellow
-    , _itInvDisplay = basicItemDisplay
     , _itInvSize = 1
     , _itInvPos = Nothing
     , _itDimension = ItemDimension 0 0 NoPortage (const mempty)
@@ -39,51 +27,5 @@ defaultItem = Item
     , _itValue = ItemValue 0 MundaneItem
     }
 
-{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
--- TODO make work on remote launchers
-basicItemDisplay :: Item -> [String]
-basicItemDisplay it = Prelude.take (itSlotsTaken it) $
-    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
-    : catMaybes [maybeWarmupStatus it]
-    ++ moduleStrings it ++ repeat "*"
-  where 
-    thename  = show . _iyBase $ _itType it
-    thenumber = case it ^? itConsumption of
-        Just am@LoadableAmmo{} -> case _laReloadState am of 
-            Nothing' -> show (_laLoaded am)
-            Just' x  -> show x ++ "R" ++ show (_laLoaded am)
-        Just am@ChargeableAmmo{} -> show $ _wpCharge am
-        Just x@ItemItselfConsumable{} -> show (_icAmount x)
-        Just NoConsumption -> ""
-        Nothing -> ""
-    theparam = fromMaybe []
-        . listToMaybe 
-        $ mapMaybe ($ it) 
-        [ maybeModeStatus
---        , maybeWarmupStatus
---        , maybeRateStatus
-        ]
--- this can be moved to Dodge/Module and unified with moduleSizes
-
-maybeModeStatus :: Item -> Maybe String
-maybeModeStatus it = case it ^? itAttachment of
-    Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
-    Just AttachMode {_atMode = i} -> Just $ show i
-    _   -> Nothing
-
-maybeRateStatus :: Item -> Maybe String
-maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of
-    Nothing -> Nothing
-    _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it))
-
-maybeWarmupStatus :: Item -> Maybe String
-maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
-    Nothing -> Nothing
-    Just m  -> case m - (_warmTime . _useDelay $ _itUse it) of
-        x | x <= 1      -> Just "*WARM"
-          | otherwise   -> let n = show x
-                in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
-
 defaultItemType :: ItemType
 defaultItemType = ItemType NOTDEFINED mempty NoStack
-

src/Dodge/Default/Weapon.hs

@@ -107,7 +107,6 @@ defaultGun = defaultItem
     , _itInvPos = Nothing
     , _itIsHeld = False
     , _itEffect = NoItEffect
-    , _itInvDisplay = basicItemDisplay
     , _itInvColor = white
     , _itInvSize  = 1
     , _itParams = NoParams

src/Dodge/Floor.hs

@@ -39,11 +39,7 @@ import Data.List (intersperse)
 initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
         $ intersperse (AnTree corDoor)
---    [ IntAnno $ AnTree . startRoom
-    [ AnRoom tanksPipesRoom
-    , AnRoom tanksPipesRoom
-    , AnRoom $ tanksRoom [] []
-    , AnRoom roomPillarsPassage
+    [ IntAnno $ AnTree . startRoom
     , AnTree firstBreather
 --     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
     , AnRoom $ roomCCrits 10

src/Dodge/Item/Display.hs

@@ -0,0 +1,60 @@
+module Dodge.Item.Display where
+import Dodge.Module
+import Dodge.Data
+import Dodge.Inventory.ItemSpace
+import Padding
+import LensHelp
+
+import Data.Maybe
+import Data.Sequence
+
+itemString :: Item -> String
+itemString = head . itemDisplay
+
+{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
+-- TODO make work on remote launchers
+itemDisplay :: Item -> [String]
+itemDisplay it = Prelude.take (itSlotsTaken it) $
+    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
+    : catMaybes [maybeWarmupStatus it]
+    ++ moduleStrings it ++ repeat "*"
+  where 
+    thename  = show . _iyBase $ _itType it
+    thenumber = case it ^? itConsumption of
+        Just am@LoadableAmmo{} -> case _laReloadState am of 
+            Nothing' -> show (_laLoaded am)
+            Just' x  -> show x ++ "R" ++ show (_laLoaded am)
+        Just am@ChargeableAmmo{} -> show $ _wpCharge am
+        Just x@ItemItselfConsumable{} -> show (_icAmount x)
+        Just NoConsumption -> ""
+        Nothing -> ""
+    theparam = fromMaybe []
+        . listToMaybe 
+        $ mapMaybe ($ it) 
+        [ maybeModeStatus
+--        , maybeWarmupStatus
+--        , maybeRateStatus
+        ]
+
+--    & itInvDisplay .~ \it -> head (basicItemDisplay it) : 
+--        ["*FIRERATE:" ++ fromMaybe "" (maybeRateStatus it)
+--        ]
+
+maybeWarmupStatus :: Item -> Maybe String
+maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
+    Nothing -> Nothing
+    Just m  -> case m - (_warmTime . _useDelay $ _itUse it) of
+        x | x <= 1      -> Just "*WARM"
+          | otherwise   -> let n = show x
+                in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
+
+maybeModeStatus :: Item -> Maybe String
+maybeModeStatus it = case it ^? itAttachment of
+    Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
+    Just AttachMode {_atMode = i} -> Just $ show i
+    _   -> Nothing
+
+maybeRateStatus :: Item -> Maybe String
+maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of
+    Nothing -> Nothing
+    _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it))

src/Dodge/Item/Equipment.hs

@@ -139,10 +139,6 @@ flatShield = defaultEquipment
         , _heldScroll = \_ _ -> id
         }
     , _itInvSize = 3
-    , _itInvDisplay = \it -> head (basicItemDisplay it) : 
-        ["*" ++ replicate 13 ' ' ++ "*"
-        ,"*" ++ replicate 13 ' ' ++ "*"
-        ]
     }
     & itType . iyBase .~ FLATSHIELD
 flatShieldEquipSPic :: Item -> SPic

src/Dodge/Item/Weapon/BulletGun/Rod.hs

@@ -7,7 +7,6 @@ module Dodge.Item.Weapon.BulletGun.Rod
     , machineGun
     ) where
 import Dodge.Data
-import Dodge.Default.Item
 import Dodge.Item.Weapon.BulletGun.Clip
 import Dodge.Particle.HitEffect
 import Dodge.Particle.Damage
@@ -33,7 +32,6 @@ import Shape
 --import Sound.Data
 import LensHelp
 
-import Data.Maybe
 --import qualified Data.Sequence as Seq
 --import Control.Lens
 --import Control.Monad.State
@@ -150,6 +148,3 @@ machineGun = bangRod
     & itConsumption . laReloadTime .~ 75
     & itInvSize .~ 3
     & itParams. torqueAfter .~ 0.2 -- not sure if this is necessary?
-    & itInvDisplay .~ \it -> head (basicItemDisplay it) : 
-        ["*FIRERATE:" ++ fromMaybe "" (maybeRateStatus it)
-        ]

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -16,6 +16,7 @@ module Dodge.Item.Weapon.ExtraEffect
     ) where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Zone
 import Dodge.SoundLogic
 --import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect

src/Dodge/Placement/Instance/Door.hs

@@ -5,7 +5,7 @@ module Dodge.Placement.Instance.Door
     , switchDoor -- not used 9/3/22
     ) where
 import Dodge.Data
-import Dodge.Base
+--import Dodge.Base
 import Color
 import Geometry
 import Dodge.LevelGen.Data

src/Dodge/Render/HUD.hs

@@ -3,6 +3,7 @@ module Dodge.Render.HUD
     ( hudDrawings
     ) where
 import Dodge.Data
+import Dodge.Item.Display
 import Dodge.Combine
 import Dodge.Clock
 import Dodge.Base
@@ -281,7 +282,7 @@ invDimColor :: Color
 invDimColor = greyN 0.7
 closeObjectToTextPictures :: Int -> Either FloorItem Button -> [Picture]
 closeObjectToTextPictures nfreeslots e = case e of
-    Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ _itInvDisplay it it
+    Left flit -> let it = _flIt flit in map (applycolor it . textindent) $ itemDisplay it
     Right bt  -> [color yellow $ textindent $ _btText bt]
   where
     textindent = text . (replicate clObjIntIn ' '++)
@@ -369,9 +370,9 @@ mainListCursor c = openCursorAt 120 c 5 0
 itemText :: Item -> [Picture]
 {-# INLINE itemText #-}
 itemText it = f $ case _itCurseStatus it of
-    UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
+    UndroppableIdentified -> map (color yellow . text) (itemDisplay it)
 --        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
-    _ -> map (color thecolor . text) (_itInvDisplay it it)
+    _ -> map (color thecolor . text) (itemDisplay it)
   where
     thecolor = _itInvColor it
     f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))

src/Dodge/Room/Breather.hs

@@ -31,8 +31,7 @@ import Dodge.Room.Containing
 firstBreather :: State StdGen (MetaTree Room String)
 firstBreather = do
     itms <- takeOne 
-        [[]
-        ,[itemFromBase $ CRAFT TUBE]
+        [[itemFromBase $ CRAFT TUBE]
         ,[itemFromBase $ CRAFT PIPE]
         ,[itemFromBase $ CRAFT HARDWARE]
         ,[itemFromBase $ CRAFT CAN]

src/Dodge/Room/Containing.hs

@@ -1,6 +1,7 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Room.Containing where
 import Dodge.Data
+import Dodge.Item.Display
 import Dodge.Tree
 import Dodge.LevelGen.Data
 import Dodge.PlacementSpot
@@ -16,7 +17,9 @@ import Geometry
 --import Dodge.Item.Equipment
 
 roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String)
-roomsContaining crs its = tToBTree "roomsContaining" <$> roomsContaining' crs its
+roomsContaining crs its = tToBTree str <$> roomsContaining' crs its
+  where
+    str = "roomsContaining "++ concatMap _crName crs ++ concatMap (head . itemDisplay) its
 
 roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
 roomsContaining' crs its = do
@@ -24,6 +27,7 @@ roomsContaining' crs its = do
         [ roomPillarsSquare <&> rmPmnts .++~ crsItmsUnused crs its
         , randomFourCornerRoomCrsIts crs its 
         , tanksRoom crs its
+        , tanksPipesRoom <&> rmPmnts ++.~ crsItmsUnused crs its
         , roomPillarsContaining crs its
         , roomPillarsPassage <&> rmPmnts .++~ crsItmsUnused crs its
         ]

src/Dodge/Room/Room.hs

@@ -10,6 +10,7 @@ module Dodge.Room.Room
     , corDoor
     ) where
 import Dodge.Cleat
+import Dodge.Item.Display
 import Dodge.Data
 import Dodge.PlacementSpot
 import Dodge.RoomLink
@@ -135,8 +136,8 @@ roomCenterPillar = do
         ]
 
 {- Probabilites of the type of the first floor weapon.  -}
-randFirstWeapon :: State StdGen PSType
-randFirstWeapon = takeOne $ map PutFlIt $
+randFirstWeapon :: State StdGen Item
+randFirstWeapon = takeOne $
     replicate 10 pistol
     ++ replicate 5 (bangStick 4)
     ++ replicate 5 (bangCaneX 3)
@@ -148,7 +149,7 @@ weaponEmptyRoom = do
     w <- state $ randomR (220,300)
     h <- state $ randomR (220,300)
     let plmnts = 
-            [sPS (V2 (w/2)  (h-40)) 0      $ RandPS randFirstWeapon
+            [sPS (V2 (w/2)  (h-40)) 0      $ RandPS $ fmap PutFlIt randFirstWeapon
             ,sPS (V2 20     20)     (pi/2) randC1
             ,sPS (V2 (w-20) 20)     (pi/2) randC1
             ,mntLightLnkCond useUnusedLnk
@@ -160,7 +161,7 @@ weaponEmptyRoom = do
      
 weaponUnderCrits :: RandomGen g => Int -> State g (MetaTree Room String)
 weaponUnderCrits i = do
-    let addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon)
+    let addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
         continuationRoom = treePost
             [ addwpat (V2 20 0) corridorN
             , addwpat (V2 20 0) corridorN
@@ -185,13 +186,13 @@ weaponBehindPillar  = do
     return $ treePost 
         [ corridor
         , rcp & rmPmnts ++.~
-            [sPS wpos wpa $ RandPS randFirstWeapon
+            [sPS wpos wpa $ RandPS $ fmap PutFlIt randFirstWeapon
             ,sPS cpos (argV $ V2 120 80 -.- cpos) randC1
             ]
         , cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN
         ]
 
-weaponBetweenPillars :: RandomGen g => State g (Tree Room)
+weaponBetweenPillars :: State StdGen (MetaTree Room String)
 weaponBetweenPillars = do
     (w,wn) <- takeOne [(240,2),(340,3)]
     (h,hn) <- takeOne [(240,2),(340,3)]
@@ -202,13 +203,14 @@ weaponBetweenPillars = do
             , any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
             ]
     ncrits <- state $ randomR (1,3)
+    wp <- randFirstWeapon
     critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> 
         rpIsOnPath rp
         && _rpPlacementUse rp == 0
         && all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
-    fmap pure $ roomPillars 30 w h wn hn 
-        <&> rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
-        <&> cleatOnward
+    (fmap pure $ roomPillars 30 w h wn hn 
+        <&> rmPmnts .++~ map (`sps` randC1) critPlacementSpots ++ [ sps wpPos (PutFlIt wp) ]
+        <&> cleatOnward) >>= rToOnward ("weaponBetweenPillars_"++itemString wp)
 
 weaponLongCorridor :: RandomGen g => State g (Tree Room)
 weaponLongCorridor = do
@@ -222,7 +224,7 @@ weaponLongCorridor = do
     return $ Node rt [branch1,branch2]
   where 
     putCrs = rmPmnts .++~ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ]
-    putWp  = rmPmnts .~ [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
+    putWp  = rmPmnts .~ [sPS (V2 20 60) 0 $ RandPS $ fmap PutFlIt randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
 
 critInDeadEnd :: Room
 critInDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) 0 randC1]
@@ -239,12 +241,12 @@ deadEndRoom = defaultRoom
   where 
     lnks = [(V2 0 30  ,0) ]
 {- A random Either tree with a weapon and melee monster challenge.  -}
-weaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
+weaponRoom :: Int -> State StdGen (MetaTree Room String)
 weaponRoom i = join $ takeOne 
     [ weaponEmptyRoom       >>= rToOnward "weaponEmptyRoom"
     , weaponUnderCrits i  -- this int is used for PickOnePlacement
     , weaponBehindPillar    >>= rToOnward "weaponBehindPillar"
-    , weaponBetweenPillars  >>= rToOnward "weaponBetweenPillars"
+    , weaponBetweenPillars--  >>= rToOnward "weaponBetweenPillars"
     , weaponLongCorridor    >>= rToOnward "weaponLongCorridor"
     ]
 

src/Dodge/Room/Start.hs

@@ -56,7 +56,7 @@ powerFakeout = do
             ,cleatOnward door]
 
 -- the i is used either for a PickOnePlacement or a room id, this is not great
-startRoom :: RandomGen g => Int -> State g (MetaTree Room String)
+startRoom :: Int -> State StdGen (MetaTree Room String)
 startRoom i = join $ takeOne
     [ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom i
     , rezBoxesWpCrit            >>= rToOnward "rezBoxesWpCrit"

src/Dodge/Tree/Compose.hs

@@ -126,4 +126,4 @@ numMetaTree' (MTree lab mn bs) = do
     return $ MTree (is,lab) (mn & nodeMetaTree %~ (\nmt -> evalState (numMetaTree' nmt) (0:is))) bs'
 
 showIntsString :: ([Int],String) -> String
-showIntsString (is,s) = foldr1 (++) (intersperse ":" (map show is)) ++ ':':s
+showIntsString (is,s) = foldr1 (++) (intersperse ":" (map show $ reverse is)) ++ ':':s

src/Dodge/Update/Camera.hs

@@ -210,7 +210,7 @@ farWallDistDirection :: Point2 -> Configuration -> World -> (Float,Float,Float,F
 --farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
 farWallDistDirection p cfig w = foldr (m . f) (0,0,0,0) vps
   where
-    f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilter' wlIsOpaque p q wos -.- p
+    f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWalls' p q (IM.filter wlIsOpaque wos) -.- p
     g (V2 x y) = (y, negate y, x, negate x)
     m (a,b,c,d) (x,y,z,w') = (max a x, max b y, max c z, max d w')
     vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -8,7 +8,6 @@ module Dodge.WorldEvent.SpawnParticle
     , concBall
     ) where
 import Dodge.Data
-import Dodge.Base
 import Dodge.Zone
 import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Particle.Damage

src/Dodge/Zone.hs

@@ -17,12 +17,18 @@ module Dodge.Zone
     , wallsNearZones
     , zoneOfSight
     , flattenIMIMIM
+    , creaturesNearPointI
+    , creaturesNearPoint
+    , creatureNearPoint
+    , creatureNearPointI
+    , creaturesAlongLine
     )
     where
 import Dodge.Data
 import Dodge.Base.Window
 import Geometry
 import Geometry.Zone
+import qualified FoldlHelp as L
 
 import Data.Maybe
 import Data.List
@@ -179,3 +185,32 @@ wallsNearPoint p w =  IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1
 
 flattenIMIMIM :: IM.IntMap (IM.IntMap (IM.IntMap a)) -> IM.IntMap a
 flattenIMIMIM = IM.unions . fmap IM.unions
+
+creatureNearPoint :: Point2 -> World -> Maybe Creature
+creatureNearPoint = creatureNearPointI 1
+
+creatureNearPointI :: Int -> Point2 -> World -> Maybe Creature
+creatureNearPointI n p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPointI n p
+
+creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
+creaturesNearPoint = creaturesNearPointI 1
+
+creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature
+creaturesNearPointI n p w =  IM.unions 
+    [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-n..x+n] , b<-[y-n..y+n]]
+  where 
+    (x,y) = crZoneOfPoint p
+    f i m = fromMaybe IM.empty $ IM.lookup i m
+
+-- possible BUG, occurs when used in thingsHitLongLine
+creaturesAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Creature
+--creaturesAlongLine a b w = IM.unions [f y $ f x $ _creaturesZone w | (x,y) <- zoneOfLine a b]
+--    where f i m = case IM.lookup i m of Just val -> val
+--                                        _        -> IM.empty
+
+creaturesAlongLine a b w = IM.foldrWithKey' g IM.empty (zoneOfLineIntMap a b)
+  where 
+    g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _creaturesZone w) s))
+    f i = fromMaybe IM.empty . IM.lookup i
+--    f i m = case IM.lookup i m of Just val -> val
+--                                  _        -> IM.empty