Make item display universal
This commit is contained in:
+4
-259
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user