diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index b8338d60b..ad5bad811 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -27,7 +27,7 @@ combineList = map f . combineItemListYouX , _siHeight = itInvHeight itm , _siWidth = 15 , _siIsSelectable = True - , _siColor = itemInvColor $ basePCI itm + , _siColor = itemInvColor $ baseCI itm , _siOffX = 0 , _siPayload = CombinableItem is itm } diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index ea3589bc8..9f336dba7 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -241,11 +241,21 @@ inventoryX c = case c of [targetingScope tt | tt <- [minBound .. maxBound]] <> [ battery + , laser + , augmentedHUD , launcher , megaShellMag , homingModule , remoteScreen + , launcherX 3 + , megaShellMag + , homingModule + , megaShellMag + , homingModule + , megaShellMag + , homingModule ] + <> [shellModule p | p <- [minBound .. maxBound]] 'V' -> [targetingScope tt | tt <- [minBound .. maxBound]] <> diff --git a/src/Dodge/Data/EnergyBall.hs b/src/Dodge/Data/EnergyBall.hs index 1d0e10156..f5e2b892b 100644 --- a/src/Dodge/Data/EnergyBall.hs +++ b/src/Dodge/Data/EnergyBall.hs @@ -19,7 +19,6 @@ data EnergyBall = EnergyBall , _ebWidth :: Float , _ebTimer :: Int , _ebEff :: (DamageType, Int) --- , _ebZ :: Float , _ebRot :: Float } deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/Item/Combine.hs b/src/Dodge/Data/Item/Combine.hs index f4457a367..81311a866 100644 --- a/src/Dodge/Data/Item/Combine.hs +++ b/src/Dodge/Data/Item/Combine.hs @@ -5,6 +5,7 @@ module Dodge.Data.Item.Combine where +import Dodge.Data.Payload import Control.Lens import Data.Aeson import Data.Aeson.TH @@ -71,6 +72,7 @@ data AttachType | REMOTESCREEN | HOMINGMODULE | AUGMENTEDHUD + | SHELLPAYLOAD {_shellPayload :: Payload} deriving (Eq, Ord, Show, Read) data AmmoMagType diff --git a/src/Dodge/Data/Payload.hs b/src/Dodge/Data/Payload.hs index 63293e8ec..88e024aa3 100644 --- a/src/Dodge/Data/Payload.hs +++ b/src/Dodge/Data/Payload.hs @@ -8,7 +8,9 @@ module Dodge.Data.Payload where import Data.Aeson import Data.Aeson.TH -data Payload = ExplosionPayload | DudPayload +data Payload = ExplosionPayload + | ShrapnelBomb + | DudPayload deriving (Show, Eq, Ord, Enum, Bounded, Read) --Generic, Flat) deriveJSON defaultOptions ''Payload diff --git a/src/Dodge/EnergyBall.hs b/src/Dodge/EnergyBall.hs index a2d17e701..6ce992bf9 100644 --- a/src/Dodge/EnergyBall.hs +++ b/src/Dodge/EnergyBall.hs @@ -48,11 +48,12 @@ updateEnergyBall w eb | otherwise = ( ebFlicker eb $ uncurry (damageCircle 5 (_ebPos eb)) (_ebEff eb) w -- , Just $ eb & ebTimer -~ 1 & ebPos .+.+~ _ebVel eb & ebVel .*.*~ 0.9 - , Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ 0.8 * bv + , Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ 0.85 * bv ) where p = eb ^. ebPos + eb ^. ebVel - (bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w + (bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0.5 (eb ^. ebPos) p w +-- (bp,bv) = fromMaybe (p,eb^.ebVel) $ bouncePoint (const True) 0.5 (eb ^. ebPos) p w incBallAt :: Point2 -> World -> World incBallAt p w = diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index a78715e4a..e06c23fcf 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -7,6 +7,7 @@ module Dodge.HeldUse ( mcUseHeld, ) where +import Control.Applicative import Dodge.Item.Weapon.Bullet import Color import Control.Monad @@ -610,7 +611,8 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do magid <- magtree ^? ldtValue . itLocation . ilInvID ammoitem <- cr ^? crInv . ix magid let homing = determineProjectileTracking magtree itmtree - aparams <- ammoitem ^? itConsumables . magParams . ampPayload + aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload)) + <|> ammoitem ^? itConsumables . magParams . ampPayload return $ createShell homing aparams muz cr . startthesound diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 432461670..b47a07e94 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -84,6 +84,6 @@ closeButtonToSelectionItem w i = do closeItemToTextPictures :: FloorItem -> ([String], Color) closeItemToTextPictures flit = - (basicItemDisplay it, itemInvColor $ basePCI it) + (basicItemDisplay it, itemInvColor $ baseCI it) where it = _flIt flit diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 1347fd8e9..df2418f27 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -42,6 +42,7 @@ itemFromAttachType at = case at of -- ROCKETHOMER -> rocketHomer HOMINGMODULE -> homingModule AUGMENTEDHUD -> augmentedHUD + SHELLPAYLOAD p -> shellModule p itemFromEquipType :: EquipItemType -> Item itemFromEquipType et = case et of diff --git a/src/Dodge/Item/Ammo.hs b/src/Dodge/Item/Ammo.hs index 07da556cc..f37877978 100644 --- a/src/Dodge/Item/Ammo.hs +++ b/src/Dodge/Item/Ammo.hs @@ -67,6 +67,7 @@ shellMag = { _magParams = ProjectileParams { _ampPayload = ExplosionPayload +-- { _ampPayload = ShrapnelBomb } , _magLoadStatus = ReloadStatus diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index a23ce232b..026e13351 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -73,6 +73,7 @@ showAttachItem t itm = case t of (itm ^? itUse . uaParams . apLinkedProjectile . _Just) HOMINGMODULE -> "HOMING MOD" AUGMENTEDHUD -> "AUGMENTED HUD" + SHELLPAYLOAD x -> show x showEquipItem :: EquipItemType -> String showEquipItem eit = case eit of diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index f2c03fc97..91de20b37 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -3,7 +3,7 @@ module Dodge.Item.Grammar ( invAdj, invRootMap, invRootTrees, - basePCI, + baseCI, allInvLocs, ) where @@ -112,10 +112,11 @@ itemToFunction itm = case itm ^. itType of TARGETING{} -> WeaponTargetingSF EQUIP WRIST_ECG -> TriggerSF EQUIP{} -> EquipmentPlatformSF + ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo _ -> UncomposableIsolateSF -basePCI :: Item -> ComposedItem -basePCI itm = (itm, itemToFunction itm, itemBaseConnections itm) +baseCI :: Item -> ComposedItem +baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm) itemBaseConnections :: Item -> LinkTest itemBaseConnections itm = case _itType itm of @@ -205,7 +206,7 @@ joinItemsInList f xs = snd $ h (xs, []) invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink ComposedItem] invLDT = joinItemsInList tryAttachItems . IM.elems - . fmap (singleLDT . basePCI) + . fmap (singleLDT . baseCI) -- this assumes the creature inventory is well formed, specifically the -- location ids diff --git a/src/Dodge/Item/Scope.hs b/src/Dodge/Item/Scope.hs index 17fd14a33..b5ec45356 100644 --- a/src/Dodge/Item/Scope.hs +++ b/src/Dodge/Item/Scope.hs @@ -1,4 +1,5 @@ module Dodge.Item.Scope ( + shellModule, zoomScope, targetingScope, remoteScreen, @@ -38,6 +39,11 @@ bulletModule bm = & itType .~ BULLETMOD bm & itUse .~ UseBulletMod {_ubMod = bm} +shellModule :: Payload -> Item +shellModule p = defaultHeldItem + & itType .~ ATTACH (SHELLPAYLOAD p) + & itUse .~ UseNothing + --bulletTargetingModule :: BulletTrajectoryType -> Item --bulletTargetingModule = bulletModule . BulletModTrajectory diff --git a/src/Dodge/Payload.hs b/src/Dodge/Payload.hs index 61e0906b5..6535096b9 100644 --- a/src/Dodge/Payload.hs +++ b/src/Dodge/Payload.hs @@ -1,10 +1,45 @@ -module Dodge.Payload where +module Dodge.Payload ( + usePayload, +) where +--import Geometry.Vector +import Dodge.Item.Weapon.Bullet +import RandomHelp +import Control.Monad +import Color +import Dodge.WorldEvent.Shockwave +import Geometry.Vector3D import Dodge.Data.World +import Dodge.SoundLogic import Dodge.WorldEvent.Explosion import Geometry.Data +import LensHelp usePayload :: Payload -> Point2 -> Point2 -> World -> World usePayload payload = case payload of ExplosionPayload -> makeExplosionAt + ShrapnelBomb -> makeShrapnelAt DudPayload -> const (const id) + +makeShrapnelAt :: Point2 -> Point2 -> World -> World +makeShrapnelAt p v w = + w + & soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing + & cWorld . lWorld . worldEvents + .:~ MakeTempLight (LSParam (addZ 20 p) 150 (V3 0.8 0.8 0.8)) 20 + & makeShockwaveAt [] p 50 5 0 white + & cWorld . lWorld . bullets .++~ buls + where +-- speed = magV v + vs = replicateM 75 (randInCirc $ 10) & evalState $ _randGen w + drags :: [Float] + drags = replicateM 75 (state $ randomR (0.85,0.9)) & evalState $ _randGen w + buls = zipWith f vs drags + f v' drag = defaultBullet + & buEffect .~ BounceBullet + & buVel .~ v + v' + & buDrag .~ drag + & buPos .~ (p - v) + & buOldPos .~ (p - v) + & buDamages .~ [Damage PIERCING 10 0 0 0 $ PushBackDamage 2] + & buWidth .~ 1 diff --git a/src/Dodge/Shockwave/Update.hs b/src/Dodge/Shockwave/Update.hs index a66bdb192..6df88e242 100644 --- a/src/Dodge/Shockwave/Update.hs +++ b/src/Dodge/Shockwave/Update.hs @@ -30,7 +30,7 @@ moveShockwave w sw doDams w' = over (cWorld . lWorld . creatures) (IM.map damCr) $ foldl' - (flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect)) + (flip $ damageWall (Damage EXPLOSIVE 1000 p p p NoDamageEffect)) w' hitBlocks hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 7fefe855a..a30474459 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -26,8 +26,8 @@ import qualified IntMapHelp as IM import qualified Data.Map.Strict as M testStringInit :: Universe -> [String] -testStringInit u = - (map (show . _ebPos) $ u ^. uvWorld . cWorld . lWorld . energyBalls) +testStringInit _ = [] +-- (map (show . _ebPos) $ u ^. uvWorld . cWorld . lWorld . energyBalls) -- <> -- (foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . bullets) -- fromMaybe mempty $ do diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index edf737dc4..25ea9d3bf 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -84,8 +84,6 @@ makeExplosionAt p vel w = fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' sizes = randomRs (2, 9) $ _randGen w times = randomRs (15, 20) $ _randGen w - mF q v size time = makeFlamelet (q - vel) (v + vel) size time + mF q v size time = makeFlamelet (q - (v + 2* vel)) (v + vel) size time newFs = zipWith3 (mF p) (zipWith (+) fPs' (fmap (3 *.*) fVs')) sizes times --- newFs = zipWith3 (mF p) (fmap (3 *.*) fVs') sizes times --- newFs = zipWith3 (mF p) fPs' sizes times addFlames w' = foldl' (flip ($)) w' newFs diff --git a/src/RandomHelp.hs b/src/RandomHelp.hs index 0aeb688f3..7434dd721 100644 --- a/src/RandomHelp.hs +++ b/src/RandomHelp.hs @@ -73,6 +73,11 @@ randProb p = do randInCirc :: RandomGen g => Float -> State g Point2 randInCirc = flip randInArc (2 * pi) +randOnCirc :: RandomGen g => Float -> State g Point2 +randOnCirc r = do + a <- state $ randomR (0, 2*pi) + return $ r *.* unitVectorAtAngle a + randInArc :: RandomGen g => Float -> Float -> State g Point2 randInArc = randInArcStrip 0