Split off StreamingHelp module

src/Dodge/Base/Collide.hs

@@ -17,6 +17,7 @@ module Dodge.Base.Collide
     , bounceBall
     , bouncePoint
     , sortStreamOn
+    , minStreamOn
 --    , wallsOnCirc
 --    , wallsOnCirc'
     , wallsOnLineHit
@@ -53,13 +54,12 @@ import Geometry
 import FoldableHelp
 
 import Data.Maybe
-import Data.Function (on)
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
-import qualified FoldlHelp as L
+--import qualified FoldlHelp as L
 import Data.Monoid
-import Streaming
+import StreamingHelp
 import qualified Streaming.Prelude as S
 
 collidePoint :: Point2 -> Point2 
@@ -96,14 +96,6 @@ collidePointWallsFilterStream t sp ep = collidePoint sp ep
     . S.filter t
     . wallsAlongLine sp ep
 
--- this hopefully also nub the stream in most cases
---orderStreamOn :: Ord b => (a -> b) -> Stream (Of a) Identity () -> Identity (Of (M.Map b a) ())
-sortStreamOn :: Ord a => (b -> a) -> Stream (Of b) Identity () -> Stream (Of b) Identity ()
-{-# INLINE sortStreamOn #-}
-sortStreamOn f = S.each . runIdentity . L.purely S.fold_ L.map . S.map g
-  where
-    g x = (f x,x)
-
 overlapSegWalls :: Point2 -> Point2 -> Stream (Of Wall) Identity () 
     -> Stream (Of (Point2,Wall)) Identity ()
 overlapSegWalls sp ep = S.mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)
@@ -168,8 +160,7 @@ collideCircWallsStream sp ep rad = runIdentity
         f = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
 
 overlapCircWallsClosest :: Point2 -> Float -> Stream (Of Wall) Identity () -> Maybe (Point2,Wall)
-overlapCircWallsClosest p r = runIdentity
+overlapCircWallsClosest p r = minStreamOn (dist p . fst)
-    . L.purely S.fold_ (L.minimumBy (compare `on` (dist p . fst)))
     . overlapCircWalls p r
 
 -- | Looks for first collision of a circle with walls.
@@ -250,10 +241,7 @@ circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine
 --    . 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 -}
-anyCrNearPoint :: Float -> Point2 -> World -> Bool
-anyCrNearPoint 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

src/Dodge/Creature/ReaderUpdate.hs

@@ -20,13 +20,14 @@ import Dodge.Creature.Volition
 import Dodge.Base
 import Dodge.Zone
 import Geometry
-import FoldableHelp
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Applicative
 import Data.Maybe
 import Data.Bifunctor
+--import StreamingHelp
+import qualified Streaming.Prelude as S
 
 overrideMeleeCloseTarget :: Creature -> Creature
 overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -76,8 +77,7 @@ 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
-            nearACCs = IM.filter isFarACC $ creaturesNearPointI 5 cpos w
+            macr = minStreamOn (dist cpos . _crPos) . S.filter isFarACC $ crsInsideCirc cpos 50 w
-            macr = safeMinimumOn (dist cpos . _crPos) nearACCs
             in case macr of
                 Nothing  -> cr
                 Just acr ->

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -28,7 +28,6 @@ import Picture
 import Geometry.Vector
 import Geometry.Data
 import LensHelp
-import qualified FoldlHelp as L
 import Sound.Data
 import ShortShow
 
@@ -36,7 +35,7 @@ import qualified Data.Map.Strict as M
 --import Data.Bifunctor
 import Data.Maybe
 --import qualified Control.Foldl as L
---import qualified Data.Set as S
+import qualified Streaming.Prelude as S
 import qualified SDL
 autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
 autoEffect eff t sid itm cr w
@@ -129,9 +128,9 @@ targetRBCreatureUp it cr w t
         & tgActive .~ False 
         )
   where
-    newtarg = L.fold 
+    newtarg = minStreamOn (dist mwp . _crPos)
-        (L.prefilter (canseepos . _crPos) $ L.minimumOn (dist mwp . _crPos)) 
+        . S.filter (canseepos . _crPos)
-        $ creaturesNearPointI 3 mwp w
+        $ crsInsideCirc mwp 40 w
     canseepos p = hasLOS (_crPos cr) p w
     mwp = mouseWorldPos w
     updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -25,6 +25,7 @@ import LensHelp
 
 import Data.Foldable
 import Data.Tuple
