From 346c426b4301f8b94e70c79aab5152d91ae94f48 Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 27 May 2021 02:50:33 +0200 Subject: [PATCH] Refactor, add bullet modules and weapon effect modifiers --- src/Dodge/Combine.hs | 35 +++++++ src/Dodge/Combine/Data.hs | 34 ++++++ src/Dodge/Creature.hs | 3 +- src/Dodge/Creature/Action/UseItem.hs | 2 +- src/Dodge/Data.hs | 17 ++- src/Dodge/Default/Weapon.hs | 4 +- src/Dodge/Event.hs | 22 +++- src/Dodge/Event/Keyboard.hs | 18 ++-- src/Dodge/Item/Weapon.hs | 150 ++++++++++++++------------- src/Dodge/Item/Weapon/Launcher.hs | 106 ++++++++++++------- src/Dodge/Item/Weapon/Shell.hs | 27 +++++ src/Dodge/Item/Weapon/TriggerType.hs | 63 ++++++++++- src/Dodge/Render/HUD.hs | 58 ++++++++--- 13 files changed, 395 insertions(+), 144 deletions(-) create mode 100644 src/Dodge/Combine.hs create mode 100644 src/Dodge/Combine/Data.hs create mode 100644 src/Dodge/Item/Weapon/Shell.hs diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs new file mode 100644 index 000000000..1820cb0fd --- /dev/null +++ b/src/Dodge/Combine.hs @@ -0,0 +1,35 @@ +module Dodge.Combine + where +--import Dodge.Data +import Dodge.Combine.Data + +--import qualified Data.IntMap.Strict as IM +--import qualified Data.IntSet as IS +import qualified Data.Map.Strict as M + +--combineList :: IM.IntMap Item -> [(Item , IS.IntSet)] +--combineList + + +invert :: (Ord a) => M.Map b a -> M.Map a [b] +invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty + +combineList :: [([ItemType], ItemType)] +combineList = + [ ( [ Pistol, Pipe, Hardware ] , Rifle ) + , ( [ Rifle, Hardware ] , Pistol ) + , ( [ Pistol, Pistol, Hardware ] , SpreadGun 2 ) + , ( [ SpreadGun 2, Pistol, Hardware ] , SpreadGun 3 ) + , ( [ SpreadGun 3, Pistol, Hardware ] , SpreadGun 4 ) + , ( [ SpreadGun 4, Pistol, Hardware ] , SpreadGun 5 ) + , ( [ Pistol, AutoGun, Hardware ] , LtAutoGun ) + , ( [ LtAutoGun, Pipe, Hardware ] , AutoGun ) + , ( [ Rifle, Rifle, Hardware ] , MultGun 2 ) + , ( [ MultGun 2, Rifle, Hardware ] , MultGun 3 ) + , ( [ MultGun 3, Rifle, Hardware ] , MultGun 4 ) + , ( [ MultGun 4, Rifle, Hardware ] , MultGun 5 ) + , ( [ LtAutoGun, Pipe, Hardware ] , AutoGun ) + , ( [ Pistol, BigTube, Hardware] , Launcher 1 ) + , ( [ Launcher 1, BigTube, Pistol, Hardware] , Launcher 2) + , ( [ Launcher 2, BigTube, Pistol, Hardware] , Launcher 3) + ] diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs new file mode 100644 index 000000000..f4e14208d --- /dev/null +++ b/src/Dodge/Combine/Data.hs @@ -0,0 +1,34 @@ +module Dodge.Combine.Data + where +data ItemType + = Pipe + | BigTube + | Plate + | MChip + | Magnet + | Motor + | LED + | Hardware + | Nailbox + | Plank + | Prism + | LightSensor + | SoundSensor + | HeatSensor + | CopperWire + | EmptyCan + | Pistol + | AutoGun + | Rifle + | LtAutoGun + | HvAutoGun + | HvRifle + | MultGun Int + | SpreadGun Int + | Launcher Int + | Battery + | PortableFusion + | AutoFiringMech + | FiringMech + | TargetingModule + deriving (Eq,Ord) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 36279d8f5..1e11a87b6 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -157,7 +157,8 @@ startCr = defaultCreature startInventory :: IM.IntMap Item startInventory = IM.fromList (zip [0..20] ( - [blinkGun + [hvAutoGun + ,blinkGun ,miniGun ,bezierGun ,multGun diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs index 95314730d..c45e1b969 100644 --- a/src/Dodge/Creature/Action/UseItem.hs +++ b/src/Dodge/Creature/Action/UseItem.hs @@ -32,7 +32,7 @@ itemEffect -> World -> World itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w) -itemEffect cr it@Weapon{_itUse=eff} w = eff it cr w +itemEffect cr it@Weapon{_itUse=eff} w = foldr ($) eff (_itUseModifiers it) it cr w itemEffect cr it@Throwable{_itUse = eff} w = eff it cr w itemEffect _ _ w = w diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index a41f244bb..5a268fad8 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -194,8 +194,8 @@ data PressPlate = PressPlate } data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int} data ItemPos - = InInv { _itCrId :: Int , _itInvId :: Int } - | OnFloor { _itFlID :: Int } + = InInv { _itCrId :: Int , _itInvId :: Int } + | OnFloor { _itFlID :: Int } data Item = Weapon { _itName :: String @@ -207,6 +207,7 @@ data Item , _itUseRate :: Int , _itUseTime :: Int , _itUse :: Item -> Creature -> World -> World + , _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World] , _itLeftClickUse :: Maybe (Creature -> Int -> World -> World) , _wpSpread :: Float , _wpRange :: Float @@ -391,23 +392,30 @@ data Particle , _btMaxTime' :: Int , _btTimer' :: Int } -type HitEffect = Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World,Maybe Particle) +type HitEffect = Particle + -> [(Point2, Either3 Creature Wall ForceField)] + -> World + -> (World,Maybe Particle) data Ammo = ShellAmmo { _amPayload :: Point2 -> World -> World , _amString :: String - , _amPjMove :: [PjParam] + , _amPjParams :: [PjParam] , _amPjDraw :: Projectile -> Picture , _amParamSel :: Int } | BulletAmmo { _amString :: String + , _amBulEff :: HitEffect + , _amBulWth :: Float + , _amBulVel :: Point2 } | GenericAmmo data PjParam = PjParam { _pjMoveParam :: Int -> Item -> Creature -> Projectile -> World -> World , _pjIntParam :: Int + , _pjMaxParam :: Int , _pjDisplayParam :: Int -> String } data Projectile @@ -677,6 +685,7 @@ makeLenses ''ItEffect makeLenses ''ItZoom makeLenses ''FloorItem makeLenses ''Ammo +makeLenses ''PjParam makeLenses ''Projectile makeLenses ''Particle makeLenses ''Wall diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 2d3ab492d..56070c0ac 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -16,6 +16,7 @@ defaultGun = Weapon , _itUseRate = 8 , _itUseTime = 0 , _itUse = \_ _ -> id + , _itUseModifiers = [] , _itLeftClickUse = Nothing , _wpSpread = 0.02 , _wpRange = 20 @@ -37,6 +38,7 @@ defaultGun = Weapon , _itTargeting = Nothing , _itWorldTrigger = Nothing } + defaultAutoGun :: Item defaultAutoGun = defaultGun { _itScrollUp = const id @@ -48,7 +50,7 @@ defaultShellAmmo :: Ammo defaultShellAmmo = ShellAmmo { _amPayload = \_ -> id , _amString = "Shell" - , _amPjMove = [] + , _amPjParams = [] , _amPjDraw = \_ -> blank , _amParamSel = 0 } diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index f613711b6..16f1447b8 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -92,12 +92,16 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi) (_, TopInventory) | rbDown -> fromMaybe (closeObjScrollDir y w) $ (yourItem w ^? itScrollUp) - <*> pure (_crInvSel (you w)) - <*> pure w + <*> pure (_crInvSel (you w)) + <*> pure w | lbDown -> w & cameraZoom +~ y | invKeyDown -> swapInvDir yi $ dirInvPos yi w | otherwise -> dirInvPos yi w - (_, TweakInventory) -> w + (_, TweakInventory) + | invKeyDown && rbDown -> w & moveYourAmmoSel yi + | invKeyDown -> dirInvPos yi w + | rbDown -> w & moveYourAmmoParam yi + | otherwise -> w & moveYourAmmoSel yi (_, _) -> w where yi = round $ signum y @@ -106,6 +110,18 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of lbDown = ButtonLeft `S.member` _mouseButtons w invKeyDown = ScancodeCapsLock `S.member` _keys w +moveYourAmmoSel :: Int -> World -> World +moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of + Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) + . wpAmmo . amParamSel %~ (`mod` (length l)) . (subtract i) + _ -> w +moveYourAmmoParam :: Int -> World -> World +moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of + Just n -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) + . wpAmmo . amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i) + _ -> w + where + paramid = _amParamSel $ _wpAmmo $ yourItem w swapInvDir :: Int -> World -> World swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n) where diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 42000a222..a6d7dae0b 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -16,7 +16,7 @@ import Dodge.LightSources import Dodge.LevelGen import Dodge.Creature.Inanimate import qualified Data.IntMap.Strict as IM ---import Dodge.Event.Test +import Dodge.Event.Test import Dodge.Event.Menu import SDL @@ -51,13 +51,13 @@ handlePressedKeyInGame scode w | scode == dropItemKey (_keyConfig w) = Just $ youDropItem w | scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w --- | scode == testEventKey (_keyConfig w) = Just $ testEvent w + | scode == testEventKey (_keyConfig w) = Just $ testEvent w | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w | scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01 | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01 | scode == ScancodeF5 = Just $ dropLight w | scode == ScancodeF6 = Just $ dropLight' w - | scode == ScancodeT = Just $ w & inventoryMode %~ toggleInv TweakInventory + | scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory | scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory | scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory handlePressedKeyInGame _ w = Just w @@ -79,13 +79,11 @@ gotoTerminal w = case _menuLayers w of spaceAction :: World -> World spaceAction w = if _carteDisplay w - then - w & carteCenter .~ theLoc - else - case listToMaybe $ _closeActiveObjects w of - Just (Left flit) -> pickUpItem 0 flit w - Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w - Nothing -> w + then w & carteCenter .~ theLoc + else case (_inventoryMode w, listToMaybe $ _closeActiveObjects w) of + (TopInventory,Just (Left flit)) -> pickUpItem 0 flit w + (TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w + _ -> w & inventoryMode .~ TopInventory where theLoc = fst (_seenLocations w IM.! _selLocation w) w updateTopCloseObject i = closeActiveObjects %~ ( Right (_buttons w IM.! i) : ) . tail diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 3a875412d..a0208a947 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -18,6 +18,7 @@ import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect import Dodge.Item.Weapon.Laser +import Dodge.Item.Weapon.Shell import Dodge.Default.Weapon import Dodge.Item.Weapon.Booster import Dodge.Item.Weapon.Grenade @@ -43,23 +44,22 @@ import qualified Data.Set as S --import qualified Data.Map as M pistol :: Item -pistol = Weapon +pistol = defaultGun { _itName = "PISTOL" , _itIdentity = Pistol , _wpMaxAmmo = 15 , _wpLoadedAmmo = 15 - , _wpAmmo = GenericAmmo , _wpReloadTime = 40 , _wpReloadState = 0 , _itUseRate = 8 , _itUseTime = 0 - , _itUse = \_ -> - hammerCheck - . shootWithSound 0 - . withRandomDir 0.1 - . withMuzFlare - . withVelWthHiteff (30,0) 2 - $ destroyOnImpact bulHitCr bulHitWall' bulHitFF' + , _itUse = useAmmoParams + , _itUseModifiers = + [ hammerCheckI + , shootWithSoundI 0 + , withRandomDirI 0.1 + , withMuzFlareI + ] , _itLeftClickUse = Nothing , _wpSpread = 0.02 , _wpRange = 20 @@ -80,7 +80,20 @@ pistol = Weapon , _itInvColor = white , _itTargeting = Nothing , _itWorldTrigger = Nothing + , _wpAmmo = basicBullet } +basicBullet :: Ammo +basicBullet = BulletAmmo + { _amString = "BULLET" + , _amBulEff = destroyOnImpact bulHitCr bulHitWall' bulHitFF' + , _amBulWth = 2 + , _amBulVel = (30,0) + } +useAmmoParams :: Item -> Creature -> World -> World +useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b) + where + b = _wpAmmo it + effectGun :: String -> (Creature -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" @@ -118,6 +131,7 @@ autoGun = defaultGun , _itScrollUp = incCharMode , _itScrollDown = decCharMode , _itInvDisplay = basicWeaponDisplay + , _wpAmmo = basicBullet } autoFireMode, singleFireMode, autoGunNonTwistEff :: Creature -> World -> World autoFireMode = shootWithSound (fromIntegral autoGunSound) @@ -289,19 +303,25 @@ hvAutoGun = defaultAutoGun , _wpReloadState = 0 , _itUseRate = 25 , _itUseTime = 0 - , _itUse = \_ -> rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul + , _itUse = \it -> rateIncAB 24 10 (torqueBeforeForced 0.1 (mkHvBul it)) + (torqueAfter 0.2 (mkHvBul it)) , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) + , _wpAmmo = BulletAmmo + {_amString = "HVBULLET" + , _amBulEff = penWalls hvBulHitCr' hvBulHitWall' bulHitFF' + , _amBulWth = 6 + , _amBulVel = (80,0) + } } where - mkHvBul = withSound (fromIntegral longGunSound) + mkHvBul it = withSound (fromIntegral longGunSound) . withThinSmoke . withMuzFlare - . withVelWthHiteff (80,0) 6 - $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF' + $ useAmmoParams it ltAutoGun :: Item ltAutoGun = defaultAutoGun { _itName = "AUTO-LT" @@ -337,11 +357,11 @@ miniGun = defaultAutoGun , _itUseRate = 2 , _itUseTime = 0 , _itUse = \_ -> withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15 - . withRandomDir 0.1 - . withRandomOffset 9 - . withMuzFlare - . withVelWthHiteff (30,0) 2 - $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF' + . withRandomDir 0.1 + . withRandomOffset 9 + . withMuzFlare + . withVelWthHiteff (30,0) 2 + $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF' , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5) , _itAimingSpeed = 0.4 @@ -529,6 +549,16 @@ aTeslaArc' cr w (sideOffset,g) = randomR (-5,5) $ _randGen w dir = _crDir cr +remoteShellPic' :: Projectile -> Picture +remoteShellPic' pj + | t > 40 = onLayerL [levLayer CrLayer - 2] + $ uncurry translate pos $ rotate dir $ remoteShellPic t + | otherwise = uncurry translate pos $ rotate dir $ remoteShellPic t + where + t = _pjTimer pj + pos = _pjPos pj + dir = _pjDir pj + remoteShellPic :: Int -- ^ Timer -> Picture @@ -735,13 +765,18 @@ fireRemoteLauncher cr w = setLocation cid = _crID cr dir = _crDir cr pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - remRocket = IM.insert i $ Projectile + remRocket = IM.insert i $ Shell { _pjPos = pos , _pjStartPos = pos , _pjVel = rotateV dir (1,0) - , _pjDraw = \_ -> blank + , _pjDraw = remoteShellPic' , _pjID = i - , _pjUpdate = \_ -> moveRemoteShell 50 i cid itid dir + , _pjUpdate = \pj -> decTimMvVel pj . moveRemoteShell cid itid pj + , _pjAcc = (0,0) + , _pjDir = dir + , _pjSpin = 0 + , _pjPayload = makeExplosionAt + , _pjTimer = 50 } j = _crInvSel cr newitid = IM.newKey $ _itemPositions w @@ -756,69 +791,44 @@ fireRemoteLauncher cr w = setLocation _ -> w' itid = fromMaybe newitid maybeitid -moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World -moveRemoteShell time i cid itid _ w +moveRemoteShell :: Int -> Int -> Projectile -> World -> World +moveRemoteShell cid itid pj w | time > 40 = if circOnSomeWall oldPos 4 w - then doExplosion w - else over (projectiles . ix i . pjPos) (+.+ vel) - $ set (projectiles . ix i . pjDraw) (\_ -> piclow) - $ set (projectiles . ix i . pjUpdate) - (\_ -> moveRemoteShell (time-1) i cid itid newdir) - $ setScope - w + then doExplosion w + else w & setScope | time >= 20 = case thingHit of Just _ -> doExplosion w - Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) - $ set (projectiles . ix i . pjDraw) (\_ -> pic) - $ set (projectiles . ix i . pjUpdate) - (\_ -> moveRemoteShell (time-1) i cid itid newdir) - $ setScope - w + Nothing -> setScope w & projectiles . ix i . pjDir .~ newdir | time > -99 = case thingHit of - Just _ -> doExplosion - $ stopSoundFrom (ShellSound i) - w - Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) - $ set randGen g - $ set (projectiles . ix i . pjDraw) (\_ -> pic) - $ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir) - $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) - $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 - $ smokeGen - $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 - $ setScope - w + Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w + Nothing -> w & set randGen g + & projectiles . ix i %~ + ( ( pjVel %~ ( (accel +.+) . (frict *.*) ) ) + . ( pjDir .~ newdir ) + ) + & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 + & smokeGen + & makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + & setScope | time > -200 = case thingHit of - Just _ -> doExplosion - $ stopSoundFrom (ShellSound i) - w - Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) - $ set (projectiles . ix i . pjDraw) (\_ -> pic) - $ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir) - $ setScope - w - | otherwise = doExplosion - $ stopSoundFrom (ShellSound i) - w + Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w + Nothing -> setScope w + | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w where - pj = _projectiles w IM.! i - oldPos = _pjPos pj - vel = _pjVel pj - newPos = oldPos +.+ vel + time = _pjTimer pj + i = _pjID pj + oldPos = _pjPos pj + vel = _pjVel pj + newPos = oldPos +.+ vel newdir | SDL.ButtonRight `S.member` _mouseButtons w && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId = _cameraRot w + argV (_mousePos w) | otherwise = dir accel = rotateV newdir (2,0) - (frict,g) = randomR (0.6,0.9) $ _randGen w + (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w dir = argV vel - pic = uncurry translate newPos - $ rotate (argV accel) $ remoteShellPic time - piclow = onLayerL [levLayer CrLayer - 2] - $ uncurry translate newPos $ rotate (argV accel) - $ remoteShellPic time hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index c4ebf7ace..45ec75887 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -1,21 +1,22 @@ module Dodge.Item.Weapon.Launcher where import Dodge.Data -import Dodge.Item.Weapon.TriggerType import Dodge.Default.Weapon +import Dodge.Default.Shell import Dodge.SoundLogic.Synonyms -import Picture -import qualified IntMapHelp as IM import Dodge.WorldEvent.Explosion import Dodge.Picture.Layer import Dodge.Item.Draw -import Geometry -import Dodge.Default.Shell +import Dodge.Item.Weapon.Shell +import Dodge.Item.Weapon.TriggerType import Dodge.Base import Dodge.SoundLogic import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Cloud import Dodge.RandomHelp +import Geometry +import Picture +import qualified IntMapHelp as IM import Data.Maybe import Control.Lens @@ -45,7 +46,7 @@ launcher = defaultGun , _wpAmmo = defaultShellAmmo { _amPayload = makeExplosionAt , _amString = "" - , _amPjMove = basicAmPjMoves + , _amPjParams = basicAmPjMoves , _amPjDraw = shellPic } } @@ -54,19 +55,58 @@ basicAmPjMoves :: [PjParam] basicAmPjMoves = [spinDrag ,spinStart + ,thrustParam ] spinDrag :: PjParam spinDrag = PjParam - { _pjMoveParam = \_ _ _ -> reduceSpinBy 0.995 - , _pjIntParam = 0 - , _pjDisplayParam = ("SPIN DRAG:" ++ ) . show + { _pjMoveParam = \i _ _ -> reduceSpinBy (1 - (fromIntegral i)*2 / 200) + , _pjIntParam = 1 + , _pjDisplayParam = pjPadText "SPIN SLOWDOWN" . show + , _pjMaxParam = 5 } +pjPadText :: String -> String -> String +pjPadText s = (rightPad 12 ' ' s ++ ) . (' ':) spinStart :: PjParam spinStart = PjParam - { _pjMoveParam = \_ _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr) - , _pjIntParam = 0 - , _pjDisplayParam = ("SPIN START:" ++ ) . show + { _pjMoveParam = \i _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr) i + , _pjIntParam = 2 + , _pjDisplayParam = pjPadText "SPIN AMOUNT" . show + , _pjMaxParam = 5 } +thrustParam :: PjParam +thrustParam = PjParam + { _pjMoveParam = \i _ _ -> pjThrust i + , _pjIntParam = 1 + , _pjDisplayParam = pjPadText "THRUST DELAY" . show + , _pjMaxParam = 5 + } + +pjThrust :: Int -> Projectile -> World -> World +pjThrust i = pjEffTimeRange (st,et) $ doThrust + where + et | i == 0 = 36 + | otherwise = 40 - (fromIntegral i * 20) + st = et - 100 + +doThrust :: Projectile -> World -> World +doThrust pj w = w + & randGen .~ g + & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) + & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 + & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 + & smokeGen + where + accel = _pjAcc pj + i = _pjID pj + oldPos = _pjPos pj + vel = _pjVel pj + newPos = oldPos +.+ vel + (frict,g) = randomR (0.6,0.9) $ _randGen w + (sparkD,_) = randomR (-0.2,0.2) $ _randGen w + r1 = randInCirc 10 & evalState $ _randGen w + smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) + + flameLauncher :: Item flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt @@ -86,7 +126,7 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w i = IM.newKey $ _projectiles w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr - ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjMove am) + ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjParams am) theShell = defaultShell { _pjPos = pos , _pjStartPos = pos @@ -108,18 +148,10 @@ moveShell pj w then doExplode else w | isJust thingHit = doExplode - | time >= 20 = w - | time > -99 = w - & randGen .~ g - & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) - & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 - & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 - & smokeGen - | time > -200 = w + | time > -300 = w | otherwise = doExplode where time = _pjTimer pj - accel = _pjAcc pj doExplode = w & projectileExplosion oldPos & stopSoundFrom (ShellSound i) @@ -129,13 +161,9 @@ moveShell pj w vel = _pjVel pj projectileExplosion = _pjPayload pj newPos = oldPos +.+ vel - (frict,g) = randomR (0.6,0.9) $ _randGen w - (sparkD,_) = randomR (-0.2,0.2) $ _randGen w hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl - r1 = randInCirc 10 & evalState $ _randGen w - smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) reduceSpinBy :: Float -> Projectile -> World -> World reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x @@ -151,16 +179,18 @@ shellPic pj pos = _pjPos pj t = _pjTimer pj -decTimMvVel :: Projectile -> World -> World -decTimMvVel pj = projectiles . ix pjid %~ - ( (pjTimer -~ 1) - . (pjPos %~ (+.+ vel) ) - . (pjAcc %~ rotateV rot ) - ) + +pjEffTimeRange + :: (Int,Int) + -> (Projectile -> World -> World) + -> Projectile + -> World + -> World +pjEffTimeRange (st,et) f pj + | t <= et && t >= st = f pj + | otherwise = id where - rot = _pjSpin pj - vel = _pjVel pj - pjid = _pjID pj + t = _pjTimer pj pjEffAtTime :: Int @@ -174,13 +204,15 @@ pjEffAtTime t f pj trySpinByCID :: Int -- ^ creature id + -> Int -- ^ Spin amount -> Projectile -> World -> World -trySpinByCID cid pj w = w & projectiles . ix pjid . pjSpin .~ newSpin +trySpinByCID cid i pj w = w & projectiles . ix pjid . pjSpin .~ newSpin where pjid = _pjID pj dir = argV $ _pjVel pj newSpin = case w ^? creatures . ix cid of - Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 + Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor _ -> 0 + spinFactor = 5 * (6 - fromIntegral i) diff --git a/src/Dodge/Item/Weapon/Shell.hs b/src/Dodge/Item/Weapon/Shell.hs new file mode 100644 index 000000000..8908ffced --- /dev/null +++ b/src/Dodge/Item/Weapon/Shell.hs @@ -0,0 +1,27 @@ +module Dodge.Item.Weapon.Shell + where +import Dodge.Data +import Geometry.Vector + +import Control.Lens +decTimMvVel :: Projectile -> World -> World +decTimMvVel pj = projectiles . ix pjid %~ + ( (pjTimer -~ 1) + . (pjPos %~ (+.+ vel) ) + . (pjAcc %~ rotateV rot ) + ) + where + rot = _pjSpin pj + vel = _pjVel pj + pjid = _pjID pj + +--pjAutoSpin :: Projectile -> World -> World +--pjAutoSpin pj = projectiles . ix pjid %~ +-- ( (pjDir -~ 1) +-- . (pjPos %~ (+.+ vel) ) +-- . (pjAcc %~ rotateV rot ) +-- ) +-- where +-- rot = _pjSpin pj +-- vel = _pjVel pj +-- pjid = _pjID pj diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index c94740e83..71d2cc12e 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -153,8 +153,7 @@ withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w cid = _crID cr push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w -{- | -Applies a world effect and sound effect after an ammo check. -} +{- | Applies a world effect and sound effect after an ammo check. -} shootWithSound :: Int -- ^ Sound identifier -> (Creature -> World -> World) @@ -178,6 +177,30 @@ shootWithSound soundid f cr w && _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 {- | Applies a world effect after an item use cooldown check. -} useTimeCheck @@ -205,6 +228,19 @@ hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of where cid = _crID cr setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown +{- | Applies a world effect after a hammer position check. -} +hammerCheckI + :: (Item -> Creature -> World -> World) -- ^ Underlying effect + -> Item + -> Creature + -> World + -> World +hammerCheckI f it cr w = case it ^? itHammer of + Just HammerUp -> f it cr $ setHammerDown w + _ -> setHammerDown w + where + cid = _crID cr + setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown {- | Applies a world effect after an ammo check. -} shoot :: (Creature -> World -> World) @@ -272,6 +308,17 @@ withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w where pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) + +withMuzFlareI + :: (Item -> Creature -> World -> World) -- ^ Underlying effect + -> Item + -> Creature + -> World + -> World +withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w + where + pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) + pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) {- | Applies the effect to a randomly rotated creature. -} withRandomDir :: Float -- ^ Max possible rotation @@ -283,6 +330,18 @@ withRandomDir withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w where (a, g) = randomR (-acc,acc) $ _randGen w +{- | Applies the effect to a randomly rotated creature. -} +withRandomDirI + :: Float -- ^ Max possible rotation + -> (Item -> Creature -> World -> World) + -- ^ Underlying effect + -> Item + -> Creature + -> World + -> World +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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index df376d38b..be794319f 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -35,10 +35,11 @@ drawInventory w = case _inventoryMode w of ++ displayInv 0 w TweakInventory -> mCurs it w - ++ [cursorAt 120 col 5 iPos w] + ++ [cursorAt 120 col 5 0 iPos w + ,cursorsZ w iPos it + ] ++ displayInv 0 w ++ displayMidList w (ammoTweakStrings it) "TWEAK" - ++ mCurs it w CombineInventory -> displayInv 0 w ++ invHead w "COMBINE" InspectInventory -> displayInv 0 w ++ invHead w "INSPECT" where @@ -47,22 +48,47 @@ drawInventory w = case _inventoryMode w of it = yourItem w col = itCol it +cursorsZ :: World -> Int -> Item -> Picture +cursorsZ w ipos it = case it ^? wpAmmo . amParamSel of + Nothing -> winScale w $ zDraw sp (155- hw, hh - 77.5) + Just jpos -> winScale w $ zDraw sp (155 - hw, hh - (20 * fromIntegral jpos + 77.5)) + where + hh = halfHeight w + hw = halfWidth w + sp = (125 - hw, hh - (20 * fromIntegral ipos + 17.5)) + topInvCursor :: Color -> Int -> World -> [Picture] topInvCursor col iPos w | ButtonRight `S.member` _mouseButtons w = - [cursorAt 100 col 5 iPos w - ,openCursorAt 20 col 105 iPos w] - | otherwise = [ openCursorAt 120 col 5 iPos w ] + [cursorAt 100 col 5 0 iPos w + ,openCursorAt 20 col 105 0 iPos w] + | otherwise = [ openCursorAt 120 col 5 0 iPos w ] ammoTweakStrings :: Item -> [String] -ammoTweakStrings it = case it ^? wpAmmo . amPjMove of +ammoTweakStrings it = case it ^? wpAmmo . amPjParams of Just l -> map pjTweakString l _ -> ["NOT TWEAKABLE"] mCurs :: Item -> World -> [Picture] mCurs it w = case it ^? wpAmmo . amParamSel of Nothing -> [] - Just i -> [openCursorAt 120 white 200 i w] + Just i + | ButtonRight `S.member` _mouseButtons w -> + [cursorAt x white y 60 i w + ,openCursorAt 20 white (x+y) 60 i w + ] + | otherwise -> [openCursorAt 140 white 155 60 i w] + where + x = 117.5 + y = 155 + +zDraw :: Point2 -> Point2 -> Picture +zDraw (x,y) (a,b) = line + [(x,y) + ,(0.5 * (x+a), y) + ,(0.5 * (x+a), b) + ,(a, b) + ] pjTweakString :: PjParam -> String pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj @@ -70,11 +96,11 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj displayMidList :: World -> [String] -> String -> [Picture] displayMidList w strs s = invHead w s - ++ renderListAt (200,0) (map (,white) strs) w + ++ renderListAt (150,-60) (map (,white) strs) w invHead :: World -> String -> [Picture] -invHead w s = [winScale w . translate (-150) (150-halfHeight w) - . dShadCol white . scale 0.5 0.5 $ text s +invHead w s = [winScale w . translate (-130) (halfHeight w - 40) + . dShadCol white . scale 0.4 0.4 $ text s ] displayListTopLeft :: [(String,Color)] -> World -> [Picture] @@ -200,17 +226,18 @@ dShadCol c p = pictures ] drawListCursor :: Color -> Int -> World -> Picture -drawListCursor c = openCursorAt 120 c 5 +drawListCursor c = openCursorAt 120 c 5 0 openCursorAt :: Float -- ^ Width -> Color -> Float -- ^ x offset + -> Float -- ^ y offset -> Int -- ^ y offset (discrete) -> World -> Picture -openCursorAt wth col xoff yint w = winScale w - . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20) +openCursorAt wth col xoff yoff yint w = winScale w + . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20) $ lineCol [(( wth,12.5) ,withAlpha 0 col) ,(( 0,12.5) ,col) @@ -221,11 +248,12 @@ cursorAt :: Float -- ^ Width -> Color -> Float -- ^ x offset + -> Float -- ^ y offset -> Int -- ^ y offset (discrete) -> World -> Picture -cursorAt wth col xoff yint w = winScale w - . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20) +cursorAt wth col xoff yoff yint w = winScale w + . translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20) . color col $ line [( wth,12.5)