This commit is contained in:
2021-05-04 18:11:59 +02:00
parent 6d4c17fc07
commit f0e5095b5f
28 changed files with 477 additions and 584 deletions
+4 -4
View File
@@ -1,4 +1,4 @@
{-
{- |
Creation of particles in the world.
-}
module Dodge.WorldEvent.SpawnParticle
@@ -26,6 +26,7 @@ import Control.Monad.State
import Data.Function (on)
import Data.List
import Data.Maybe
import Data.Tuple
aFlameParticle
:: Int -- ^ Timer
@@ -126,9 +127,8 @@ moveFlame rotd w pt
, _btVel' = reflV wl
}
pOut p = p +.+ safeNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn ((snd $ _wlLine wall) -.- (fst $ _wlLine wall)) vel )
+.+
(0.2 *.* vel)
reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
+.+ (0.2 *.* vel)
smokeGen = makeFlamerSmokeAt ep
makeFlameletTimed
+27 -27
View File
@@ -1,4 +1,4 @@
{-
{- |
Find which objects lie upon a line.
-}
module Dodge.WorldEvent.ThingsHit
@@ -11,9 +11,7 @@ import qualified Data.IntMap.Strict as IM
import Data.List
import Data.Maybe
import Data.Function (on)
{-
List those objects that appear on a line.
-}
{- List those objects that appear on a line. -}
thingsHit
:: Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
@@ -23,26 +21,24 @@ thingsHit sp ep w
| sp == ep = []
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
where
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
hitCrs = IM.elems
$ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
, b<-[y-1,y,y+1]])
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
f i m = case IM.lookup i m of
Just val -> val
_ -> IM.empty
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitPoint w = intersectSegSeg' sp ep (fst $ _wlLine w) (snd $ _wlLine w)
hitPoint w = uncurry (intersectSegSeg' sp ep) (_wlLine w)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
{-
List objects that appear on a line.
Can filter out a creature.
-}
{- List objects that appear on a line.
Can filter out a creature. -}
thingsHitExceptCr
:: Maybe Int -- ^ A possible creature ID
-> Point2 -- ^ Line start point
@@ -55,28 +51,32 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid _ = True
thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World
-> [(Point2, Either3 Creature Wall ForceField)]
thingsHitExceptCrLongLine
:: Maybe Int
-> Point2
-> Point2
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
where crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid _ = True
where
crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid _ = True
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
thingsHitLongLine sp ep w
| sp == ep = []
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
| otherwise = sortOn (dist sp . fst) (crs ++ walls ++ ffs)
where
crs = zip crPs (map E3x1 hitCrs)
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
hitCrs = IM.elems
. IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
hitPoint wl = intersectSegSeg' sp ep (fst $ _wlLine wl) (snd $ _wlLine wl)
hitPoint wl = uncurry (intersectSegSeg' sp ep) (_wlLine wl)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs