diff --git a/src/Dodge/Config/KeyConfig.hs b/src/Dodge/Config/KeyConfig.hs index 41df8cd83..7a339cbc7 100644 --- a/src/Dodge/Config/KeyConfig.hs +++ b/src/Dodge/Config/KeyConfig.hs @@ -31,44 +31,46 @@ data KeyConfig = KeyConfig deriving (Generic, Show) data KeyConfigSDL = KeyConfigSDL - { moveUpKey :: SDL.Scancode, - moveDownKey :: SDL.Scancode, - moveLeftKey :: SDL.Scancode, - moveRightKey :: SDL.Scancode, - pauseKey :: SDL.Scancode, - escapeKey :: SDL.Scancode, - dropItemKey :: SDL.Scancode, - toggleMapKey :: SDL.Scancode, - reloadKey :: SDL.Scancode, - testEventKey :: SDL.Scancode, - spaceActionKey :: SDL.Scancode, - rotateCameraPlusKey :: SDL.Scancode, - rotateCameraMinusKey :: SDL.Scancode, - zoomInKey :: SDL.Scancode, - zoomOutKey :: SDL.Scancode, - newMapKey :: SDL.Scancode + { moveUpKey :: SDL.Scancode + , moveDownKey :: SDL.Scancode + , moveLeftKey :: SDL.Scancode + , moveRightKey :: SDL.Scancode + , pauseKey :: SDL.Scancode + , escapeKey :: SDL.Scancode + , dropItemKey :: SDL.Scancode + , toggleMapKey :: SDL.Scancode + , reloadKey :: SDL.Scancode + , testEventKey :: SDL.Scancode + , spaceActionKey :: SDL.Scancode + , rotateCameraPlusKey :: SDL.Scancode + , rotateCameraMinusKey :: SDL.Scancode + , zoomInKey :: SDL.Scancode + , zoomOutKey :: SDL.Scancode + , newMapKey :: SDL.Scancode + , modifierKey :: SDL.Scancode } deriving (Generic, Show) defaultKeyConfigSDL :: KeyConfigSDL defaultKeyConfigSDL = KeyConfigSDL - { moveUpKey = SDL.ScancodeW, - moveDownKey = SDL.ScancodeS, - moveLeftKey = SDL.ScancodeA, - moveRightKey = SDL.ScancodeD, - pauseKey = SDL.ScancodeP, - escapeKey = SDL.ScancodeEscape, - dropItemKey = SDL.ScancodeF, - toggleMapKey = SDL.ScancodeM, - reloadKey = SDL.ScancodeR, - testEventKey = SDL.ScancodeT, - spaceActionKey = SDL.ScancodeSpace, - rotateCameraPlusKey = SDL.ScancodeQ, - rotateCameraMinusKey = SDL.ScancodeE, - zoomInKey = SDL.ScancodeJ, - zoomOutKey = SDL.ScancodeK, - newMapKey = SDL.ScancodeN + { moveUpKey = SDL.ScancodeW + , moveDownKey = SDL.ScancodeS + , moveLeftKey = SDL.ScancodeA + , moveRightKey = SDL.ScancodeD + , pauseKey = SDL.ScancodeP + , escapeKey = SDL.ScancodeEscape + , dropItemKey = SDL.ScancodeF + , toggleMapKey = SDL.ScancodeM + , reloadKey = SDL.ScancodeR + , testEventKey = SDL.ScancodeT + , spaceActionKey = SDL.ScancodeSpace + , rotateCameraPlusKey = SDL.ScancodeQ + , rotateCameraMinusKey = SDL.ScancodeE + , zoomInKey = SDL.ScancodeJ + , zoomOutKey = SDL.ScancodeK + , newMapKey = SDL.ScancodeN + , modifierKey = SDL.ScancodeCapsLock } --instance ToJSON KeyConfig where diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 2083f1f6b..63ca01bf8 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -29,6 +29,7 @@ import Dodge.Creature.ArmourChase import Dodge.Data import Dodge.Default import Dodge.Item.Weapon +import Dodge.Item.Weapon.Launcher import Dodge.Item.Equipment import Dodge.Item.Consumable import Dodge.WorldEvent.Cloud diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 772352283..58658e7bc 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -14,7 +14,7 @@ import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State --import Dodge.Creature.State.Data -import Dodge.Item.Weapon +import Dodge.Item.Weapon.Launcher --import Dodge.Item.Consumable --import Geometry import Picture diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 6dc335915..ee6d11118 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -148,6 +148,7 @@ data Creature = Creature , _crMaxHP :: Int , _crInv :: IM.IntMap Item , _crInvSel :: Int + , _crLeftInvSel :: Maybe Int , _crState :: CreatureState , _crCorpse :: Picture , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature) @@ -193,6 +194,7 @@ data Item { _itName :: String , _wpMaxAmmo :: Int , _wpLoadedAmmo :: Int + , _wpAmmo :: Ammo , _wpReloadTime :: Int , _wpReloadState :: Int , _itUseRate :: Int @@ -381,6 +383,14 @@ data Particle , _btTimer' :: Int } type HitEffect = Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World,Maybe Particle) + +data Ammo + = ShellAmmo + { _amPayload :: Point2 -> World -> World + } + | BulletAmmo + { } + | GenericAmmo data Projectile = Projectile { _pjPos :: Point2 @@ -399,7 +409,7 @@ data Projectile , _pjDraw :: Projectile -> Picture , _pjID :: Int , _pjUpdate :: Projectile -> World -> World - , _pjPayload :: Point2-> World -> World + , _pjPayload :: Point2 -> World -> World } | LinearShockwave { _pjDraw :: Projectile -> Picture @@ -645,6 +655,7 @@ makeLenses ''ItemPos makeLenses ''ItEffect makeLenses ''ItZoom makeLenses ''FloorItem +makeLenses ''Ammo makeLenses ''Projectile makeLenses ''Particle makeLenses ''Wall diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 13094c1a9..03e1fe4a4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -88,6 +88,7 @@ defaultCreature = Creature , _crMaxHP = 150 , _crInv = IM.empty , _crInvSel = 0 + , _crLeftInvSel = Nothing , _crState = defaultState , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10 , _crApplyDamage = defaultApplyDamage diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs new file mode 100644 index 000000000..b2521fd3e --- /dev/null +++ b/src/Dodge/Default/Weapon.hs @@ -0,0 +1,37 @@ +module Dodge.Default.Weapon + where +import Dodge.Data +import Dodge.Item.Weapon.ExtraEffect +import Dodge.Item.Weapon.InventoryDisplay +import Picture +defaultGun :: Item +defaultGun = Weapon + { _itName = "default" + , _itIdentity = Pistol + , _wpMaxAmmo = 15 + , _wpLoadedAmmo = 15 + , _wpAmmo = GenericAmmo + , _wpReloadTime = 40 + , _wpReloadState = 0 + , _itUseRate = 8 + , _itUseTime = 0 + , _itUse = \_ -> id + , _itLeftClickUse = Nothing + , _wpSpread = 0.02 + , _wpRange = 20 + , _itHammer = HammerUp + , _itFloorPict = blank + , _itAmount = 1 + , _itMaxStack = 1 + , _itAimingSpeed = 1 + , _itAimingRange = 0 + , _itZoom = ItZoom 20 0.2 1 20 0.2 1 + , _itEquipPict = \_ _ -> blank + , _itScrollUp = const id + , _itScrollDown = const id + , _itAttachment = Nothing + , _itID = Nothing + , _itEffect = wpRecock + , _itInvDisplay = basicWeaponDisplay + , _itInvColor = white + } diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index f674c2075..c3b75a50c 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -23,6 +23,7 @@ import Dodge.Inventory import Dodge.Config.Data --import Geometry import Preload.Update +import qualified IntMapHelp as IM import Control.Lens import Data.Maybe @@ -30,7 +31,6 @@ import Data.Maybe --import Data.List --import Data.Function (on) import qualified Data.Set as S -import qualified Data.IntMap.Strict as IM import SDL handleEvent :: World -> Event -> Maybe World @@ -100,10 +100,12 @@ wheelUpEvent w = case _carteDisplay w of <*> pure (_crInvSel (you w)) <*> pure w | lbDown -> w & cameraZoom +~ 0.1 + | invKeyDown -> swapInvUp $ upInvPos w | otherwise -> upInvPos w where rbDown = ButtonRight `S.member` _mouseButtons w lbDown = ButtonLeft `S.member` _mouseButtons w + invKeyDown = ScancodeCapsLock `S.member` _keys w z = _carteZoom w numLocs = (fst . IM.findMax $ _seenLocations w) + 1 @@ -116,13 +118,21 @@ wheelDownEvent w = case _carteDisplay w of | rbDown -> fromMaybe (closeObjScrollDown w) $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w)) <*> pure w | lbDown -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01} + | invKeyDown -> downInvPos $ swapInvUp w | otherwise -> downInvPos w where rbDown = ButtonRight `S.member` _mouseButtons w lbDown = ButtonLeft `S.member` _mouseButtons w z = _carteZoom w + invKeyDown = ScancodeCapsLock `S.member` _keys w numLocs = (fst . IM.findMax $ _seenLocations w) + 1 +swapInvUp :: World -> World +swapInvUp w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + 1) `mod` n) + where + i = _crInvSel $ you w + n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w + upInvPos :: World -> World upInvPos w = stopSoundFrom (CrReloadSound 0) $ w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract 1 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index d146f5fbe..6fa650348 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -53,8 +53,8 @@ handlePressedKeyInGame scode w | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) 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 == 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 handlePressedKeyInGame _ w = Just w diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 7adc211b0..36bc11fb1 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -104,5 +104,3 @@ storeLevel :: World -> World storeLevel w = case _storedLevel w of Nothing -> w & storedLevel ?~ w _ -> w - - diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 032d9b13a..37ad797d7 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -32,7 +32,8 @@ import Dodge.Creature --import Dodge.LightSources import Dodge.LevelGen.Data --import Dodge.LevelGen.SwarmPlacement -import Dodge.Item.Weapon +--import Dodge.Item.Weapon +import Dodge.Item.Weapon.Launcher --import Data.Tree --import Data.Maybe (fromJust,isNothing) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 3ac035771..84883c2e4 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -10,7 +10,7 @@ import Dodge.Creature.Action import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.Default -import Dodge.Default.Shell +--import Dodge.Default.Shell import Dodge.Item.Draw import Dodge.Particle.Bullet.HitEffect import Dodge.Particle.Bullet.Spawn @@ -20,6 +20,7 @@ import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect import Dodge.Item.Weapon.Laser +import Dodge.Default.Weapon import Dodge.Item.Weapon.Booster import Dodge.Item.Weapon.Grenade import Dodge.Item.Attachment.Data @@ -49,6 +50,7 @@ pistol = Weapon , _itIdentity = Pistol , _wpMaxAmmo = 15 , _wpLoadedAmmo = 15 + , _wpAmmo = GenericAmmo , _wpReloadTime = 40 , _wpReloadState = 0 , _itUseRate = 8 @@ -79,8 +81,6 @@ pistol = Weapon , _itInvDisplay = basicWeaponDisplay , _itInvColor = white } -defaultGun :: Item -defaultGun = pistol defaultAutoGun :: Item defaultAutoGun = autoGun { _itScrollUp = const id @@ -259,44 +259,6 @@ tractorGun = defaultAutoGun , _itAimingRange = 0.5 , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] } -launcher :: Item -launcher = defaultGun - { _itName = "ROCKO" - , _itIdentity = Launcher - , _wpMaxAmmo = 30 - , _wpLoadedAmmo = 30 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 20 - , _itUseTime = 0 - , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt - , _wpSpread = 0.02 - , _wpRange = 20 - , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) - , _itAimingSpeed = 0.2 - , _itAimingRange = 0.5 - , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) - , _itHammer = NoHammer - , _itEffect = NoItEffect - } -flameLauncher :: Item -flameLauncher = launcher - { _itName = "FLROCKO" - , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt - } - -poisonLauncher :: Item -poisonLauncher = launcher - { _itName = "POISROCK" - , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt - } - -teslaLauncher :: Item -teslaLauncher = launcher - { _itName = "TESLROCK" - , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt - } - useTargetPos :: (Point2 -> Creature -> World -> World) -> Creature @@ -618,102 +580,6 @@ aTeslaArc' cr w (sideOffset,g) = randomR (-5,5) $ _randGen w dir = _crDir cr -aRocketWithPayload - :: (Point2 -> World -> World) -- ^ Payload - -> Creature - -> World - -> World -aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w - where - cid = _crID cr - i = newProjectileKey w - pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) - dir = _crDir cr - theShell = makeShellAt pl i cid pos dir - -makeShellAt - :: (Point2 -> World -> World) - -- ^ Payload - -> Int -- ^ Projectile id - -> Int -- ^ Creature id - -> Point2 -- ^ Start position - -> Float -- ^ Direction - -> Projectile -makeShellAt pl i cid pos dir = defaultShell - { _pjPos = pos - , _pjStartPos = pos - , _pjVel = rotateV dir (1,0) - , _pjDraw = \_ -> blank - , _pjID = i - , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0)) - , _pjPayload = pl - } - -moveShell - :: Int -- ^ Timer (frames) - -> Int -- ^ Projectile id - -> Int -- ^ Creature id - -> Float -- ^ Rotation - -> Point2 -- ^ Acceleration - -> World -> World -moveShell time i cid rot accel w - | time > 40 = if circOnSomeWall oldPos 4 w - then doExplode - else w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> piclow) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel)) - | isJust thingHit = doExplode - | time == 35 = w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel - | time >= 20 = w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) - | time > -99 = w - & projectiles . ix i . pjPos %~ (+.+ vel) - & randGen .~ g - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) - & 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 - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) - | otherwise = doExplode - where - doExplode = w - & projectileExplosion oldPos - & stopSoundFrom (ShellSound i) - & projectiles %~ IM.delete i - pj = _projectiles w IM.! i - oldPos = _pjPos pj - 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 - dir = argV vel - pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic - piclow = onLayerL [levLayer CrLayer - 2] - $ uncurry translate newPos $ rotate (argV accel) shellPic - hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w - hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) - thingHit = hitCr <|> hitWl - spin = case w ^? creatures . ix cid of - Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 - _ -> 0 - r1 = randInCirc 10 & evalState $ _randGen w - smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) - rot' = rot * 0.995 - -shellPic :: Picture -shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] remoteShellPic :: Int -- ^ Timer -> Picture diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index abf2f0a3e..9280dd0ab 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -32,62 +32,29 @@ boostSelfL -> World -> World boostSelfL x cr invid w = case boostPoint x cr w of - Left p -> wWithShock p - & creatures . ix cid %~ - ( (crPos .~ p) - . (crInv . ix invid %~ - (wpLoadedAmmo .~ 0) - . (itEffect . itEffectCounter .~ 1) - . (itAttachment .~ Just (ItInt pid)) - ) - ) - Right p -> wWithShock p & creatures . ix cid . crPos .~ p - & creatures . ix cid %~ - ( (crPos .~ p) - . (crInv . ix invid %~ - (wpLoadedAmmo -~ 1) - . (itEffect . itEffectCounter .~ 1) - . (itAttachment .~ Just (ItInt pid)) - ) - ) + Left p -> crEff p (wpLoadedAmmo .~ 0) + Right p -> crEff p (wpLoadedAmmo -~ 1) where cid = _crID cr - --cpos = _crPos cr + cpos = _crPos cr r = _crRad cr pid = fromMaybe (IM.newKey $ _projectiles w) (cr ^? crInv . ix invid . itAttachment . _Just . itInt) - wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w + crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w + & creatures . ix cid %~ + (crPos .~ p) + . (crInv . ix invid %~ + ammoEff + . (itEffect . itEffectCounter .~ 1) + . (itAttachment .~ Just (ItInt pid)) + ) boostSelf :: Float -- ^ boost amount -> Creature -> World -> World -boostSelf x cr w = case boostPoint x cr w of - Left p -> wWithShock p - & creatures . ix cid %~ - ( (crPos .~ p) - . (crInv . ix (_crInvSel cr) %~ - (wpLoadedAmmo .~ 0) - . (itEffect . itEffectCounter .~ 1) - . (itAttachment .~ Just (ItInt pid)) - ) - ) - Right p -> wWithShock p & creatures . ix cid . crPos .~ p - & creatures . ix cid %~ - ( (crPos .~ p) - . (crInv . ix (_crInvSel cr) %~ - (wpLoadedAmmo -~ 1) - . (itEffect . itEffectCounter .~ 1) - . (itAttachment .~ Just (ItInt pid)) - ) - ) - where - cid = _crID cr - r = _crRad cr - pid = fromMaybe (IM.newKey $ _projectiles w) - (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt) - wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w +boostSelf x cr = boostSelfL x cr (_crInvSel cr) addBoostShockwave :: Int diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs new file mode 100644 index 000000000..a1df19deb --- /dev/null +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -0,0 +1,159 @@ +module Dodge.Item.Weapon.Launcher + where +import Dodge.Data +import Dodge.Item.Weapon.TriggerType +import Dodge.Default.Weapon +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.Base +import Dodge.SoundLogic +import Dodge.WorldEvent.SpawnParticle +import Dodge.WorldEvent.Cloud +import Dodge.RandomHelp + +import Data.Maybe +import Control.Lens +import Control.Applicative +import Control.Monad.State +import System.Random + +launcher :: Item +launcher = defaultGun + { _itName = "ROCKO" + , _itIdentity = Launcher + , _wpMaxAmmo = 30 + , _wpLoadedAmmo = 30 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 20 + , _itUseTime = 0 + , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt + , _wpSpread = 0.02 + , _wpRange = 20 + , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) + , _itAimingSpeed = 0.2 + , _itAimingRange = 0.5 + , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) + , _itHammer = NoHammer + , _itEffect = NoItEffect + } +flameLauncher :: Item +flameLauncher = launcher + { _itName = "FLROCKO" + , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt + } + +poisonLauncher :: Item +poisonLauncher = launcher + { _itName = "POISROCK" + , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt + } + +teslaLauncher :: Item +teslaLauncher = launcher + { _itName = "TESLROCK" + , _itUse = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt + } + +aRocketWithPayload + :: (Point2 -> World -> World) -- ^ Payload + -> Creature + -> World + -> World +aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w + where + cid = _crID cr + i = IM.newKey $ _projectiles w + pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) + dir = _crDir cr + theShell = makeShellAt pl i cid pos dir + +makeShellAt + :: (Point2 -> World -> World) + -- ^ Payload + -> Int -- ^ Projectile id + -> Int -- ^ Creature id + -> Point2 -- ^ Start position + -> Float -- ^ Direction + -> Projectile +makeShellAt pl i cid pos dir = defaultShell + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjDraw = \_ -> blank + , _pjID = i + , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0)) + , _pjPayload = pl + } + +moveShell + :: Int -- ^ Timer (frames) + -> Int -- ^ Projectile id + -> Int -- ^ Creature id + -> Float -- ^ Rotation + -> Point2 -- ^ Acceleration + -> World -> World +moveShell time i cid rot accel w + | time > 40 = if circOnSomeWall oldPos 4 w + then doExplode + else w + & projectiles . ix i . pjPos %~ (+.+ vel) + & projectiles . ix i . pjDraw .~ (\_ -> piclow) + & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel)) + | isJust thingHit = doExplode + | time == 35 = w + & projectiles . ix i . pjPos %~ (+.+ vel) + & projectiles . ix i . pjDraw .~ (\_ -> pic) + & projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel + | time >= 20 = w + & projectiles . ix i . pjPos %~ (+.+ vel) + & projectiles . ix i . pjDraw .~ (\_ -> pic) + & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) + | time > -99 = w + & projectiles . ix i . pjPos %~ (+.+ vel) + & randGen .~ g + & projectiles . ix i . pjDraw .~ (\_ -> pic) + & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) + & 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 + & projectiles . ix i . pjPos %~ (+.+ vel) + & projectiles . ix i . pjDraw .~ (\_ -> pic) + & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) + | otherwise = doExplode + where + doExplode = w + & projectileExplosion oldPos + & stopSoundFrom (ShellSound i) + & projectiles %~ IM.delete i + pj = _projectiles w IM.! i + oldPos = _pjPos pj + 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 + dir = argV vel + pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic + piclow = onLayerL [levLayer CrLayer - 2] + $ uncurry translate newPos $ rotate (argV accel) shellPic + hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w + hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) + thingHit = hitCr <|> hitWl + spin = case w ^? creatures . ix cid of + Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 + _ -> 0 + r1 = randInCirc 10 & evalState $ _randGen w + smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) + rot' = rot * 0.995 + +shellPic :: Picture +shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 7e19cb0fc..76fd089bf 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -7,6 +7,7 @@ module Dodge.Room ) where import Dodge.Data import Dodge.Item.Weapon +import Dodge.Item.Weapon.Launcher import Dodge.Creature --import Dodge.Creature.Inanimate --import Dodge.LevelGen diff --git a/src/IntMapHelp.hs b/src/IntMapHelp.hs index 521326c84..e7328a041 100644 --- a/src/IntMapHelp.hs +++ b/src/IntMapHelp.hs @@ -3,6 +3,7 @@ module IntMapHelp , newKey , insertNewKey , insertWithNewKeys + , swapKeys ) where --import Data.List hiding (foldr,insert) @@ -19,3 +20,6 @@ insertNewKey x m = case lookupMax m of {- | Insert a list of values with new keys -} insertWithNewKeys :: [a] -> IntMap a -> IntMap a insertWithNewKeys xs m = union m $ fromList $ zip [newKey m..] xs +{- | Swaps two keys. Unsafe: assumes both keys exist. -} +swapKeys :: Int -> Int -> IntMap a -> IntMap a +swapKeys i j m = insert i (m ! j) $ insert j (m ! i) m