module Dodge.Bullet ( updateBullet, useAmmoParams, ) where import Dodge.Item.Weapon.Bullet import System.Random import Data.Foldable import Data.Maybe import Dodge.Base.Coordinate import Dodge.Creature.HandPos import Dodge.Creature.Test import Dodge.Data.World import Dodge.EnergyBall import Dodge.MagnetBuBu 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 Data.Bifunctor updateBullet :: World -> Bullet -> (World, Maybe Bullet) updateBullet w bu = case _buDelayFraction bu of 1 -> mvBullet 1 w bu x -> mvBullet x w (bu & buDelayFraction .~ 1) mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet) mvBullet x w bu -- | magV (_buVel bu) < 1 = (w, Nothing) -- | _buTimer bu <= 0 = (endspawn w, Nothing) | magV (_buVel bu) < 1 || _buTimer bu <= 0 = (endspawn w, Nothing) | otherwise = second (fmap updateBulVel) . hitEffFromBul x w $ applyMagnetsToBul bu w where endspawn = fromMaybe id $ do partspawn <- bulletSpawn bu return $ partspawn p p = _buPos bu applyMagnetsToBul :: Bullet -> World -> Bullet applyMagnetsToBul bu = foldl' (flip doMagnetBuBu) bu . _magnets . _lWorld . _cWorld updateBulVel :: Bullet -> Bullet updateBulVel 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 useAmmoParams :: Item -> Creature -> World -> World useAmmoParams it cr w = w & cWorld . lWorld . instantBullets .:~ ( _amBullet bultype & buPos .~ sp & buTrajectory %~ settrajectory & buVel %~ (rotateV dir . (muzvel *.*)) & buDrag *~ _rifling (_itParams it) ) where sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir dir = _crDir cr bultype = _laAmmoType $ _heldConsumption $ _itUse it muzvel = _muzVel $ _itParams it 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 ^. cWorld . camPos)) 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 bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World) bulletSpawn bu = case _buSpawn bu of BulSpark -> Nothing BulFlak -> Just (makeFlak bu) BulFrag -> Just makeFragBullets BulGas -> Just (`makeGasCloud` V2 0 0) BulBall IncBall -> Just incBallAt BulBall ConcBall -> Just $ \p -> cWorld . lWorld . shockwaves .:~ concBall p BulBall TeslaBall -> Just makeStaticBall BulBall FlashBall -> Just makeFlashBall makeFragBullets :: Point2 -> World -> World makeFragBullets p w = w & cWorld . lWorld . instantBullets .++~ 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 & buVel .~ s *.* unitVectorAtAngle a & buDrag .~ 0.8 & buPos .~ p & buOldPos .~ p & buWidth .~ 1 & buDamages .~ [ Damage PIERCING 5 0 0 0 NoDamageEffect , Damage PUSHDAM 1 0 0 0 . PushBackDamage $ 2 ] makeFlak :: Bullet -> Point2 -> World -> World makeFlak bu _ w = w & cWorld . lWorld . instantBullets .++~ [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 & buTimer .~ 97 & buSpawn .~ BulSpark & buWidth .~ 0.5 & buDamages .~ [ Damage PIERCING 25 0 0 0 NoDamageEffect , Damage PUSHDAM 1 0 0 0 . PushBackDamage $ 2 ] g x v = v +.+ x *.* normalizeV (vNormal v) hitEffFromBul :: Float -> World -> Bullet -> (World, Maybe Bullet) hitEffFromBul x w bu = case _buEffect bu of PenetrateBullet -> movePenBullet x bu hitstream w BounceBullet -> case List.safeHead hitstream of Nothing -> (w, moveBullet x bu) Just (hp, crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do dir <- bounceDir (hp, crwl) return ( w , Just $ bu & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp) & buVel %~ reflectIn dir & buTrajectory .~ BasicBulletTrajectory & buTimer -~ 1 ) DestroyBullet -> expireAndDamage x bu hitstream w where ep = sp +.+ x *.* _buVel bu sp = _buPos bu hitstream = thingsHit sp ep w setFromToDams :: Bullet -> Point2 -> [Damage] setFromToDams bu p = map f (_buDamages bu) where f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu) damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World damageThingHit bu (p, crwl) = case crwl of Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams where dams = setFromToDams bu p expireAndDamage :: Float -> Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Maybe Bullet) expireAndDamage y bt things w = case List.safeHead things of Nothing -> (w, moveBullet y bt) Just x -> (damageThingHit bt x w, destroyAt (fst x) bt) moveBullet :: Float -> Bullet -> Maybe Bullet moveBullet x pt = Just $ pt & buPos %~ (+.+ x *.* _buVel pt) & buOldPos .~ _buPos pt & buTimer -~ 1 destroyAt :: Point2 -> Bullet -> Maybe Bullet destroyAt hitp pt = Just $ pt & buPos .~ hitp +.+ normalizeV (p -.- hitp) & buOldPos .~ p & buVel .~ 0 where p = _buPos pt movePenBullet :: Float -> Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Maybe Bullet) movePenBullet x bu hitstream w = case hitstream of [] -> (w, moveBullet x bu) ((p, crwl) : strm) -> if penThing crwl then first (damageThingHit bu (p, crwl)) $ movePenBullet x bu strm w else expireAndDamage x bu hitstream w penThing :: Either Creature Wall -> Bool penThing (Left _) = True penThing (Right wl) = _wlPenetrable wl