module Dodge.Bullet (updateBullet) where import Dodge.Damage import Data.Bifunctor import Data.Foldable import Data.Maybe import Dodge.Creature.Test import Dodge.Data.World import Dodge.EnergyBall import Dodge.Item.Weapon.Bullet import Dodge.Movement.Turn import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.ThingsHit import Geometry --import qualified IntMapHelp as IM import LensHelp import qualified ListHelp as List import System.Random updateBullet :: World -> Bullet -> (World, Maybe Bullet) updateBullet w bu | magV (_buVel bu) < 10 , BulBall _ <- _buPayload bu = (useBulletPayload bu (_buPos bu) w, Nothing) | magV (_buVel bu) < 1 = (useBulletPayload bu (_buPos bu) w, Nothing) -- have to be slightly carefull not to accelerate bullets using magnets | otherwise = second (Just . updateBulVel) . hitEffFromBul w $ applyMagnetsToBul bu w -- do we want this to drain energy from the deflection source? applyMagnetsToBul :: Bullet -> World -> Bullet applyMagnetsToBul bu = foldl' doMagnetBuBu bu . _oldMagnets . _lWorld . _cWorld doMagnetBuBu :: Bullet -> Magnet -> Bullet doMagnetBuBu bu mg | notclose = bu | otherwise = case _mgField mg of MagnetAlign -> doturntowards mgalignpos MagnetDeflect -> doturntowards mgdeflectpos MagnetAttract -> doturntowards mpos MagnetRepulse -> doturntowards (2 * bpos - mpos) where notclose = d > 100 doturntowards p = bu & buVel %~ vecTurnTo (10 * pi / (d + 40)) bpos p bvel = bu ^. buVel mpos = mg ^. mgPos bpos = bu ^. buPos mgdeflectpos | isLHS mpos (mpos + bvel) bpos = bpos + vNormal (bpos - mpos) | otherwise = bpos - vNormal (bpos - mpos) mgalignpos | dotV bvel (bpos - mpos) > 0 = bpos - mpos | otherwise = mpos - bpos d = dist (bu ^. buPos) (mg ^. mgPos) updateBulVel :: Bullet -> Bullet updateBulVel bt = bt & buVel .*.*~ _buDrag bt --case _buTrajectory bt of -- BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt -- MagnetTrajectory tpos -> bt -- & buVel %~ (clipV 20 . (+.+ 5 *.* normalizeV (tpos -.- _buPos bt))) -- FlechetteTrajectory tpos -> bt & buVel %~ vecTurnTo 0.2 (_buPos bt) tpos -- BezierTrajectory spos tpos xpos -> -- let bf tm = bQuadToF (spos, xpos, tpos) $ (100 - tm) * 0.05 -- in bt & buVel .~ bf (fromIntegral $ t - 1) -.- bf (fromIntegral t) -- where -- t = _buTimer bt -- NOTE THE FOLLOWING HAS BEZIER CURE/FLECHETTE STUFF THAT MIGHT BE USEFUL --shootBullet :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World --shootBullet itm cr w = fromMaybe (error "cannot find bullet ammo when expected to") $ do -- atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0 -- leftitms <- itm ^? ldtLeft -- mag <- lookup (AmmoInLink 0 atype) leftitms -- thebullet <- mag ^? ldtValue . itUse . amagParams . ampBullet -- return $ w -- & randGen .~ g' -- & cWorld . lWorld . instantBullets -- .:~ ( thebullet -- & buPos .~ _crPos cr -- & buTrajectory %~ settrajectory -- & buVel %~ (rotateV dir . (muzvel *.*)) -- & buDrag *~ drag -- ) -- where -- it = itm ^. ldtValue -- sp = _crPos cr +.+ (muzlength ^?! _head . _x) *.* unitVectorAtAngle dir -- dir = _crDir cr -- (drag,g) = case _rifling (_heldParams $ _itUse it) of -- ConstFloat x -> (x, _randGen w) -- UniRandFloat x y -> randomR (x,y) $ _randGen w -- (muzvel,g') = case _muzVel $ _heldParams $ _itUse it of -- ConstFloat x -> (x,g) -- UniRandFloat x y -> randomR (x,y) $ _randGen w -- muzlength = aimingMuzzlePos cr it -- settrajectory traj = case traj of -- BasicBulletTrajectory -> BasicBulletTrajectory -- MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do -- tpos <- cr ^? crTargeting . ctPos . _Just -- return $ MagnetTrajectory tpos -- FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do -- tpos <- cr ^? crTargeting . ctPos . _Just -- return $ FlechetteTrajectory tpos -- BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do -- tpos <- cr ^? crTargeting . ctPos . _Just -- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam)) bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2 bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl) bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p - _crPos cr bounceDir _ = Nothing useBulletPayload :: Bullet -> Point2 -> World -> World useBulletPayload bu = case _buPayload bu of BulPlain _ -> const id BulFlak -> makeFlak bu BulFrag -> makeFragBullets BulGas -> (`makeGasCloud` V2 0 0) BulBall ExplosiveBall -> makeMovingEB (_buVel bu) ExplosiveBall BulBall ElectricalBall{} -> makeMovingEB (_buVel bu) (ElectricalBall (round $ bu ^. buPos . _1)) BulBall FlashBall -> makeMovingEB (_buVel bu) FlashBall BulBall (FlameletBall x r) -> makeMovingEB (_buVel bu) (FlameletBall x r) BulBall IncendiaryBall -> makeMovingEB (_buVel bu) IncendiaryBall makeFragBullets :: Point2 -> World -> World makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus where bus = zipWith f (take 10 as) (take 10 ss) as = randomRs (0, 2 * pi) $ _randGen w ss = randomRs (5, 15) $ _randGen w f a s = defaultBullet & buPayload .~ BulPlain 5 & buVel .~ s *.* unitVectorAtAngle a & buDrag .~ 0.8 & buPos .~ p & buOldPos .~ p makeFlak :: Bullet -> Point2 -> World -> World makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs] where s = min 10 (0.5 * magV (_buVel bu)) xs = take 5 $ randomRs (- s, s) $ _randGen w f x = bu & buVel %~ g x & buPayload .~ BulPlain 25 g x v = v +.+ x *.* normalizeV (vNormal v) hitEffFromBul :: World -> Bullet -> (World, Bullet) hitEffFromBul w bu = case _buEffect bu of PenetrateBullet -> movePenBullet bu hitstream w BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do (hp, crwl) <- hitstream ^? _head dir <- bounceDir (hp, crwl) return ( w , bu & buPos .~ hp + normalizeV (_buPos bu - hp) & buVel %~ reflectIn dir ) DestroyBullet -> expireAndDamage bu hitstream w where sp = _buPos bu hitstream = thingsHit sp (sp + _buVel bu) w getBulHitDams :: Bullet -> Point2 -> [Damage] getBulHitDams bu p = case _buPayload bu of BulPlain x -> [Piercing x p v] _ -> [] where v = _buVel bu damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World damageThingHit bu (p, crwl) = damageCrWl (getBulHitDams bu p) crwl -- case crwl of -- Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crDamage <>~ dams -- Right wl -> cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty <>~ dams -- where -- dams = setFromToDams bu p expireAndDamage :: Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Bullet) expireAndDamage bt things w = case List.safeHead things of Nothing -> (w, moveBullet bt) Just x -> (damageThingHit bt x w, stopBulletAt (fst x) bt) moveBullet :: Bullet -> Bullet moveBullet pt = pt & buPos +~ _buVel pt & buOldPos .~ _buPos pt stopBulletAt :: Point2 -> Bullet -> Bullet stopBulletAt hitp pt = pt & buPos .~ hitp & buOldPos .~ _buPos pt & buVel .~ 0 movePenBullet :: Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Bullet) movePenBullet bu hitstream w = case hitstream of [] -> (w, moveBullet bu) ((p, crwl) : strm) | penThing crwl -> first (damageThingHit bu (p, crwl)) $ movePenBullet bu strm w _ -> expireAndDamage bu hitstream w penThing :: Either Creature Wall -> Bool penThing (Left _) = True penThing (Right wl) = _wlPenetrable wl