From e32c6082c5bad8ded90e5af2b80e33ca06334abe Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 25 Mar 2021 05:10:05 +0100 Subject: [PATCH] Refactor bezgun --- src/Dodge/Item/Weapon.hs | 61 +++++++++++++++---------------- src/Dodge/WorldEvent.hs | 2 + src/Dodge/WorldEvent/Bullet.hs | 56 ---------------------------- src/Dodge/WorldEvent/ThingsHit.hs | 49 +++++++++++++++---------- 4 files changed, 61 insertions(+), 107 deletions(-) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 8ce823e43..f66a0565e 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -180,7 +180,6 @@ rezGun = defaultGun , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] - , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 @@ -204,7 +203,6 @@ teslaGun = defaultAutoGun , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] - , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 @@ -337,7 +335,11 @@ launcher = defaultGun } bezierGun = defaultAutoGun { _itName = "B-GUN" - , _wpFire = maybeSetTarget shootBezier + , _wpFire = maybeSetTarget $ \p -> shootWithSound 0 + . withMuzFlare + . withRecoil 40 + . torqueBefore 0.05 -- I believe that this doesn't affect + $ shootBezier p -- <- the start point , _itAttachment = Nothing , _itScrollUp = removeItAttachment 0 , _itScrollDown = removeItAttachment 0 @@ -349,37 +351,34 @@ bezierGun = defaultAutoGun maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of - Just (ItTargetPos targetp) -> f targetp cid w - _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp) - where - mp = mouseWorldPos w - cr = _creatures w IM.! cid - itRef = _crInvSel cr + Just (ItTargetPos targetp) + -> f targetp cid w + _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp) + where + mp = mouseWorldPos w + cr = _creatures w IM.! cid + itRef = _crInvSel cr shootBezier :: Point2 -> Int -> World -> World -shootBezier targetp cid w = (shootWithSound 0 - . withMuzFlare - . withRecoil 40 - . torqueBefore 0.05 - ) bezBul cid w - where --- note that torqueBefore will not affect the startp here - bezBul = mkBezierBul startp controlp targetp - controlp = mouseWorldPos w - cr = _creatures w IM.! cid - dir = _crDir cr - startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) +shootBezier targetp cid w = over particles' (theBullet :) w + where + theBullet = aCurveBulAt + (Just cid) + white + startp + (controlp +.+ randPos) + (targetp +.+ randPos') + (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') + 5 + controlp = mouseWorldPos w + cr = _creatures w IM.! cid + dir = _crDir cr + startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) + (randPos,randPos') = flip evalState (_randGen w) + $ do a <- randInCirc 10 + b <- randInCirc 20 + return (a,b) -mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World -mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w - where - bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') - (passThroughAll bulHitCr' bulHitWall' bulHitFF') 5 - (randPos,randPos') = flip evalState (_randGen w) - $ do a <- randInCirc 10 - b <- randInCirc 20 - return (a,b) - removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing where cr = _creatures w IM.! i diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 64bd25d09..e117c2040 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -5,6 +5,7 @@ module Dodge.WorldEvent , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.HelperParticle , module Dodge.WorldEvent.Cloud + , module Dodge.WorldEvent.HitEffect ) where @@ -13,6 +14,7 @@ import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.HelperParticle import Dodge.WorldEvent.Cloud +import Dodge.WorldEvent.HitEffect import Dodge.LightSources import Dodge.Data diff --git a/src/Dodge/WorldEvent/Bullet.hs b/src/Dodge/WorldEvent/Bullet.hs index 1ec9d5cff..ded26a082 100644 --- a/src/Dodge/WorldEvent/Bullet.hs +++ b/src/Dodge/WorldEvent/Bullet.hs @@ -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 diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index f2e084b62..149d288a6 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -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