Refactor wall zoning, remove streaming
This commit is contained in:
@@ -11,11 +11,13 @@ module Dodge.WorldEvent.ThingsHit
|
||||
, wlsHitRadial
|
||||
)
|
||||
where
|
||||
import Dodge.Zoning.Wall
|
||||
import Dodge.Zoning.Creature
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.Zone
|
||||
import Geometry
|
||||
import qualified ListHelp as List
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
@@ -31,10 +33,19 @@ thingsHit
|
||||
:: Point2 -- ^ Line start point
|
||||
-> Point2 -- ^ Line end point
|
||||
-> World
|
||||
-> StreamOf (Point2, Either Creature Wall)
|
||||
thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
||||
(S.map (second Left) (S.each $ crsHit sp ep w))
|
||||
(S.map (second Right) (wlsHit sp ep w))
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
thingsHit sp ep w = List.mergeOn (dist sp . fst)
|
||||
(map (second Left) (crsHit sp ep w))
|
||||
(map (second Right) (wlsHit sp ep w))
|
||||
--{- List those objects that appear on a line. -}
|
||||
--thingsHit
|
||||
-- :: Point2 -- ^ Line start point
|
||||
-- -> Point2 -- ^ Line end point
|
||||
-- -> World
|
||||
-- -> StreamOf (Point2, Either Creature Wall)
|
||||
--thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
||||
-- (S.map (second Left) (S.each $ crsHit sp ep w))
|
||||
-- (S.map (second Right) (wlsHit sp ep w))
|
||||
|
||||
crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
|
||||
crsHit sp ep w
|
||||
@@ -48,13 +59,20 @@ crsHit sp ep w
|
||||
|
||||
thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
|
||||
-> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
||||
thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
|
||||
thingHitFilt fcr fwl sp ep = listToMaybe . filter (f . snd) . thingsHit sp ep
|
||||
where
|
||||
f (Left cr) = fcr cr
|
||||
f (Right wl) = fwl wl
|
||||
|
||||
--thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
|
||||
-- -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
||||
--thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
|
||||
-- where
|
||||
-- f (Left cr) = fcr cr
|
||||
-- f (Right wl) = fwl wl
|
||||
|
||||
thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
|
||||
thingHit sp ep = runIdentity . S.head_ . thingsHit sp ep
|
||||
thingHit sp ep = listToMaybe . thingsHit sp ep
|
||||
|
||||
{- List objects that appear on a line.
|
||||
Can filter out a creature. -}
|
||||
@@ -63,26 +81,51 @@ thingsHitExceptCr
|
||||
-> Point2 -- ^ Line start point
|
||||
-> Point2 -- ^ Line end point
|
||||
-> World
|
||||
-> StreamOf (Point2, Either Creature Wall)
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
|
||||
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
|
||||
where
|
||||
crNotCid (_,Left cr) = _crID cr /= cid
|
||||
crNotCid _ = True
|
||||
--{- List objects that appear on a line.
|
||||
--Can filter out a creature. -}
|
||||
--thingsHitExceptCr
|
||||
-- :: Maybe Int -- ^ A possible creature ID
|
||||
-- -> Point2 -- ^ Line start point
|
||||
-- -> Point2 -- ^ Line end point
|
||||
-- -> World
|
||||
-- -> StreamOf (Point2, Either Creature Wall)
|
||||
--thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||
--thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
|
||||
-- where
|
||||
-- crNotCid (_,Left cr) = _crID cr /= cid
|
||||
-- crNotCid _ = True
|
||||
|
||||
wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
|
||||
wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
|
||||
wlsHit sp ep
|
||||
| sp == ep = const mempty
|
||||
| otherwise = sortStreamOn (dist sp . fst)
|
||||
| otherwise = sortOn (dist sp . fst)
|
||||
. overlapSegWalls sp ep
|
||||
. wlsNearSeg sp ep
|
||||
--wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
|
||||
--wlsHit sp ep
|
||||
-- | sp == ep = const mempty
|
||||
-- | otherwise = sortStreamOn (dist sp . fst)
|
||||
-- . overlapSegWalls sp ep
|
||||
-- . wlsNearSeg sp ep
|
||||
|
||||
wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
|
||||
wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
|
||||
wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
|
||||
wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
|
||||
where
|
||||
f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
|
||||
where
|
||||
v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
|
||||
--wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
|
||||
--wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
|
||||
-- where
|
||||
-- f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
|
||||
-- where
|
||||
-- v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
|
||||
|
||||
crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
|
||||
crsHitRadial p r = mapMaybe f . crsNearCirc p r
|
||||
|
||||
Reference in New Issue
Block a user