Refactor, add bullet modules and weapon effect modifiers

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)

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

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