Refactor sound
This commit is contained in:
+123
-65
@@ -583,8 +583,9 @@ collidePointWallsNorm p1 p2 ws = listToMaybe $ sortBy f $ IM.elems $ IM.mapMaybe
|
||||
) ws
|
||||
where f (a,_) (b,_) = compare (magV (p1 -.- a)) (magV (p1 -.- b))
|
||||
|
||||
-- looks for first collision of a point with walls
|
||||
-- if found, gives point and colour of wall
|
||||
{- | Looks for first collision of a point with walls.
|
||||
If found, gives point and colour of wall.
|
||||
-}
|
||||
collidePointWallsCol :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Color)
|
||||
collidePointWallsCol p1 p2 ws = listToMaybe $ sortBy f $ IM.elems $ IM.mapMaybe
|
||||
( (\(m, c) -> fmap (flip (,) c) m)
|
||||
@@ -592,8 +593,9 @@ collidePointWallsCol p1 p2 ws = listToMaybe $ sortBy f $ IM.elems $ IM.mapMaybe
|
||||
(_wlLine w !! 0) (_wlLine w !! 1), _wlColor w))
|
||||
) ws
|
||||
where f (a,_) (b,_) = compare (magV (p1 -.- a)) (magV (p1 -.- b))
|
||||
-- looks for first collision of a point with walls
|
||||
-- if found, gives point, and normal and colour of wall
|
||||
{- | Looks for first collision of a point with walls.
|
||||
If found, gives point, and normal and colour of wall.
|
||||
-}
|
||||
collidePointWallsNormCol :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2,Color)
|
||||
collidePointWallsNormCol p1 p2 ws
|
||||
= listToMaybe $ sortBy f $ IM.elems $ IM.mapMaybe m ws
|
||||
@@ -603,7 +605,7 @@ collidePointWallsNormCol p1 p2 ws
|
||||
m w = let (a1,a2,a3) = ls w
|
||||
in fmap (\a4 -> (a4,a2,a3)) a1
|
||||
|
||||
--returns the first creature, if any, that a point intersects with
|
||||
-- | Returns the first creature, if any, that a point intersects with.
|
||||
collidePointCreatures :: Point2 -> Point2 -> World -> Maybe Int
|
||||
collidePointCreatures p1 p2 w = fmap fst $ listToMaybe $ sortBy (csnd) $ IM.toList $
|
||||
IM.mapMaybe (\x ->
|
||||
@@ -611,8 +613,8 @@ collidePointCreatures p1 p2 w = fmap fst $ listToMaybe $ sortBy (csnd) $ IM.toLi
|
||||
)
|
||||
(_creatures w)
|
||||
where csnd (_,a) (_,b) = compare a b
|
||||
--as for collidePointCreatures, only increases the radius of creatures by a
|
||||
--fixed amount, thus collides a moving circle with creaures
|
||||
-- | As for 'collidePointCreatures', only increases the radius of creatures by a
|
||||
--fixed amount, thus collides a moving circle with creaures.
|
||||
collideCircCreatures :: Point2 -> Point2 -> Float -> World -> Maybe Int
|
||||
collideCircCreatures p1 p2 rad w = fmap fst $ listToMaybe $ sortBy (csnd) $ IM.toList $
|
||||
IM.mapMaybe (\x ->
|
||||
@@ -622,35 +624,46 @@ collideCircCreatures p1 p2 rad w = fmap fst $ listToMaybe $ sortBy (csnd) $ IM.t
|
||||
where csnd (_,a) (_,b) = compare a b
|
||||
|
||||
|
||||
--returns the first creature, if any, that a point intersects with, gives point
|
||||
--in creature on line
|
||||
-- | Returns the first creature, if any, that a point intersects with, gives point
|
||||
--in creature on line.
|
||||
collidePointCrsPoint :: Point2 -> Point2 -> World -> Maybe (Point2,Int)
|
||||
collidePointCrsPoint p1 p2 w = fmap f $ listToMaybe $ sortBy (csndsnd) $ IM.toList $
|
||||
IM.mapMaybe (\x ->
|
||||
collidePointCirc'' p1 p2 (_crRad x) (_crPos x)
|
||||
)
|
||||
(_creatures w)
|
||||
where csndsnd (_,(_,a)) (_,(_,b)) = compare a b
|
||||
f (cID,(p,_)) = (p,cID)
|
||||
where
|
||||
csndsnd (_,(_,a)) (_,(_,b)) = compare a b
|
||||
f (cID,(p,_)) = (p,cID)
|
||||
collideCircCrsPoint :: Point2 -> Point2 -> Float -> World -> Maybe (Point2,Int)
|
||||
collideCircCrsPoint p1 p2 rad w = fmap f $ listToMaybe $ sortBy (csndsnd) $ IM.toList $
|
||||
IM.mapMaybe (\x ->
|
||||
collidePointCirc'' p1 p2 (rad + _crRad x) (_crPos x)
|
||||
)
|
||||
(_creatures w)
|
||||
where csndsnd (_,(_,a)) (_,(_,b)) = compare a b
|
||||
f (cID,(p,_)) = (p,cID)
|
||||
collideCircCrsPoint p1 p2 rad w
|
||||
= fmap f
|
||||
. listToMaybe
|
||||
. sortBy (csndsnd)
|
||||
. IM.toList
|
||||
$ IM.mapMaybe (\x ->
|
||||
collidePointCirc'' p1 p2 (rad + _crRad x) (_crPos x)
|
||||
)
|
||||
(_creatures w)
|
||||
where
|
||||
csndsnd (_,(_,a)) (_,(_,b)) = compare a b
|
||||
f (cID,(p,_)) = (p,cID)
|
||||
|
||||
|
||||
-- makes a creatures not hittable
|
||||
-- | Makes a creature not hittable.
|
||||
collidePointCrsWithoutPoint :: Int -> Point2 -> Point2 -> World -> Maybe (Point2,Int)
|
||||
collidePointCrsWithoutPoint cid p1 p2 w = fmap f $ listToMaybe $ sortBy (csndsnd) $ IM.toList $
|
||||
IM.mapMaybe (\x ->
|
||||
collidePointCirc'' p1 p2 (_crRad x) (_crPos x)
|
||||
)
|
||||
(IM.delete cid $ _creatures w)
|
||||
where csndsnd (_,(_,a)) (_,(_,b)) = compare a b
|
||||
f (cID,(p,_)) = (p,cID)
|
||||
collidePointCrsWithoutPoint cid p1 p2 w
|
||||
= fmap f
|
||||
. listToMaybe
|
||||
. sortBy (csndsnd)
|
||||
. IM.toList
|
||||
$ IM.mapMaybe (\x ->
|
||||
collidePointCirc'' p1 p2 (_crRad x) (_crPos x)
|
||||
)
|
||||
(IM.delete cid $ _creatures w)
|
||||
where
|
||||
csndsnd (_,(_,a)) (_,(_,b)) = compare a b
|
||||
f (cID,(p,_)) = (p,cID)
|
||||
|
||||
circOnSomeWall :: Point2 -> Float -> World -> Bool
|
||||
circOnSomeWall p rad w = any (\(x:y:_) -> circOnSeg x y p rad)
|
||||
@@ -664,55 +677,85 @@ crsNearPoint :: Float -> Point2 -> World -> Bool
|
||||
crsNearPoint d p w = any (\c -> dist (_crPos c) p < (d + _crRad c)) (_creatures w)
|
||||
|
||||
crsOnLine :: Point2 -> Point2 -> World -> [Creature]
|
||||
crsOnLine p1 p2 w = IM.elems
|
||||
$ IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
crsOnLine p1 p2 w
|
||||
= IM.elems
|
||||
. IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr))
|
||||
$ _creatures w
|
||||
|
||||
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 thickness p1 p2 w
|
||||
= IM.elems
|
||||
. IM.filter (\cr -> circOnSeg p1 p2 (_crPos cr) (_crRad cr + thickness))
|
||||
$ _creatures w
|
||||
|
||||
{- | Find 'Maybe' the closest creature to a point, within a circle.
|
||||
-}
|
||||
nearestCrInRad :: Point2 -> Float -> World -> Maybe Creature
|
||||
nearestCrInRad p r w = let crs = IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
|
||||
sortedCrs = sortBy (compare `on` (dist p . _crPos)) $ IM.elems crs
|
||||
in listToMaybe sortedCrs
|
||||
nearestCrInRad p r w
|
||||
= let crs = IM.filter (\cr -> dist p (_crPos cr) < r) $ _creatures w
|
||||
sortedCrs = sortBy (compare `on` (dist p . _crPos)) $ IM.elems crs
|
||||
in listToMaybe sortedCrs
|
||||
|
||||
nearestCrInTri :: Point2 -> Float -> Float -> World -> Maybe Creature
|
||||
{- | 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
|
||||
= let crs = IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
|
||||
sortedCrs = sortBy (compare `on` (dist p . _crPos)) $ IM.elems crs
|
||||
in listToMaybe sortedCrs
|
||||
where tri = [p
|
||||
,p +.+ rotateV (dir-pi/4) (x,0)
|
||||
,p +.+ rotateV (dir+pi/4) (x,0)
|
||||
]
|
||||
|
||||
nearestCrInFront :: Point2 -> Float -> Float -> World -> Maybe Creature
|
||||
where
|
||||
tri = [p
|
||||
,p +.+ rotateV (dir-pi/4) (x,0)
|
||||
,p +.+ rotateV (dir+pi/4) (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 w
|
||||
= let crs = IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
|
||||
sortedCrs = sortBy (compare `on` (dist p . _crPos)) $ IM.elems crs
|
||||
in listToMaybe sortedCrs
|
||||
where rec = [p
|
||||
,pR
|
||||
,pR1
|
||||
,pL1
|
||||
,pL
|
||||
]
|
||||
pR = p +.+ rotateV (dir - pi*(3/8)) (x/2,0)
|
||||
pL = p +.+ rotateV (dir + pi*(3/8)) (x/2,0)
|
||||
pR1 = pR +.+ rotateV dir (x/2,0)
|
||||
pL1 = pL +.+ rotateV dir (x/2,0)
|
||||
where
|
||||
rec = [p
|
||||
,pR
|
||||
,pR1
|
||||
,pL1
|
||||
,pL
|
||||
]
|
||||
pR = p +.+ rotateV (dir - pi*(3/8)) (x/2,0)
|
||||
pL = p +.+ rotateV (dir + pi*(3/8)) (x/2,0)
|
||||
pR1 = pR +.+ rotateV dir (x/2,0)
|
||||
pL1 = pL +.+ rotateV dir (x/2,0)
|
||||
|
||||
{- | Test whether a creature is in a polygon.
|
||||
-}
|
||||
crInPolygon :: Creature -> [Point2] -> Bool
|
||||
crInPolygon cr xs = errorPointInPolygon 3 (_crPos cr) xs
|
||||
|
||||
{- | Uses a layer to set the depth.
|
||||
-}
|
||||
onLayer :: Layer -> Picture -> Picture
|
||||
onLayer l = setDepth $ 1 - fromIntegral (levLayer l) / 100
|
||||
|
||||
{- | Set a depth according to a list of numbers.
|
||||
Lists are lexicographically ordered if input values are always less than 100.
|
||||
Higher numbers will get placed on top of lower numbers.
|
||||
-}
|
||||
onLayerL :: [Int] -> Picture -> Picture
|
||||
onLayerL is = setDepth (1 - (sum $ zipWith (/) (map fromIntegral is) $ map (\x->100**x) [1..]))
|
||||
onLayerL is = setDepth (1 - (sum $ zipWith (/) (map fromIntegral is) $ map (100 **) [1..]))
|
||||
|
||||
{- | For depth testing, set layer values.
|
||||
-}
|
||||
levLayer :: Layer -> Int
|
||||
levLayer BgLayer = 20
|
||||
levLayer PressPlateLayer = 45
|
||||
@@ -729,6 +772,8 @@ levLayer LabelLayer = 80
|
||||
levLayer InvLayer = 85
|
||||
levLayer MenuLayer = 90
|
||||
|
||||
{- | Transform coordinates from world position to normalised screen coordinates.
|
||||
-}
|
||||
worldPosToScreen :: World -> Point2 -> Point2
|
||||
worldPosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
|
||||
where
|
||||
@@ -739,6 +784,9 @@ worldPosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
|
||||
, y * 2 / _windowY w
|
||||
)
|
||||
|
||||
{- | Transform coordinates from the map position to normalised screen
|
||||
coordinates.
|
||||
-}
|
||||
cartePosToScreen :: World -> Point2 -> Point2
|
||||
cartePosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
|
||||
where
|
||||
@@ -749,32 +797,42 @@ cartePosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
|
||||
, y * 2 / _windowY w
|
||||
)
|
||||
|
||||
{- | The mouse position in world coordinates.
|
||||
-}
|
||||
mouseWorldPos :: World -> Point2
|
||||
mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
|
||||
|
||||
{- | The mouse position in map coordinates
|
||||
-}
|
||||
mouseCartePos :: World -> Point2
|
||||
mouseCartePos w = _carteCenter w +.+ (1/_carteZoom w) *.* rotateV (_carteRot w) (_mousePos w)
|
||||
|
||||
{- | Create a logistic function given three parameters.
|
||||
-}
|
||||
logistic :: Float -> Float -> Float -> (Float -> Float)
|
||||
logistic x0 l k x = l / (1 + exp (k*(x0 - x)))
|
||||
|
||||
wallLOS :: [Point2] -> Point2 -> Point2 -> Bool
|
||||
{-# INLINE wallLOS #-}
|
||||
wallLOS !(x:y:_) !c !p = isRHS c x y || isLHS p x' y' || isLHS c p x || isRHS c p y
|
||||
where n = 10 *.* (safeNormalizeV . vNormal $ y -.- x)
|
||||
x' = x +.+ n
|
||||
y' = y +.+ n
|
||||
|
||||
wallsLOS :: Foldable t => t [Point2] -> Point2 -> Point2 -> Bool
|
||||
{-# INLINE wallsLOS #-}
|
||||
wallsLOS !ls !c !p = all (\l -> wallLOS l c p) ls
|
||||
|
||||
mvPointTowardAtSpeed :: Float -> Point2 -> Point2 -> Point2
|
||||
{- | given a target and a start point, shift toward the end point by a given
|
||||
amount.
|
||||
If close enough, end up on the end point
|
||||
-}
|
||||
mvPointTowardAtSpeed
|
||||
:: Float -- ^ Speed.
|
||||
-> Point2 -- ^ End point.
|
||||
-> Point2 -- ^ Start point.
|
||||
-> Point2
|
||||
mvPointTowardAtSpeed speed !ep !p
|
||||
| dist p ep < speed = ep
|
||||
| otherwise = p +.+ speed *.* normalizeV (ep -.- p)
|
||||
|
||||
mvPointToward :: Point2 -> Point2 -> Point2
|
||||
{- | given a target and a start point, shift toward the end point by 1.
|
||||
If close enough, end up on the end point
|
||||
-}
|
||||
mvPointToward
|
||||
:: Point2 -- ^ End point.
|
||||
-> Point2 -- ^ Start point.
|
||||
-> Point2
|
||||
mvPointToward !ep !p | dist p ep < 1 = ep
|
||||
| otherwise = p +.+ normalizeV (ep -.- p)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user