From 882a8e98246e2739a9acd6c28bbfbf13aa834aea Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 28 Aug 2021 12:09:39 +0100 Subject: [PATCH] Beef up minigun --- src/Dodge/Creature.hs | 1 + src/Dodge/Creature/State.hs | 4 +- src/Dodge/Data.hs | 1 + src/Dodge/Default.hs | 1 + src/Dodge/Item/Weapon.hs | 124 ++++++++++---- src/Dodge/Item/Weapon/AutoGun.hs | 10 +- src/Dodge/Item/Weapon/Bezier.hs | 4 +- src/Dodge/Item/Weapon/Launcher.hs | 5 +- src/Dodge/Item/Weapon/TriggerType.hs | 231 ++++++-------------------- src/Dodge/Item/Weapon/UseEffect.hs | 3 - src/Dodge/Particle/Bullet/Draw.hs | 2 +- src/Dodge/Particle/Bullet/Spawn.hs | 22 +++ src/Dodge/Render/HUD.hs | 55 +++++- src/Dodge/Render/Picture.hs | 13 +- src/Dodge/WorldEvent/Explosion.hs | 2 +- src/Dodge/WorldEvent/SpawnParticle.hs | 3 +- src/Geometry/Vector.hs | 19 ++- 17 files changed, 263 insertions(+), 237 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index a9f99c879..62d02d4e5 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -161,6 +161,7 @@ startInventory = IM.fromList (zip [0..20] ( [spreadGun ,autoGun + ,ltAutoGun ,hvAutoGun ,pistol ,teslaGun diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index ee43391ad..59c2e0541 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -68,7 +68,9 @@ dropByState cr w = foldr (copyItemToFloor cr) w is DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w) setOldPos :: Creature -> Creature -setOldPos cr = set crOldPos (_crPos cr) cr +setOldPos cr = cr + & crOldPos .~ _crPos cr + & crOldDir .~ _crDir cr {- | Given a creature and a velocity, applies friction to that creature and evaluates a velocity to carry across frames. diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 951c9471c..eda7c1fdd 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -155,6 +155,7 @@ data Creature = Creature , _crOldPos :: Point2 , _crVel :: Point2 , _crDir :: Float + , _crOldDir :: Float , _crMvDir :: Float , _crID :: Int , _crPict :: Creature -> World -> Picture diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 8458ffbc9..3e45f6a67 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -28,6 +28,7 @@ defaultCreature = Creature , _crOldPos = V2 0 0 , _crVel = V2 0 0 , _crDir = 0 + , _crOldDir = 0 , _crMvDir = 0 , _crID = 1 , _crPict = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 67fc318a5..88ff96941 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -60,8 +60,11 @@ pistol = defaultGun , _itUseTime = 0 , _itUse = useAmmoParams , _itUseModifiers = - [ hammerCheckI - , shootWithSoundI 0 + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundI 0 + , useAmmo 1 -- , withRandomDirI 0.1 , withMuzFlareI ] @@ -108,7 +111,7 @@ rezGun = defaultGun , _wpReloadState = 0 , _itUseRate = 0 , _itUseTime = 0 - , _itUse = \_ -> aTeslaArc + , _itUse = const aTeslaArc , _itUseModifiers = [] , _wpSpread = 0.001 @@ -134,9 +137,12 @@ teslaGun = defaultGun , _wpReloadState = 0 , _itUseRate = 0 , _itUseTime = 0 - , _itUse = \_ -> aTeslaArc + , _itUse = const aTeslaArc , _itUseModifiers = - [ shootWithSoundForI 25 1 + [ ammoCheckI + , useTimeCheckI + , withSoundForI 25 1 + , useAmmo 1 ] , _wpSpread = 0.001 , _wpRange = 20 @@ -165,9 +171,12 @@ lasGun = defaultAutoGun , _wpReloadState = 0 , _itUseRate = 0 , _itUseTime = 0 - , _itUse = \_ -> aLaser + , _itUse = const aLaser , _itUseModifiers = - [ shootWithSoundForI 24 1 + [ ammoCheckI + , useTimeCheckI + , withSoundForI 24 1 + , useAmmo 1 ] , _wpSpread = 0.001 , _wpRange = 20 @@ -255,9 +264,10 @@ remoteLauncher = defaultGun , _wpReloadState = 0 , _itUseRate = 10 , _itUseTime = 0 - , _itUse = \_ -> fireRemoteLauncher + , _itUse = const fireRemoteLauncher , _itUseModifiers = - [ hammerCheckI + [ ammoCheckI + , hammerCheckI ] , _wpSpread = 0.02 , _wpRange = 20 @@ -306,7 +316,10 @@ ltAutoGun = defaultAutoGun , _itUseTime = 0 , _itUse = useAmmoParams , _itUseModifiers = - [ shootWithSoundI 0 + [ ammoCheckI + , useTimeCheckI + , withSoundI 0 + , useAmmo 1 , withRandomDirI 0.3 , withSidePushI 50 , withMuzFlareI @@ -330,22 +343,40 @@ miniGun :: Item miniGun = defaultAutoGun { _itName = "MINI-G" , _itIdentity = MiniGun - , _wpMaxAmmo = 150 - , _wpLoadedAmmo = 150 + , _wpMaxAmmo = 1500 + , _wpLoadedAmmo = 1500 , _wpReloadTime = 200 , _wpReloadState = 0 - , _wpMaxWarmUp = 100 + , _wpMaxWarmUp = 50 , _itUseRate = 1 , _itUseTime = 0 - , _itUse = useAmmoParams + , _itUse = useAmmoParamsVelMod vm4 , _itUseModifiers = [ ammoCheckI , withWarmUpI 26 - , shootWithSoundForI 28 2 - , torqueBeforeForcedI 0.1 + , useTimeCheckI + , withRecoilI 25 + , withSoundForI 28 2 + , torqueAfterI 0.05 + --, withSidePushI 53 + --, withRandomOffsetI 12 + , trigDoAlso (useAmmoParamsVelMod vm1) + --, torqueBeforeForcedI 0.001 + , withSidePushI 52 + , withRandomOffsetI 11 + , withOldDir od1 + , trigDoAlso (useAmmoParamsVelMod vm2) + --, torqueBeforeForcedI 0.001 + , withSidePushI 51 + , withRandomOffsetI 10 + , withOldDir od2 + , trigDoAlso (useAmmoParamsVelMod vm3) + , useAmmo 4 + --, torqueBeforeForcedI 0.001 , withSidePushI 50 , withRandomOffsetI 9 , withMuzFlareI + , withOldDir od3 ] , _wpRange = 20 , _itFloorPict = onLayer FlItLayer miniGunPict @@ -354,6 +385,17 @@ miniGun = defaultAutoGun , _itEquipPict = pictureWeaponOnAim miniGunPict , _wpAmmo = basicBullet } + where + [vm1,vm2,vm3,vm4] = + [ 0.25 + , 0.5 + , 0.75 + , 1 + ] + [od1,od2,od3] = + [ 0.25, 0.5, 0.9] + --[ 0.75, 0.5, 0.25] + --[ 0, 0, 0] miniGunPict :: Picture miniGunPict = pictures [ translate 5 0 . color red $ polygon $ rectNESW 9 7 (-9) (-5) @@ -372,17 +414,21 @@ spreadGun = defaultGun --, _itUse = \_ -> spreadNumVelWthHiteff spreadGunSpread 9 (V2 30 0) 2 basicBulletEffect , _itUse = useAmmoParams , _itUseModifiers = - [ shootWithSoundI shotgunSound + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundI shotgunSound + , useAmmo 1 , withRecoilI 100 , withMuzFlareI , spreadNumI ] , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ spreadGunPic + , _itFloorPict = onLayer FlItLayer spreadGunPic , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ spreadGunPic + , _itEquipPict = pictureWeaponOnAim spreadGunPic , _wpAmmo = basicBullet , _wpNumBarrels = 50 } @@ -400,7 +446,11 @@ multGun = defaultGun , _itUseTime = 0 , _itUse = useAmmoParams , _itUseModifiers = - [ shootWithSoundI shotgunSound + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundI shotgunSound + , useAmmo 1 , withRecoilI 200 , withMuzFlareI , numI @@ -441,7 +491,11 @@ longGun = defaultGun , _itUseTime = 0 , _itUse = useAmmoParams , _itUseModifiers = - [ shootWithSoundI longGunSound + [ ammoCheckI + , hammerCheckI + , useTimeCheckI + , withSoundI longGunSound + , useAmmo 1 , withThickSmokeI , torqueAfterI 0.05 , withMuzFlareI @@ -483,9 +537,11 @@ poisonSprayer = defaultAutoGun , _wpReloadState = 0 , _itUseRate = 0 , _itUseTime = 0 - , _itUse = \_ -> aGasCloud + , _itUse = const aGasCloud , _itUseModifiers = - [shootWithSoundI buzzSound + [ useTimeCheckI + , withSoundI buzzSound + , useAmmo 1 ] , _wpSpread = 0.3 , _wpRange = 8 @@ -535,10 +591,10 @@ blinkGun = defaultGun , _wpReloadState = 0 , _itUseRate = 0 , _itUseTime = 0 - , _itUse = \_ -> aSelf + , _itUse = const aSelf , _itUseModifiers = - [ hammerCheckI - , ammoUseCheckI + [ ammoCheckI + , hammerCheckI ] , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL , _wpSpread = 0.05 @@ -640,7 +696,7 @@ pointToItem (OnFloor flid) = floorItems . ix flid . flIt retireRemoteRocket :: Int -> Int -> Int -> World -> World retireRemoteRocket itid 0 pjid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (V2 0 0) - $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (\_ -> fireRemoteLauncher) + $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (const fireRemoteLauncher) (w & projectiles %~ IM.delete pjid) retireRemoteRocket itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid) @@ -651,13 +707,12 @@ retireRemoteRocket itid t pjid w = setScope w . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' pos = fromMaybe (V2 0 0) $ w ^? projectiles . ix pjid . pjPos - retireRemoteBomb :: Int -> Int -> Int -> World -> World retireRemoteBomb itid 0 pjid w = w & pointToItem (_itemPositions w IM.! itid) %~ ( (itAttachment . _Just . scopePos .~ V2 0 0) . (itZoom .~ defaultItZoom) - . (itUse .~ (\_ -> throwRemoteBomb)) + . (itUse .~ const throwRemoteBomb) ) & projectiles %~ IM.delete pjid retireRemoteBomb itid t pjid w = setScope w @@ -743,7 +798,7 @@ grenade = Throwable , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime} , _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime , _itID = Nothing - , _itUseRate = 50 + , _itUseRate = 25 , _itUseTime = 0 , _itAttachment = Just $ ItFuse fuseTime , _itInvColor = white @@ -787,7 +842,7 @@ remoteBomb = defaultThrowable , _itFloorPict = onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 - , _itUse = \_ -> throwRemoteBomb + , _itUse = const throwRemoteBomb , _itUseModifiers = [ hammerCheckI ] @@ -982,7 +1037,7 @@ radar = defaultGun , _wpReloadState = 0 , _itUseRate = 120 , _itUseTime = 0 - , _itUse = \_ -> aRadarPulse + , _itUse = const aRadarPulse , _itUseModifiers = [ ammoUseCheckI ] @@ -1008,7 +1063,7 @@ sonar = defaultGun , _wpReloadState = 0 , _itUseRate = 120 , _itUseTime = 0 - , _itUse = \_ -> aSonarPulse + , _itUse = const aSonarPulse , _itUseModifiers = [ ammoUseCheckI ] @@ -1065,7 +1120,8 @@ spawnGun cr = defaultGun , _itUseRate = 100 , _itUse = \_ -> spawnCrNextTo cr , _itUseModifiers = - [ hammerCheckI + [ ammoCheckI + , hammerCheckI ] } spawnCrNextTo diff --git a/src/Dodge/Item/Weapon/AutoGun.hs b/src/Dodge/Item/Weapon/AutoGun.hs index d458c3e85..d0d02d456 100644 --- a/src/Dodge/Item/Weapon/AutoGun.hs +++ b/src/Dodge/Item/Weapon/AutoGun.hs @@ -31,10 +31,14 @@ autoGun = defaultAutoGun , _itUseTime = 0 , _itUse = useAmmoParams , _itUseModifiers = - [ charFiringStratI - [('M',shootWithSoundI autoGunSound . torqueBeforeForcedI 0.05) - ,('S',hammerCheckI . shootWithSoundI autoGunSound) + [ ammoCheckI + , useTimeCheckI + , charFiringStratI + [('M', torqueBeforeForcedI 0.05) + ,('S', hammerCheckI) ] + , withSoundI autoGunSound + , useAmmo 1 , withRandomDirI (autogunSpread/2) , withMuzFlareI ] diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index c4c66294d..dcf2ff887 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -26,7 +26,9 @@ bezierGun = defaultGun { _itName = "B-GUN" , _itUse = \_ -> useTargetPos $ \p -> shootBezier $ fromJust p -- <- the start point , _itUseModifiers = - [shootWithSoundI 0 + [ useTimeCheckI + , withSoundI 0 + , useAmmo 1 , withMuzFlareI . withRecoilI 40 . torqueBeforeForcedI 0.05 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index b7352d645..5a40ca0e9 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -39,7 +39,10 @@ launcher = defaultGun , _itUseTime = 0 , _itUse = aRocketWithItemParams , _itUseModifiers = - [ shootWithSoundI launcherSound + [ ammoCheckI + , useTimeCheckI + , withSoundI launcherSound + , useAmmo 1 ] , _wpSpread = 0.02 , _wpRange = 20 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 222ff4d7b..aae2596e6 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -1,15 +1,17 @@ {- | Weapon effects when pulling the trigger. -} module Dodge.Item.Weapon.TriggerType - ( shootWithSoundI - , shootWithSoundForI + ( useAmmo , withMuzFlareI - , withVelWthHiteff + , withOldDir + , trigDoAlso + --, withVelWthHiteff , ammoUseCheckI , rateIncABI , torqueBeforeForcedI , torqueAfterI , withSoundI + , withSoundForI , withThickSmokeI , withThinSmokeI , withRandomOffsetI @@ -34,7 +36,6 @@ import Dodge.Creature.Action (startReloadingWeapon) import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt) import Dodge.WorldEvent.Cloud import Dodge.RandomHelp -import Dodge.Particle.Bullet.Spawn import Dodge.Item.Attachment.Data import Dodge.Item.Data import Geometry @@ -47,32 +48,26 @@ import qualified Data.IntMap.Strict as IM import Data.Foldable type ChainEffect = - (Item -> Creature -> World -> World) + (Item -> Creature -> World -> World) -> Item - -> Creature -- ^ Creature id + -> Creature -> World -> World +-- Note that this uses the "base" creature and item values +trigDoAlso + :: (Item -> Creature -> World -> World) + -> ChainEffect +trigDoAlso afterEff eff item cr = afterEff item cr . eff item cr - -withThinSmokeI - :: (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World +withThinSmokeI :: ChainEffect withThinSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThinSmokeAt . (+.+ pos)) w ps where dir = _crDir cr pos = _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir ps = (replicateM 5 . randInCirc) 8 & evalState $ _randGen w -withThickSmokeI - :: (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World +withThickSmokeI :: ChainEffect withThickSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThickSmokeAt . (+.+ pos)) w ps where dir = _crDir cr @@ -84,8 +79,9 @@ withThickSmokeI eff item cr w = eff item cr $ foldl' (flip $ makeThickSmokeAt . ammoCheckI :: ChainEffect ammoCheckI eff item cr w - | _wpLoadedAmmo item == 0 + | _wpLoadedAmmo item <= 0 = fromMaybe w (startReloadingWeapon cr w) + | _wpReloadState item > 0 = w | otherwise = eff item cr w {- | @@ -95,13 +91,9 @@ Applies ammo check and use cooldown check. -} rateIncABI :: Int -- ^ Start rate -> Int -- ^ End rate - -> ((Item -> Creature -> World -> World) -> Item -> Creature -> World -> World) -- ^ Extra effect on first fire - -> ((Item -> Creature -> World -> World) -> Item -> Creature -> World -> World) -- ^ Extra effect on continued fire - -> (Item -> Creature -> World -> World) -- ^ Extra effect (always applied) - -> Item - -> Creature -- ^ Creature id - -> World - -> World + -> ChainEffect -- ^ Extra effect on first fire + -> ChainEffect -- ^ Extra effect on continued fire + -> ChainEffect rateIncABI startRate fastRate exeffFirst exeffCont eff item cr w | repeatFire = w & pointItem %~ ( (itUseRate .~ max fastRate (currentRate - 1)) @@ -126,12 +118,7 @@ rateIncABI startRate fastRate exeffFirst exeffCont eff item cr w {- | Apply effect after a warm up. -} withWarmUpI :: Int -- ^ warm up sound id - -> (Item -> Creature -> World -> World) - -- ^ underlying effect - -> Item - -> Creature - -> World - -> World + -> ChainEffect withWarmUpI soundID f item cr w | _wpReloadState item /= 0 = w | curWarmUp < maxWarmUp = w @@ -150,18 +137,22 @@ withWarmUpI soundID f item cr w The sound is emitted from the creature's position. -} withSoundI :: Int -- ^ Sound id - -> (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature - -> World -> World + -> ChainEffect withSoundI soundid f item cr = soundOncePos soundid (_crPos cr) . f item cr +{- | Adds a sound to a creature based world effect. +The sound is emitted from the creature's position. -} +withSoundForI + :: Int -- ^ Sound id + -> Int -- ^ Frames to play + -> ChainEffect +withSoundForI soundid playTime f item cr + = soundFromPos (CrWeaponSound (_crID cr)) (_crPos cr) soundid playTime 0 + . f item cr + withRecoilI :: Float -- ^ Recoil amount - -> (Item -> Creature -> World -> World) - -> Item - -> Creature - -> World -> World + -> ChainEffect withRecoilI recoilAmount eff item cr = eff item cr . over (creatures . ix cid) pushback where cid = _crID cr @@ -170,11 +161,7 @@ withRecoilI recoilAmount eff item cr = eff item cr . over (creatures . ix cid) p Applied before the underlying effect. -} withSidePushI :: Float -- ^ Maximal possible side push amount - -> (Item -> Creature -> World -> World) - -- ^ Underlying world effect - -> Item - -> Creature - -> World -> World + -> ChainEffect withSidePushI maxSide eff item cr w = eff item cr $ w & creatures . ix cid %~ push where @@ -186,76 +173,20 @@ withSidePushI maxSide eff item cr w = eff item cr $ Applied after the underlying effect. -} withSidePushAfterI :: Float -- ^ Maximal possible side push amount - -> (Item -> Creature -> World -> World) - -> Item - -> Creature -- ^ Creature id - -> World -> World + -> ChainEffect withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ w where cid = _crID cr push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr))) (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w -{- | Applies a world effect and sound effect after an ammo check. -} -shootWithSoundForI - :: Int -- ^ Sound identifier - -> Int -- ^ Frames to play - -> (Item -> Creature -> World -> World) - -- ^ underlying effect - -> Item - -> Creature - -> World - -> World -shootWithSoundForI soundid playTime f item cr w - | fireCondition = soundFromPos (CrWeaponSound cid) cpos soundid playTime 0 - $ f item cr - $ w - & pointerToItem %~ - ( ( wpLoadedAmmo -~ 1 ) - . ( itUseTime .~ _itUseRate item) - ) - | reloadCondition = fromMaybe w $ startReloadingWeapon cr w - | otherwise = w - where - cid = _crID cr - cpos = _crPos cr - itRef = _crInvSel cr - pointerToItem = creatures . ix cid . crInv . ix itRef - fireCondition = _wpReloadState item == 0 - && _itUseTime item == 0 - && _wpLoadedAmmo item > 0 - reloadCondition = _wpLoadedAmmo item == 0 -{- | Applies a world effect and sound effect after an ammo check. -} -shootWithSoundI - :: Int -- ^ Sound identifier - -> (Item -> Creature -> World -> World) - -- ^ Shoot effect, takes creature id as input - -> Item - -> Creature - -> World - -> World -shootWithSoundI soundid f item cr w - | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) - $ soundOncePos soundid (_crPos cr) - $ set (pointerToItem . itUseTime) (_itUseRate item) - $ f item cr w - | reloadCondition = fromMaybe w $ startReloadingWeapon cr w - | otherwise = w - where - cid = _crID cr - itRef = _crInvSel cr - pointerToItem = creatures . ix cid . crInv . ix itRef - fireCondition = _wpReloadState item == 0 - && _itUseTime item == 0 - && _wpLoadedAmmo item > 0 - reloadCondition = _wpLoadedAmmo item == 0 +useAmmo + :: Int -- ^ amount of ammo to use + -> ChainEffect +useAmmo amAmount eff item cr = eff item cr . + (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . wpLoadedAmmo -~ amAmount) {- | Applies a world effect after an item use cooldown check. -} -useTimeCheckI - :: (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World +useTimeCheckI :: ChainEffect useTimeCheckI f item cr w = case item ^? itUseTime of Just 0 -> f item cr $ setUseTime w _ -> w @@ -264,12 +195,7 @@ useTimeCheckI f item cr w = case item ^? itUseTime of setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate useRate = fromMaybe 0 $ item ^? itUseRate {- | Applies a world effect after a hammer position check. -} -hammerCheckI - :: (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World +hammerCheckI :: ChainEffect hammerCheckI f it cr w = case it ^? itHammer of Just HammerUp -> f it cr $ setHammerDown w _ -> setHammerDown w @@ -277,13 +203,7 @@ hammerCheckI f it cr w = case it ^? itHammer of cid = _crID cr setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown {- | Applies a world effect after an ammo check. -} -ammoUseCheckI - :: (Item -> Creature -> World -> World) - -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World +ammoUseCheckI :: ChainEffect ammoUseCheckI f item cr w | fireCondition = f item cr w & pointerToItem %~ ( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) ) @@ -333,12 +253,7 @@ shootL f cr invid w && _itUseTime item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 -withMuzFlareI - :: (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World +withMuzFlareI :: ChainEffect withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w where pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) @@ -346,38 +261,19 @@ withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w {- | Applies the effect to a randomly rotated creature. -} withRandomDirI :: Float -- ^ Max possible rotation - -> (Item -> Creature -> World -> World) - -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World + -> ChainEffect withRandomDirI acc f it cr w = f it (cr & crDir +~ a) $ set randGen g w where (a, g) = randomR (-acc,acc) $ _randGen w -{- | Creates a bullet with a given velocity, width, and 'HitEffect' -} -withVelWthHiteff - :: Point2 -- ^ Velocity, x direction is forward with respect to the creature - -> Float -- ^ Bullet width - -> HitEffect -- ^ Bullet effect when hitting creature, wall etc - -> Creature -- ^ Creature id - -> World - -> World -withVelWthHiteff vel width hiteff cr = over particles (newbul : ) - where - cid = _crID cr - newbul = aGenBulAt (Just cid) pos (rotateV dir vel) hiteff width - dir = _crDir cr - pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +withOldDir + :: Float -- ^ The fraction of the old direction + -> ChainEffect +withOldDir aFrac eff item cr w + = eff item (cr & crDir %~ tweenAngles aFrac (_crOldDir cr)) w {- | Apply the effect to a translated creature. -} withRandomOffsetI :: Float -- ^ Max possible translate - -> (Item -> Creature -> World -> World) - -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World + -> ChainEffect withRandomOffsetI offsetAmount f item cr w = f item (cr & crPos %~ (+.+ offV)) $ set randGen g w where (offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w @@ -386,12 +282,7 @@ withRandomOffsetI offsetAmount f item cr w = f item (cr & crPos %~ (+.+ offV)) $ -- Rotates the player creature before applying the effect, other creatures after. torqueBeforeForcedI :: Float -- ^ Max possible rotation (less the 0.1 forced rotation) - -> (Item -> Creature -> World -> World) - -- ^ Underlying effect - -> Item - -> Creature - -> World - -> World + -> ChainEffect torqueBeforeForcedI torque feff item cr w | cid == 0 = feff item (cr & crDir +~ rot') $ w & randGen .~ g @@ -406,11 +297,7 @@ torqueBeforeForcedI torque feff item cr w -- | Rotate a randomly creature after applying an effect. torqueAfterI :: Float -- ^ Max possible rotation - -> (Item -> Creature -> World -> World) -- ^ Underlying effect - -> Item - -> Creature -- ^ Creature id - -> World - -> World + -> ChainEffect torqueAfterI torque feff item cr w | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff item cr w @@ -419,12 +306,7 @@ torqueAfterI torque feff item cr w (rot, g) = randomR (-torque,torque) $ _randGen w rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV rot -spreadNumI - :: (Item -> Creature -> World -> World) - -> Item - -> Creature - -> World - -> World +spreadNumI :: ChainEffect spreadNumI eff item cr w = foldr f w dirs where dirs = zipWith (+) @@ -433,12 +315,7 @@ spreadNumI eff item cr w = foldr f w dirs f dir = eff item (cr & crDir +~ dir) spread = _wpSpread item numBul = _wpNumBarrels item -numI - :: (Item -> Creature -> World -> World) - -> Item - -> Creature - -> World - -> World +numI :: ChainEffect numI eff item cr w = foldr f w poss where cp :: Float diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index 7526c1607..505e0f89a 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -30,7 +30,6 @@ blipAt p col i = Particle {_ptDraw = const blank ,_ptUpdate' = mvBlip p col i i } - mvBlip :: Point2 -> Color -> Int -- ^ Max possible timer value -> Int -- ^ Current timer value @@ -80,7 +79,6 @@ radarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvRadar 50 p } - mvRadar :: Int -- ^ Timer -> Point2 -- ^ Center of expanding circle @@ -122,7 +120,6 @@ aTractorBeam col cr w pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir) dir = _crDir cr itRef = _crInvSel cr - tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile tractorBeamAt colID i pos dir = Projectile { _pjPos = pos diff --git a/src/Dodge/Particle/Bullet/Draw.hs b/src/Dodge/Particle/Bullet/Draw.hs index de4f94306..a2803dae8 100644 --- a/src/Dodge/Particle/Bullet/Draw.hs +++ b/src/Dodge/Particle/Bullet/Draw.hs @@ -5,6 +5,6 @@ import Dodge.Data import Picture drawBul :: Particle -> Picture -drawBul pt = setLayer 1 . setDepth 20 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt) +drawBul pt = setLayer 1 . setDepth 20 . color thecolor $ thickLine (take 3 $ _btTrail' pt) (_btWidth' pt) where thecolor = _btColor' pt diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index 7f3ec1b4c..2275669c8 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -7,6 +7,7 @@ import Geometry import Picture import Control.Lens +import Data.Bifunctor aGenBulAt :: Maybe Int -- ^ Pass-through creature id @@ -26,6 +27,27 @@ aGenBulAt maycid pos vel hiteff width = Bul' , _btTimer' = 100 , _btHitEffect' = hiteff } +aDelayedBulAt + :: Float -- ^ Start velocity step factor + -> Maybe Int -- ^ Pass-through creature id + -> Point2 -- ^ Start position + -> Point2 -- ^ Velocity + -> HitEffect + -> Float -- ^ Bullet width + -> Particle +aDelayedBulAt vfact maycid pos vel hiteff width = Bul' + { _ptDraw = drawBul + , _ptUpdate' = \w -> resetVel . mvGenBullet w + , _btVel' = vfact *.* vel + , _btColor' = V4 2 2 2 2 + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = width + , _btTimer' = 100 + , _btHitEffect' = hiteff + } + where + resetVel = second $ fmap $ (ptUpdate' .~ mvGenBullet) . (btVel' .~ vel) aCurveBulAt :: Maybe Int -- ^ Pass-through creature id diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index a630191cf..0f4872a26 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -17,6 +17,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Set as S import Control.Lens import SDL (MouseButton (..)) +--import Data.Bifunctor hudDrawings :: World -> Picture hudDrawings w = pictures @@ -104,18 +105,29 @@ displayMidList w strs s = invHead :: World -> String -> Picture invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s +renderItemMapAt :: Float -> Float -> IM.IntMap Item -> World -> Picture +{-# INLINE renderItemMapAt #-} +renderItemMapAt tx ty scols w = + --concatMapPic (winScale w) $ IM.mapWithKey (listItemAt tx ty w) scols + --concatMapPic (winScale w . uncurry (listItemAt tx ty w)) $ IM.toList scols + concatMapPic (uncurry $ listItemAt' tx ty w) $ IM.toList scols + +--renderPairListAt :: Float -> Float -> [(Int,(String,Color))] -> World -> Picture +--renderPairListAt tx ty scols w = +-- concatMapPic (winScale w) $ map (uncurry $ listPairAt tx ty w) scols + renderListAt :: Float -> Float -> [(String,Color)] -> World -> Picture renderListAt tx ty scols w = - concatMapPic (winScale w) $ zipWith (listItemAt tx ty w) [0..] scols + concatMapPic (winScale w) $ zipWith (listPairAt tx ty w) [0..] scols displayInv :: Int -> World -> Picture -displayInv n w = renderListAt 0 0 scols w +displayInv n w = renderItemMapAt 0 0 items w where - scols = map itemStringCol . IM.elems . _crInv $ _creatures w IM.! n + items = _crInv $ _creatures w IM.! n -itemStringCol :: Item -> (String,Color) -itemStringCol NoItem = ("----", greyN 0.5) -itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm) +--itemStringCol :: Item -> (String,Color) +--itemStringCol NoItem = ("----", greyN 0.5) +--itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm) drawLocations :: World -> Picture drawLocations wrld = pictures $ @@ -191,14 +203,41 @@ dShadCol c p = pictures mainListCursor :: Color -> Int -> World -> Picture mainListCursor c = openCursorAt 120 c 5 0 -listItemAt +listItemAt' + :: Float -- ^ x offset + -> Float -- ^ y offset + -> World + -> Int -- ^ y offset (discrete) + -> Item -- ^ The item + -> Picture +{-# INLINE listItemAt' #-} +listItemAt' xoff yoff w yint item = winScale w . translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1))) + . scale 0.1 0.1 + . dShadCol col + $ text s + where + (s,col) = case item of + NoItem -> ("----", greyN 0.5) + _ -> (_itInvDisplay item item , _itInvColor item) + +--listItemAt +-- :: Float -- ^ x offset +-- -> Float -- ^ y offset +-- -> World +-- -> Int -- ^ y offset (discrete) +-- -> Item -- ^ The item +-- -> Picture +--{-# INLINE listItemAt #-} +--listItemAt xoff yoff w yint = listPairAt xoff yoff w yint . itemStringCol +listPairAt :: Float -- ^ x offset -> Float -- ^ y offset -> World -> Int -- ^ y offset (discrete) -> (String,Color) -- ^ The text item -> Picture -listItemAt xoff yoff w yint (s,col) +{-# INLINE listPairAt #-} +listPairAt xoff yoff w yint (s,col) = translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1))) . scale 0.1 0.1 . dShadCol col diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index dcbc20157..5d22d3d7a 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -219,9 +219,14 @@ wallsAndWindows w wallsToList :: [((Point2,Point2),Point4)] -> [Float] wallsToList = concatMap (\((V2 a b,V2 c d),V4 e f g h) -> [a,b,c,d,e,f,g,h]) - lightsForGloom :: World -> [(Point3,Float,Point3)] -lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w) +lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w) where - getLS ls = ( _lsPos ls, _lsRad ls , _lsIntensity ls) - getTLS ls = ( _tlsPos ls, _tlsRad ls, _tlsIntensity ls) + getLS ls + | dist campos (fst2 $ _lsPos ls) > 1000 = Nothing + | otherwise = Just ( _lsPos ls, _lsRad ls , _lsIntensity ls) + getTLS ls + | dist campos (fst2 $ _tlsPos ls) > 1000 = Nothing + | otherwise = Just ( _tlsPos ls, _tlsRad ls, _tlsIntensity ls) + campos = _cameraCenter w + fst2 (V3 a b _) = V2 a b diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index e23bbbc52..20c75cdb6 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -70,7 +70,7 @@ makeExplosionAt p w = soundOncePos grenadeBang p . addFlames . explosionFlashAt p - $ makeShockwaveAt [] p 50 10 1 white w + $ makeShockwaveAt [] p 50 50 1 white w where fVs = replicateM 15 (randInCirc 1) & evalState $ _randGen w fPs'' = replicateM 15 (fmap (15 *.*.*) randInHemisphere) & evalState $ _randGen w diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 692d49aaf..470e9c35a 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -378,8 +378,7 @@ crsLightChain p d wlAttract w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) - where (dChange, g) = randomR (-0.05,0.05) $ _randGen w - + where (dChange, g) = randomR (-0.5,0.5) $ _randGen w {- Finds whether a creature or wall is in front of a given point and direction. Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'. diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs index 8e8bc46e5..d3affd705 100644 --- a/src/Geometry/Vector.hs +++ b/src/Geometry/Vector.hs @@ -91,7 +91,9 @@ radToDeg r = r * 180 / pi -- | Normalize an angle to be between 0 and 2*pi radians normalizeAngle :: Float -> Float {-# INLINE normalizeAngle #-} -normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi)) +normalizeAngle f + | f >= 0 && f < 2*pi = f + | otherwise = f - 2 * pi * floor' (f / (2 * pi)) where floor' :: Float -> Float floor' x = fromIntegral (floor x :: Int) @@ -126,3 +128,18 @@ projV fromv onv dist :: Point2 -> Point2 -> Float {-# INLINE dist #-} dist !p1 !p2 = magV (p2 -.- p1) +-- | Finds a new angle a given fraction between two other angles +tweenAngles + :: Float + -> Float + -> Float + -> Float +{-# INLINE tweenAngles #-} +tweenAngles frac a1 a2 + | abs (a1 - a2) < pi = frac * (a1 - a2) + a2 + | otherwise = normalizeAngle $ go frac a1 a2 + where + go frac' a1' a2' + | abs (a1' - a2') < pi = frac' * (a1' - a2') + a2' + | a1' > a2' = go frac' (a1' - 2*pi) a2' + | otherwise = go frac' a1' (a2' - 2*pi)