Unify world shape and picture into spic

2021-11-01 02:00:12 +00:00
parent 86fdfd260e
commit da346bc3a0
9 changed files with 266 additions and 158 deletions
@@ -1,7 +1,15 @@
 {-# LANGUAGE TupleSections #-}
 {- | Basic collision detection for a moving point -}
 module Dodge.Base.Collide
-    where
+    ( hasLOS
+    , reflectPointWalls
+    , ssfold
+    , collidePointUpToIndirectMinDist
+    , canSeeIndirect
+    , isWalkable
+    , canSee
+    , hasLOSIndirect
+    ) where
 import Dodge.Data
 import Dodge.Zone
 import Geometry
@@ -17,15 +25,15 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w

-hitPointLines
-    :: Point2
-    -> Point2
-    -> [(Point2,Point2)]
-    -> Maybe (Point2,(Point2,Point2))
-hitPointLines p1 p2
-    = safeMinimumOn (dist p1 . fst)
-    . mapMaybe
-    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
+--hitPointLines
+--    :: Point2
+--    -> Point2
+--    -> [(Point2,Point2)]
+--    -> Maybe (Point2,(Point2,Point2))
+--hitPointLines p1 p2
+--    = safeMinimumOn (dist p1 . fst)
+--    . mapMaybe
+--    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)

 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
@@ -40,22 +48,22 @@ reflectPointWalls p1 p2 ws
                 (intersectSegSeg p1 p2 x y)
         ) 
        . _wlLine) ws
-- | Looks for first collision of a point with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
-reflectPointWallsDamped 
-    :: Float    -- ^ Damping factor, probably should be in (0,1)
-    -> Point2 
-    -> Point2 
-    -> IM.IntMap Wall 
-    -> Maybe (Point2,Point2)
-reflectPointWallsDamped dfact p1 p2 ws 
-    = safeMinimumOn (dist p1 . fst)
-    $ IM.mapMaybe 
-        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
-                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
-                                (intersectSegSeg p1 p2 x y)) 
-         . _wlLine
-        ) ws
+---- | Looks for first collision of a point with walls.
+---- If found, gives point and reflection velocity, reflection damped in normal.
+--reflectPointWallsDamped 
+--    :: Float    -- ^ Damping factor, probably should be in (0,1)
+--    -> Point2 
+--    -> Point2 
+--    -> IM.IntMap Wall 
+--    -> Maybe (Point2,Point2)
+--reflectPointWallsDamped dfact p1 p2 ws 
+--    = safeMinimumOn (dist p1 . fst)
+--    $ IM.mapMaybe 
+--        (( \(x,y) -> fmap ((, reflectInParam dfact (x -.- y) (p2 -.- p1)) 
+--                            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))) 
+--                                (intersectSegSeg p1 p2 x y)) 
+--         . _wlLine
+--        ) ws
 -- | Test if a point collides with walls
 pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 pointHitsWalls p1 p2 
@@ -66,42 +74,42 @@ collidePointWalkable p1 p2 ws
    = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
    $ IM.filter (fromMaybe True . (^? wlPathable)) ws

-furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
-furthestPointWalkable p1 p2 ws 
-    = fromMaybe p2
-    . safeMinimumOn (dist p1) 
-    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
+--furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
+--furthestPointWalkable p1 p2 ws 
+--    = fromMaybe p2
+--    . safeMinimumOn (dist p1) 
+--    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws

