justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2021-10-31 15:03:05 +00:00
parent c443cc4372
commit 74a4267393
14 changed files with 85 additions and 167 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/HitEffect.hs
+10 -15
View File
@@ -15,7 +15,6 @@ import Control.Lens
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
--passThroughAll
-- :: HitCreatureEffect
@@ -36,16 +35,14 @@ type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
destroyOnImpact
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
-> World
-> (World, Maybe Particle)
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
mvPt :: Particle -> Maybe Particle
mvPt pt = Just $ pt
@@ -63,18 +60,16 @@ destroyAt hitp pt = Just $ pt
penWalls
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
-> World
-> (World, Maybe Particle)
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
penWalls crEff wlEff pt hitThings w = case hitThings of
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,Right wl):hs) | isJust (wl ^? wlBlockID)
-> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
src/Dodge/WorldEvent/SpawnParticle.hs
+7 -7
View File
@@ -55,7 +55,7 @@ aFlameParticle t pos vel maycid = PtZ
, _btPassThrough' = maycid
, _btWidth' = 4
, _btTimer' = t
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = 20
}
drawFlame
@@ -98,8 +98,8 @@ moveFlame
moveFlame rotd w pt
| time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
| otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
((_,E3x1 _):_) -> (doSound damcrs , mvPt 0.7)
(thing@(p,E3x2 wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
((_,Left _):_) -> (doSound damcrs , mvPt 0.7)
(thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98)
where
time = _btTimer' pt
@@ -112,7 +112,7 @@ moveFlame rotd w pt
, _btPos' = ep
, _btPassThrough' = Nothing
, _btVel' = speed *.* vel }
damcrs = foldr (\cr -> fst . hiteff [(ep,E3x1 cr)]) w
damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w
$ IM.filter closeCrs $ _creatures w
closeCrs cr = dist ep (_crPos cr)
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
@@ -150,7 +150,7 @@ makeFlameletTimed (V2 x y) z vel maycid size time w = w
, _btPassThrough' = maycid
, _btWidth' = size
, _btTimer' = time
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff
, _ptZ = z
}
(rot ,g) = randomR (0,3) $ _randGen w
@@ -205,7 +205,7 @@ Applies movement and attaches damage to nearby creatures. -}
moveFlamelet :: World -> Particle -> (World, Maybe Particle)
moveFlamelet w pt
| _btTimer' pt <= 0 = ( w, Nothing)
| otherwise = (flameFlicker pt $ damcrs, mvPt)
| otherwise = (flameFlicker pt damcrs, mvPt)
where
sp = _btPos' pt
vel = _btVel' pt
@@ -389,7 +389,7 @@ createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . )
, _btPassThrough' = Nothing
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
, _btHitEffect' = destroyOnImpact sparkEff noEff
}
sparkEff bt p cr
= creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
src/Dodge/WorldEvent/ThingsHit.hs
+12 -17
View File
@@ -11,7 +11,6 @@ module Dodge.WorldEvent.ThingsHit
import Dodge.Data
import Dodge.Base
import Dodge.Zone
--import Dodge.Zone.Data
import Geometry
import qualified Data.IntMap.Strict as IM
@@ -22,27 +21,25 @@ thingsHit
:: Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
thingsHit sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
where
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)
crs = zip crPs (map Left hitCrs)
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _znObjects $ _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
wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
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. -}
thingsHitExceptCr
@@ -50,11 +47,11 @@ thingsHitExceptCr
-> Point2 -- ^ Line start point
-> Point2 -- ^ Line end point
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
where
crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid (_,Left cr) = _crID cr /= cid
crNotCid _ = True
thingsHitExceptCrLongLine
@@ -62,26 +59,24 @@ thingsHitExceptCrLongLine
-> Point2
-> Point2
-> World
-> [(Point2, Either3 Creature Wall ForceField)]
-> [(Point2, Either Creature Wall)]
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 (_,Left cr) = _crID cr /= cid
crNotCid _ = True
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
thingsHitLongLine sp ep w
| sp == ep = []
| otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
| otherwise = sortOn (dist sp . fst) (crs ++ wls)
where
crs = zip crPs (map E3x1 hitCrs)
crs = zip crPs (map Left hitCrs)
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
wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls)
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
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