Refactor bezgun
This commit is contained in:
@@ -16,14 +16,6 @@ import Data.Function (on)
|
||||
import Data.Bifunctor
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
|
||||
-> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
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 _ = True
|
||||
|
||||
mvGenBullet' :: World -> Particle' -> (World, Maybe Particle')
|
||||
mvGenBullet' w bt
|
||||
| t <= 0 = (w, Nothing)
|
||||
@@ -40,51 +32,3 @@ mvGenBullet' w bt
|
||||
hiteff = _btHitEffect' bt
|
||||
wth = _btWidth' bt
|
||||
t = _btTimer' bt
|
||||
|
||||
type HitCreatureEffect = Particle' -> Point2 -> Creature -> World -> World
|
||||
type HitWallEffect = Particle' -> Point2 -> Wall -> World -> World
|
||||
type HitForceFieldEffect = Particle' -> Point2 -> ForceField -> World -> World
|
||||
|
||||
passThroughAll :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
|
||||
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
|
||||
passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt)
|
||||
where
|
||||
mvPt = Just $ pt & btTrail' .~ (newP : trl)
|
||||
& btTimer' %~ (\t -> t - 1)
|
||||
& btPassThrough' .~ Nothing
|
||||
trl = _btTrail' pt
|
||||
newP = head trl +.+ _btVel' pt
|
||||
|
||||
destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
|
||||
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
|
||||
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
|
||||
[] -> ( w, mvPt)
|
||||
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
|
||||
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
|
||||
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
|
||||
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
|
||||
& btTimer' .~ 3
|
||||
mvPt = Just $ pt & btTrail' .~ (newP : trl)
|
||||
& btTimer' %~ (\t -> t - 1)
|
||||
& btPassThrough' .~ Nothing
|
||||
trl = _btTrail' pt
|
||||
wth = _btWidth' pt
|
||||
newP = head trl +.+ _btVel' pt
|
||||
|
||||
penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
|
||||
Particle' -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle')
|
||||
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
|
||||
[] -> ( w, mvPt)
|
||||
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
|
||||
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
|
||||
((p,E3x2 wl):hs) | isJust (wl ^? blHP)
|
||||
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
|
||||
((p,E3x2 wl):_) | otherwise -> (wlEff pt p wl w, destroyAt p)
|
||||
where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
|
||||
& btTimer' .~ 3
|
||||
mvPt = Just $ pt & btTrail' .~ (newP : trl)
|
||||
& btTimer' %~ (\t -> t - 1)
|
||||
& btPassThrough' .~ Nothing
|
||||
trl = _btTrail' pt
|
||||
wth = _btWidth' pt
|
||||
newP = head trl +.+ _btVel' pt
|
||||
|
||||
@@ -10,6 +10,35 @@ import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Function (on)
|
||||
|
||||
thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
thingsHit sp ep w
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures 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
|
||||
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
||||
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
|
||||
|
||||
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
|
||||
-> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
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 _ = True
|
||||
|
||||
thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World
|
||||
-> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
|
||||
@@ -35,26 +64,6 @@ thingsHitLongLine sp ep w
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
|
||||
thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
|
||||
thingsHit sp ep w
|
||||
| sp == ep = []
|
||||
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
|
||||
where
|
||||
hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
|
||||
$ _creatures 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
|
||||
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
|
||||
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
|
||||
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
|
||||
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
|
||||
|
||||
thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, (Either3 Creature Wall ForceField) ) ] ]
|
||||
thingsHitOnPath [] _ = error "tried to find thingsHitOnPath containing no points"
|
||||
thingsHitOnPath ps w = map (flip (uncurry thingsHit) w) . zip ps $ tail ps
|
||||
|
||||
Reference in New Issue
Block a user