+import StreamingHelp
 import qualified Streaming.Prelude as S
 aFlameParticle 
     :: Int      -- ^ Timer
@@ -240,14 +241,13 @@ makeGasCloud pos vel w = w
     (col, g) = runState (takeOne [green,yellow]) $ _randGen w
 {- Attach poison cloud damage to creatures near cloud.  -}
 cloudPoisonDamage :: Cloud -> World -> World
-cloudPoisonDamage c w = w & creatures 
+cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w)
-    %~ dodamagesto damagedCrs
   where 
-    dodamagesto :: StreamOf Creature -> IM.IntMap Creature -> IM.IntMap Creature
+    dodamagesto :: StreamOf Creature -> World -> World
-    dodamagesto = undefined
+    dodamagesto scrs mcrs = runIdentity $ S.fold_ (flip doDam) mcrs id scrs
-    damagedCrs = S.filter f $ crsNearPoint clpos w
+    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
-    doDam cr = cr & crState . csDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
     clpos = stripZ $ _clPos c
 
 incBall :: RandomGen g => Point2 -> State g Particle

src/Dodge/Zone.hs

@@ -4,6 +4,7 @@ module Dodge.Zone
     , wallsAlongLine
     , crsNearSeg
     , wallsInsideCirc
+    , crsInsideCirc
     , lookLookups
     , zoneOfSeg
     , zoneNearPointIP
@@ -15,10 +16,6 @@ module Dodge.Zone
     , flattenIMIMIM
     , wlZoneOfPoint
     , crsNearPoint
-    , creaturesNearPointI
---    , creaturesNearPoint
-    , creatureNearPoint
-    , creatureNearPointI
     , creaturesAlongLine
     , module Dodge.Zone.Size
     )
@@ -31,7 +28,7 @@ import Geometry.Zone
 import qualified FoldlHelp as L
 
 import qualified Streaming.Prelude as S
-import Streaming
+import StreamingHelp
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -106,6 +103,11 @@ crsNearSeg sp ep w = S.concat $ S.mapMaybe f $ zoneOfSeg crZoneSize sp ep
   where
     f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j
 
+crsInsideCirc :: Point2 -> Float -> World -> StreamOf Creature
+crsInsideCirc p r w = S.concat $ S.mapMaybe f $ zoneInsideCirc crZoneSize p r
+  where
+    f (V2 i j) = w ^? creaturesZone . znObjects . ix i . ix j
+
 wallsInsideCirc :: Point2 -> Float -> World -> Stream (Of Wall) Identity ()
 wallsInsideCirc p r w = S.concat $ S.mapMaybe f $ zoneInsideCirc wlZoneSize p r
   where
@@ -130,9 +132,6 @@ crsNearPoint p = S.each . fromMaybe mempty . (^? creaturesZone . znObjects . ix
   where
     V2 x y = crZoneOfPoint 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]]

src/Geometry/Data.hs

@@ -8,8 +8,6 @@ module Geometry.Data
 import Linear.V2
 import Linear.V3
 import Linear.V4
-import Streaming
-type StreamOf a = Stream (Of a) Identity ()
 type Int2   = V2 Int
 type Point2 = V2 Float
 type Point3 = V3 Float

src/StreamingHelp.hs

@@ -0,0 +1,25 @@
+module StreamingHelp 
+    ( minStreamOn
+    , sortStreamOn
+    , StreamOf
+    , module Streaming
+    ) where
+import Streaming
+import qualified Streaming.Prelude as S
+import qualified Control.Foldl as L
+import Data.Function (on)
+
+type StreamOf a = Stream (Of a) Identity ()
+
+minStreamOn :: Ord a => (b -> a) -> StreamOf b -> Maybe b
+{-# INLINE minStreamOn #-}
+minStreamOn f = runIdentity
+    . L.purely S.fold_ (L.minimumBy (compare `on` f))
+
+-- this hopefully also nub the stream in most cases
+--orderStreamOn :: Ord b => (a -> b) -> Stream (Of a) Identity () -> Identity (Of (M.Map b a) ())
+sortStreamOn :: Ord a => (b -> a) -> StreamOf b -> Stream (Of b) Identity ()
+{-# INLINE sortStreamOn #-}
+sortStreamOn f = S.each . runIdentity . L.purely S.fold_ L.map . S.map g
+  where
+    g x = (f x,x)