Cleanup
This commit is contained in:
+55
-64
@@ -6,8 +6,7 @@ Consider splitting. -}
|
||||
module Dodge.Base
|
||||
( module Dodge.Base
|
||||
, module Dodge.Base.You
|
||||
)
|
||||
where
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.WinScale
|
||||
import Dodge.Zone
|
||||
@@ -34,9 +33,8 @@ import Data.Maybe
|
||||
takeUntil :: Foldable t => (a -> Bool) -> t a -> [a]
|
||||
takeUntil p = foldr (\x xs -> x : if p x then [] else xs) []
|
||||
|
||||
|
||||
decreaseToZero :: Int -> Int
|
||||
decreaseToZero x = max 0 (x - 1)
|
||||
decreaseToZero = max 0 . subtract 1
|
||||
|
||||
decreaseToNothing' :: (Num a, Ord a) => Maybe' a -> Maybe' a
|
||||
decreaseToNothing' ma = case ma of
|
||||
@@ -54,7 +52,6 @@ errorHead s [] = error s
|
||||
aCrPos :: Int -> World -> Point2
|
||||
aCrPos i w = _crPos $ _creatures w IM.! i
|
||||
|
||||
|
||||
selectedObject :: World -> Maybe (Either FloorItem Button)
|
||||
selectedObject w = lookup (_crInvSel ycr) $ zip [n..] $ _closeObjects w
|
||||
where
|
||||
@@ -75,15 +72,16 @@ yourItemRef
|
||||
yourItemRef w = creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
|
||||
|
||||
wallNormal :: Wall -> Point2
|
||||
wallNormal wl = normalizeV . vNormal $ a -.- b
|
||||
where
|
||||
(a,b) = _wlLine wl
|
||||
wallNormal = normalizeV . vNormal . uncurry (-.-) . _wlLine
|
||||
|
||||
wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
|
||||
wallsOnLine p1 p2 ws = hitWalls
|
||||
where
|
||||
hitPoint = uncurry (intersectSegSeg p1 p2) . _wlLine
|
||||
hitWalls = filter (isJust . hitPoint) (IM.elems ws)
|
||||
wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap Wall
|
||||
wallsOnLine p1 p2 = IM.filter
|
||||
(isJust . uncurry (intersectSegSeg p1 p2) . _wlLine)
|
||||
|
||||
wallsOnLineHit :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall)
|
||||
wallsOnLineHit p1 p2 = IM.mapMaybe f
|
||||
where
|
||||
f wl = uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> (, wl)
|
||||
|
||||
wallsOnLine3D :: Point3 -> Point3 -> IM.IntMap Wall -> [Wall]
|
||||
wallsOnLine3D = undefined
|
||||
@@ -97,10 +95,11 @@ wallsOnCirc p r = IM.filter f
|
||||
f wl = uncurry circOnSeg (_wlLine wl) p r
|
||||
|
||||
allWalls :: World -> IM.IntMap Wall
|
||||
allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _znObjects $ _wallsZone w
|
||||
allWalls = IM.unions . concatMap IM.elems . IM.elems . _znObjects . _wallsZone
|
||||
|
||||
creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
|
||||
creaturesNearPoint p w = IM.unions [f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
|
||||
creaturesNearPoint p w = IM.unions
|
||||
[f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
|
||||
where
|
||||
(x,y) = crZoneOfPoint p
|
||||
f i m = case IM.lookup i m of
|
||||
@@ -108,7 +107,8 @@ creaturesNearPoint p w = IM.unions [f b $ f a $ _znObjects $ _creaturesZone w |
|
||||
_ -> IM.empty
|
||||
|
||||
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]]
|
||||
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 = case IM.lookup i m of
|
||||
@@ -120,11 +120,14 @@ 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 kps
|
||||
where g x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _creaturesZone w) s))
|
||||
kps = zoneOfLineIntMap a b
|
||||
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]
|
||||
lineGeom t x y
|
||||
@@ -191,13 +194,6 @@ newProjectileKey = IM.newKey . _props
|
||||
{- | Finds unused creature key. -}
|
||||
newCrKey :: World -> Int
|
||||
newCrKey = IM.newKey . _creatures
|
||||
-- | collides a point with forcefields
|
||||
-- if found, returns point of collision, deflection if required, and the id
|
||||
collidePointFFs :: a
|
||||
collidePointFFs = undefined
|
||||
collidePointFF :: a
|
||||
collidePointFF = undefined
|
||||
--
|
||||
-- | Looks for overlap of a circle with walls.
|
||||
-- If found, gives wall
|
||||
overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall
|
||||
@@ -249,9 +245,9 @@ collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Lef
|
||||
-- | 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 ws
|
||||
collideCircWalls p1 p2 rad
|
||||
= safeMinimumOn (dist p1 . fst)
|
||||
$ IM.mapMaybe
|
||||
. IM.mapMaybe
|
||||
(( \(x:y:_) -> fmap
|
||||
((, reflectInParam 0.5 (x -.- y) (p2 -.- p1))
|
||||
. (+.+ normalizeV (vNormal (x -.- y)))
|
||||
@@ -259,7 +255,7 @@ collideCircWalls p1 p2 rad ws
|
||||
(intersectSegSeg p1 p2 x y)
|
||||
)
|
||||
. shiftByRad . _wlLine
|
||||
) ws
|
||||
)
|
||||
where
|
||||
shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
|
||||
[a +.+ rad *.* normalizeV (a -.-b)
|
||||
@@ -284,22 +280,17 @@ collideCircWalls p1 p2 rad ws
|
||||
-- | Looks for first collision of a point with walls.
|
||||
-- If found, gives point and wall.
|
||||
collidePointWallsWall :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Wall)
|
||||
collidePointWallsWall p1 p2 ws
|
||||
= safeMinimumOn f
|
||||
$ IM.mapMaybe ( \wl -> uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> ( , wl ) )
|
||||
ws
|
||||
where
|
||||
f (a,_) = magV (p1 -.- a)
|
||||
collidePointWallsWall p1 p2
|
||||
= safeMinimumOn (dist p1 . fst)
|
||||
. IM.mapMaybe ( \wl -> uncurry (intersectSegSeg p1 p2) (_wlLine wl) <&> ( , wl ) )
|
||||
|
||||
-- | 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 f
|
||||
= safeMinimumOn (dist p1 . fst)
|
||||
$ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) )
|
||||
. _wlLine) ws
|
||||
where
|
||||
f (a,_) = magV (p1 -.- a)
|
||||
-- | Returns the first creature, if any, that a point intersects with.
|
||||
collidePointCreatures :: Point2 -> Point2 -> IM.IntMap Creature -> Maybe Int
|
||||
collidePointCreatures p1 p2 = fmap fst
|
||||
@@ -339,53 +330,53 @@ collideCircCrsPoint p1 p2 rad = collidePointCrsPoint p1 p2 . fmap (crRad +~ rad)
|
||||
{- | 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 w
|
||||
circOnSomeWall p rad
|
||||
= any (\(x,y) -> circOnSeg x y p rad)
|
||||
. fmap _wlLine
|
||||
. IM.elems
|
||||
$ wallsNearPoint p w
|
||||
. 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:_) w
|
||||
isHeavyCrNearLine d (p1:p2:_)
|
||||
= any (\c -> circOnSeg p1 p2 (_crPos c) (d + _crRad c))
|
||||
. IM.filter (\cr -> _crMass cr > 4)
|
||||
$ _creatures w
|
||||
isHeavyCrNearLine _ _ _ = error "Testing whether creature is near empty line"
|
||||
. _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 w = any (\c -> dist (_crPos c) p < (d + _crRad c)) (_creatures w)
|
||||
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 -> [Creature]
|
||||
crsOnLine p1 p2 w
|
||||
= IM.elems
|
||||
. IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
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 -> [Creature]
|
||||
crsOnThickLine thickness p1 p2 w
|
||||
= IM.elems
|
||||
. IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr + thickness))
|
||||
$ _creatures w
|
||||
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 w
|
||||
nearestCrInRad p r
|
||||
= safeMinimumOn (dist p . _crPos)
|
||||
$ IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
|
||||
. 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 w
|
||||
nearestCrInTri p dir x
|
||||
= safeMinimumOn (dist p . _crPos)
|
||||
$ IM.filter (\cr -> pointInPolygon (_crPos cr) tri) $ _creatures w
|
||||
. IM.filter (\cr -> pointInPolygon (_crPos cr) tri)
|
||||
. _creatures
|
||||
where
|
||||
tri =
|
||||
[p
|
||||
@@ -400,9 +391,10 @@ nearestCrInFront
|
||||
-> Float -- ^ Direction (radians +ve anticlockwise from x-axis).
|
||||
-> Float -- ^ Distance.
|
||||
-> World -> Maybe Creature
|
||||
nearestCrInFront p dir x w
|
||||
nearestCrInFront p dir x
|
||||
= safeMinimumOn (dist p . _crPos)
|
||||
$ IM.filter (\cr -> pointInPolygon (_crPos cr) rec) $ _creatures w
|
||||
. 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)
|
||||
@@ -411,7 +403,7 @@ nearestCrInFront p dir x w
|
||||
pL1 = pL +.+ rotateV dir (V2 (x/2) 0)
|
||||
{- | Test whether a creature is in a polygon. -}
|
||||
crInPolygon :: Creature -> [Point2] -> Bool
|
||||
crInPolygon cr = pointInPolygon (_crPos cr)
|
||||
crInPolygon = pointInPolygon . _crPos
|
||||
|
||||
{- | Transform coordinates from world position to screen coordinates. -}
|
||||
worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
|
||||
@@ -494,4 +486,3 @@ dbArg f x = f x x
|
||||
-- TODO check whether this is simply the reader monad, flipped
|
||||
dbArgChain :: (a -> b -> b) -> (a -> b -> b) -> a -> b -> b
|
||||
dbArgChain f g x = f x . g x
|
||||
|
||||
|
||||
Reference in New Issue
Block a user