module Dodge.Bullet ( updateBullet , useAmmoParams ) where import qualified ListHelp as List import Dodge.EnergyBall import Dodge.Creature.Test import Dodge.Data import Dodge.Creature.HandPos import Dodge.Base.Coordinate import Dodge.WorldEvent.SpawnParticle import Geometry import LensHelp import StreamingHelp import qualified IntMapHelp as IM import Data.Maybe import Dodge.Movement.Turn import Dodge.WorldEvent.ThingsHit updateBullet :: World -> Bullet -> (World,Maybe Bullet) updateBullet w bu = case _buState bu of DelayedBullet x -> mvBullet x w bu _ -> mvBullet 1 w bu useAmmoParams :: Item -> Creature -> World -> World useAmmoParams it cr w = w & 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 $ _itConsumption it muzvel = _muzVel $ _itParams it muzlength = aimingMuzzlePos cr it settrajectory traj = case traj of BasicBulletTrajectory -> BasicBulletTrajectory MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just return $ MagnetTrajectory tpos FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just return $ FlechetteTrajectory tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just return $ BezierTrajectory sp tpos (mouseWorldPos w) {- Update for a generic bullet. -} mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet) mvBullet x w bt' | t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing) | otherwise = second (fmap dodrag) $ hiteff bt hitstream w where endspawn w' = fromMaybe w' $ do partspawn <- bulletSpawn bt' return $ partspawn p w' hitstream = thingsHit p (p +.+ vel) w bt = foldr (\mg b -> _mgField mg mg b) bt' (_magnets w) & buState .~ NormalBulletState dodrag = case _buTrajectory bt of BasicBulletTrajectory -> buVel .*.*~ drag MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt) FlechetteTrajectory tpos -> buVel %~ vecTurnTo 0.2 (_buPos bt) tpos BezierTrajectory spos tpos xpos -> let bf tm = bQuadToF (spos,xpos,tpos) $ (100 - tm) * 0.05 in buVel .~ bf (fromIntegral $ _buTimer bt - 1) -.- bf (fromIntegral $ _buTimer bt) drag = _buDrag bt p = _buPos bt vel = _buVel bt hiteff = hitEffFromBul x t = _buTimer bt 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 BulBall IncBall -> Just incBallAt BulBall ConcBall -> Just $ randParticleAt concBall BulBall TeslaBall -> Just makeStaticBall hitEffFromBul :: Float -> Bullet -> [(Point2, Either Creature Wall)] -> World -> (World,Maybe Bullet) hitEffFromBul x bu hitstream w = 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 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 -> creatures . ix (_crID cr) . crState . csDamage .++~ dams Right wl -> 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