Implement modules changing shell payloads

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
             }

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]]
         <>

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)

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

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

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 =

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

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

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

src/Dodge/Item/Ammo.hs

@@ -67,6 +67,7 @@ shellMag =
                 { _magParams =
                     ProjectileParams
                         { _ampPayload = ExplosionPayload
+--                        { _ampPayload = ShrapnelBomb
                         }
                 , _magLoadStatus =
                     ReloadStatus

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

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

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
 

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

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

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

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

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