-collideDirectionIndirect 
-    :: Float    -- ^max distance to look
-    -> Point2   -- ^start point
-    -> Point2   -- ^point in direction
-    -> IM.IntMap Wall 
-    -> Float
-{-# INLINE collideDirectionIndirect #-}
-collideDirectionIndirect d p1 p2 wls
-    = fromMaybe d
-    $
-    ( L.fold
-    . L.prefilter wlIsOpaque
-    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
-    ) L.minimum 
-    wls
-  where
-    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
+--collideDirectionIndirect 
+--    :: Float    -- ^max distance to look
+--    -> Point2   -- ^start point
+--    -> Point2   -- ^point in direction
+--    -> IM.IntMap Wall 
+--    -> Float
+--{-# INLINE collideDirectionIndirect #-}
+--collideDirectionIndirect d p1 p2 wls
+--    = fromMaybe d
+--    $
+--    ( L.fold
+--    . L.prefilter wlIsOpaque
+--    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
+--    ) L.minimum 
+--    wls
+--  where
+--    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)

 wlIsOpaque :: Wall -> Bool
 wlIsOpaque wl = _wlOpacity wl == Opaque

-collidePointUpToIndirect
-    :: Point2   -- ^start point
-    -> Point2   -- ^end point
-    -> IM.IntMap Wall 
-    -> Point2
-{-# INLINE collidePointUpToIndirect #-}
-collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
-  where
-    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+--collidePointUpToIndirect
+--    :: Point2   -- ^start point
+--    -> Point2   -- ^end point
+--    -> IM.IntMap Wall 
+--    -> Point2
+--{-# INLINE collidePointUpToIndirect #-}
+--collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter wlIsOpaque
+--  where
+--    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl

 collidePointUpToIndirectMinDist
    :: Point2   -- ^start point
@@ -138,21 +146,21 @@ collidePointIndirect'  p1 p2
    . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
    $ L.minimumOn (dist p1)

-{- | Checks to see whether someone can fire bullets effectively between two points. 
- - Not sure if this needs vision as well, need to make this uniform. -}
-collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
-collidePointFire p1 p2 ws 
-    = safeMinimumOn (dist p1) 
-    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
-    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
-{- | Checks to see whether someone can fire bullets effectively between two points. 
- - Not sure if this needs vision as well, need to make this uniform. -}
-collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
-collidePointFireVision p1 p2 ws 
-    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    $ IM.filter theTest ws
-  where 
-    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl
+--{- | Checks to see whether someone can fire bullets effectively between two points. 
+-- - Not sure if this needs vision as well, need to make this uniform. -}
+--collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
+--collidePointFire p1 p2 ws 
+--    = safeMinimumOn (dist p1) 
+--    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
+--    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
+--{- | Checks to see whether someone can fire bullets effectively between two points. 
+-- - Not sure if this needs vision as well, need to make this uniform. -}
+--collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
+--collidePointFireVision p1 p2 ws 
+--    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
+--    $ IM.filter theTest ws
+--  where 
+--    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl

 -- the reason for using the dashed version is the hope that this will short
 -- circuit
@@ -172,47 +180,47 @@ canSee i j w = hasLOS p1 p2 w
    p1 = _crPos (_creatures w IM.! i)
    p2 = _crPos (_creatures w IM.! j)

-canSeePoint :: Int -> Point2 -> World -> Bool
-canSeePoint i p w = hasLOS p1 p w
-  where
-    p1 = _crPos (_creatures w IM.! i)
+--canSeePoint :: Int -> Point2 -> World -> Bool
+--canSeePoint i p w = hasLOS p1 p w
+--  where
+--    p1 = _crPos (_creatures w IM.! i)

-pathToPointFireable :: Int -> Point2 -> World -> Bool
-pathToPointFireable i p w 
-    = not 
-    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
-    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
-  where 
-    p1 = _crPos (_creatures w IM.! i)
+--pathToPointFireable :: Int -> Point2 -> World -> Bool
+--pathToPointFireable i p w 
+--    = not 
+--    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
+--    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
+--  where 
+--    p1 = _crPos (_creatures w IM.! i)

-canSeePointAll :: Int -> Point2 -> World -> Bool
-canSeePointAll i targPos w 
-    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
-    cr = _creatures w IM.! i
-    radius = _crRad cr
+--canSeePointAll :: Int -> Point2 -> World -> Bool
+--canSeePointAll i targPos w 
+--    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--  where 
+--    cr = _creatures w IM.! i
+--    radius = _crRad cr

-canSeeAny :: Int -> Int -> World -> Bool
-canSeeAny fromID toID w 
-    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
-    cr = _creatures w IM.! toID
-    cpos = _crPos cr
-    radius = _crRad cr
+--canSeeAny :: Int -> Int -> World -> Bool
+--canSeeAny fromID toID w 
+--    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--  where 
+--    cr = _creatures w IM.! toID
+--    cpos = _crPos cr
+--    radius = _crRad cr

-canSeeAll :: Int -> Int -> World -> Bool
-canSeeAll fromID toID w 
-    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
-  where 
-    cr = _creatures w IM.! toID
-    cpos = _crPos cr
-    radius = _crRad cr
+--canSeeAll :: Int -> Int -> World -> Bool
+--canSeeAll fromID toID w 
+--    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
+--  where 
+--    cr = _creatures w IM.! toID
+--    cpos = _crPos cr
+--    radius = _crRad cr

-canWalk :: Int -> Int -> World -> Bool
-canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
-  where 
-    ipos = _crPos (_creatures w IM.! i)
-    jpos = _crPos (_creatures w IM.! j)
+--canWalk :: Int -> Int -> World -> Bool
+--canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
+--  where 
+--    ipos = _crPos (_creatures w IM.! i)
+--    jpos = _crPos (_creatures w IM.! j)

 canSeeIndirect :: Int -> Int -> World -> Bool
 canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
@@ -220,43 +228,43 @@ canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLi
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)
    
-canSeeFire :: Point2 -> Point2 -> World -> Bool
-canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w
+--canSeeFire :: Point2 -> Point2 -> World -> Bool
+--canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w

-canSeeFireVision :: Int -> Int -> World -> Bool
-canSeeFireVision i j w = canSeeFire ipos jpos w
-  where 
-    ipos = _crPos (_creatures w IM.! i)
-    jpos = _crPos (_creatures w IM.! j)
-{- | Test whether both of the outside lines between two creatures are blocked -}
-canSeeFireVisionAny :: Int -> Int -> World -> Bool
-canSeeFireVisionAny i j w 
-    = not 
-    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
-        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
-    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
-        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
-  where
-    icr = _creatures w IM.! i
-    jcr = _creatures w IM.! j
-    ipos = _crPos icr
-    jpos = _crPos jcr
-    n = normalizeV $ vNormal $ ipos -.- jpos
-    ni = _crRad icr *.* n
-    nj = _crRad jcr *.* n
-{- | Test whether either of the outside lines between two creatures are blocked -}
-canSeeFireVisionAll :: Int -> Int -> World -> Bool
-canSeeFireVisionAll i j w 
-    = not 
-    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
-        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
-    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
-        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
-  where
-    icr = _creatures w IM.! i
-    jcr = _creatures w IM.! j
-    ipos = _crPos icr
-    jpos = _crPos jcr
-    n = normalizeV $ vNormal $ ipos -.- jpos
-    ni = _crRad icr *.* n
-    nj = _crRad jcr *.* n
+--canSeeFireVision :: Int -> Int -> World -> Bool
+--canSeeFireVision i j w = canSeeFire ipos jpos w
+--  where 
+--    ipos = _crPos (_creatures w IM.! i)
+--    jpos = _crPos (_creatures w IM.! j)
+--{- | Test whether both of the outside lines between two creatures are blocked -}
+--canSeeFireVisionAny :: Int -> Int -> World -> Bool
+--canSeeFireVisionAny i j w 
+--    = not 
+--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
+--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
+--    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
+--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
+--  where
+--    icr = _creatures w IM.! i
+--    jcr = _creatures w IM.! j
+--    ipos = _crPos icr
+--    jpos = _crPos jcr
+--    n = normalizeV $ vNormal $ ipos -.- jpos
+--    ni = _crRad icr *.* n
+--    nj = _crRad jcr *.* n
+--{- | Test whether either of the outside lines between two creatures are blocked -}
+--canSeeFireVisionAll :: Int -> Int -> World -> Bool
+--canSeeFireVisionAll i j w 
+--    = not 
+--    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
+--        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
+--    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
+--        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
+--  where
+--    icr = _creatures w IM.! i
+--    jcr = _creatures w IM.! j
+--    ipos = _crPos icr
+--    jpos = _crPos jcr
+--    n = normalizeV $ vNormal $ ipos -.- jpos
+--    ni = _crRad icr *.* n
+--    nj = _crRad jcr *.* n