Generalise weapon character modes

src/Dodge/Creature.hs

@@ -264,7 +264,9 @@ Items you start with.
  -}
 startInventory = IM.fromList (zip [0..20] 
     (
-    [pistol
+    [lasGun
+    ,autoGun
+    ,bezierGun
     --,blinkGun
     --,spawnGun lamp
     --,poisonSprayer
@@ -295,13 +297,15 @@ sizeEnemy col cr
     | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr
     | otherwise       = pictures [color col $ circleSolid $ _crRad cr
                                  , circLine $ _crRad cr ]
-    where pdam = _crPastDamage $ _crState cr
+  where 
+    pdam = _crPastDamage $ _crState cr
 
 sizeColEnemy r col = pictures [color col $ circleSolid r, circLine r]
 
 basicCrPict :: Color -> Creature -> Picture
 basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr]
-    where naked | pdam > 200      = color red $ circleSolid $ _crRad cr
+  where 
+    naked | pdam > 200      = color red $ circleSolid $ _crRad cr
           | pdam > 100      = color white $ circleSolid $ _crRad cr
           | mod pdam 2 == 1 = color white $ circleSolid $ _crRad cr
           --  | crDam > _crHP cr && odd (crDam - _crHP cr)

src/Dodge/Creature/Action/UseItem.hs

@@ -10,13 +10,7 @@ import Control.Lens
 import Data.Maybe (fromMaybe)
 
 useItem :: Int -> World -> World
-useItem n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
+useItem n w = equippedItemEffect n w
-                            Just HammerUp -> equippedItemEffect n $ setHammerDown w
-                            Just NoHammer -> equippedItemEffect n w
-                            _             -> setHammerDown w
-    where 
-        cr = _creatures w IM.! n
-        setHammerDown = creatures . ix n . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
 
 tryUseItem :: Int -> World -> World
 tryUseItem cid w = case w ^? creatures . ix cid of
@@ -25,7 +19,8 @@ tryUseItem cid w = case w ^? creatures . ix cid of
 
 equippedItemEffect :: Int -> World -> World
 equippedItemEffect n w = itemEffect n it w
-    where c = (_creatures w IM.! n)
+  where 
+    c = (_creatures w IM.! n)
     it = _crInv c IM.! _crInvSel c
 
 itemEffect :: Int -> Item -> World -> World

src/Dodge/Event.hs

@@ -88,9 +88,11 @@ handlePressedMouseButton but w
 
 wheelUpEvent :: World -> World
 wheelUpEvent w = case _carteDisplay w of
-    True    | rbDown    -> w & carteZoom .~ min 0.75 (z+(0.1*z))
+    True    
+        | rbDown    -> w & carteZoom .~ min 0.75 (z+(0.1*z))
         | otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i - 1)
-    _       | rbDown    -> fromMaybe (closeObjScrollUp w) 
+    _       
+        | rbDown    -> fromMaybe (closeObjScrollUp w) 
                             $ (yourItem w ^? itScrollUp) 
                                 <*> pure (_crInvSel (you w))
                                 <*> pure w

src/Dodge/Item/Attachment.hs

@@ -1,2 +1,42 @@
 module Dodge.Item.Attachment
     where
+import Dodge.Data
+import Dodge.Item.Attachment.Data
+
+import Control.Lens hiding ((|>),(<|))
+import Data.Sequence
+import Data.Maybe (fromJust)
+import qualified Data.IntMap.Strict as IM
+
+incCharMode' :: ItAttachment -> ItAttachment
+incCharMode' = itCharMode %~ cycleL
+  where
+    cycleL (x :<| xs) = xs |> x
+    cycleL xs = xs
+decCharMode' :: ItAttachment -> ItAttachment
+decCharMode' = itCharMode %~ cycleR
+  where
+    cycleR (xs :|> x) = x <| xs
+    cycleR xs = xs
+
+incCharMode 
+    :: Int      -- ^ Inventory selection
+    -> World 
+    -> World
+incCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . _Just %~ incCharMode'
+decCharMode 
+    :: Int      -- ^ Inventory selection
+    -> World 
+    -> World
+decCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . _Just %~ decCharMode'
+
+charFiringStrat 
+    :: [(Char, Int -> World -> World)] -- ^ Different firing effects for different characters
+    -> Int      -- ^ Creature id
+    -> World 
+    -> World
+charFiringStrat strats cid w =
+    let Just (c :<| _) = w ^? creatures . ix cid . crInv 
+                        . ix (_crInvSel $ _creatures w IM.! cid) . itAttachment 
+                        . _Just . itCharMode
+    in fromJust (Prelude.lookup c strats) cid w

src/Dodge/Item/Attachment/Data.hs

@@ -5,6 +5,7 @@ module Dodge.Item.Attachment.Data
 import Geometry.Data
 
 import Control.Lens
+import qualified Data.Sequence as Seq
 
 data ItAttachment 
     = ItScope 
@@ -16,11 +17,7 @@ data ItAttachment
     | ItFuse {_itFuseTime :: Int}
     | ItPhaseV {_itPhaseV :: Float}
     | ItMode {_itMode :: Int}
-    | ItCharMode 
+    | ItCharMode {_itCharMode :: Seq.Seq Char }
-        {_itCharMode    :: Char
-        ,_itUpChar      :: Char -> Char
-        ,_itDownChar    :: Char -> Char
-        }
     | ItTargetPos { _itTargetPos :: Point2 }
 
 makeLenses ''ItAttachment

src/Dodge/Item/Weapon.hs

@@ -13,8 +13,6 @@ import Dodge.SoundLogic
 import Dodge.Creature.Action
 import Dodge.RandomHelp
 import Dodge.WorldEvent
-import Dodge.Debug
-import Dodge.WallCreatureCollisions
 import Dodge.Default
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.Bullet
@@ -22,6 +20,7 @@ import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.Recock
 import Dodge.Item.Attachment.Data
+import Dodge.Item.Attachment
 import Geometry
 import Picture
 
@@ -30,11 +29,12 @@ import Data.Char
 import Data.Maybe
 import Data.Function
 import qualified Data.ByteString as B
+import qualified Data.Sequence as Seq
 import Control.Lens
 import Control.Applicative
 import Control.Monad.State
 import Control.Monad
-import qualified SDL as SDL
+import qualified SDL
 import System.Random
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
@@ -56,7 +56,9 @@ pistol = Weapon
     , _wpReloadState = 0
     , _wpFireRate = 8
     , _wpFireState = 0
-    , _wpFire = shootWithSound 0 
+    , _wpFire = 
+        hammerCheck
+        . shootWithSound 0 
         . withRandomDir 0.1
         . withMuzFlare
         . withVelWthHiteff (30,0) 2 
@@ -81,8 +83,11 @@ pistol = Weapon
     }
 defaultGun = pistol
 
-defaultAutoGun = autoGun {_itScrollUp = const id
+defaultAutoGun = autoGun 
-                         , _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay}
+    { _itScrollUp   = const id
+    , _itScrollDown = const id
+    , _itInvDisplay = basicWeaponDisplay
+    }
 effectGun :: String -> (Int -> World -> World) -> Item
 effectGun name eff = defaultGun
     { _itName = name ++ "Gun"
@@ -103,11 +108,13 @@ autoGun = defaultGun
     , _wpReloadState = 0
     , _wpFireRate = 6
     , _wpFireState = 0
-    , _wpFire =  autoFireMode
+    , _wpFire   = charFiringStrat
+        [('M',autoFireMode) 
+        ,('S',singleFireMode)
+        ]
     , _wpSpread = autogunSpread
     , _wpRange = 20
-    , _itHammer = NoHammer
+    , _itHammer = HammerUp
---    , _itHammer = HammerUp
     , _itFloorPict = onLayer FlItLayer $ color red $ pictures [polygon [(-4,-4),(-4,4),(4,4),(4,-4)]]
     , _itAmount = 1
     , _itMaxStack = 1
@@ -115,17 +122,17 @@ autoGun = defaultGun
     , _itAimingRange = 1
     , _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
     , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4)
-    , _itEffect = NoItEffect
+    , _itEffect = wpRecock
-    , _itAttachment = Just $ ItMode 0
+    , _itAttachment = Just $ ItCharMode $ Seq.fromList "MS"
-    , _itScrollUp = incMode
+    , _itScrollUp   = incCharMode
-    , _itScrollDown = incMode
+    , _itScrollDown = decCharMode
-    , _itInvDisplay = displayAutoGun
+    , _itInvDisplay = basicWeaponDisplay
     }
 autoFireMode = shootWithSound (fromIntegral autoGunSound) 
     . torqueBefore 0.05
     $ autoGunNonTwistEff
-singleFireMode = shootWithSound (fromIntegral autoGunSound) 
+singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) 
-    . torqueAfter 0.03
+--    . torqueAfter 0.03
     $ autoGunNonTwistEff
 autoGunNonTwistEff = withRecoil 40
     . withRandomDir (autogunSpread/2)
@@ -133,33 +140,6 @@ autoGunNonTwistEff = withRecoil 40
     . withVelWthHiteff (50,0) 3 
     $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
 
-
-incMode :: Int -> World -> World
-incMode _ w 
-    = case newMode of
-        0 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 0
-               & creatures . ix 0 . crInv . ix itRef . itHammer .~ NoHammer
-               & creatures . ix 0 . crInv . ix itRef . itEffect .~ NoItEffect
-               & creatures . ix 0 . crInv . ix itRef . wpFire .~ autoFireMode
-        1 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 1
-               & creatures . ix 0 . crInv . ix itRef . itHammer .~ HammerUp
-               & creatures . ix 0 . crInv . ix itRef . itEffect .~ wpRecock
-               & creatures . ix 0 . crInv . ix itRef . wpFire .~ singleFireMode
-    where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
-          oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode
-          newMode = fromMaybe 1 $ fmap f oldMode
-          f x = mod (x+1) 2
-decMode :: Int -> World -> World
-decMode _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode %~ f
-                & creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN" ++ g newMode
-    where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
-          oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode
-          newMode = fromMaybe 1 $ fmap f oldMode
-          f x = mod (x-1) 2
-          g 1 = "-S"
-          g 2 = "-B"
-          g 0 = "-A"
-
 rezGun = defaultGun
     { _itName = "REANIMATOR"
     , _wpMaxAmmo = 50
@@ -224,32 +204,11 @@ lasGun = defaultAutoGun
     , _itAimingSpeed = 0.4
     , _itAimingRange = 1
     , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
-    , _itAttachment = Just $ ItPhaseV 1
+    , _itAttachment = Just $ ItCharMode $ Seq.fromList "/VZ"
-    , _itScrollUp = incPhaseV 
+    , _itScrollUp   = incCharMode
-    , _itScrollDown = decPhaseV
+    , _itScrollDown = decCharMode
-    , _itInvDisplay = displayLasGun
+    , _itInvDisplay = basicWeaponDisplay
     }
-
-incPhaseV :: Int -> World -> World
-incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
-    where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
-          oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
-          newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
-          f 0.2 = 1
-          --f 0.5 = 1
-          f 1 = 5
-          --f 2 = 5
-          f 5 = 5
-decPhaseV :: Int -> World -> World
-decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f
-    where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel
-          oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV
-          newPhaseV = fromMaybe 1 $ fmap f oldPhaseV
-          f 0.2 = 0.2
-          --f 0.5 = 0.2
-          f 1 = 0.2
-          --f 2 = 1
-          f 5 = 1
 forceFieldGun = defaultGun 
     { _itName = "FORCEFIELD"
     , _itIdentity = ForceFieldGun
@@ -344,7 +303,8 @@ teslaLauncher = launcher
 
 bezierGun = defaultAutoGun
     { _itName = "B-GUN"
-    , _wpFire = maybeSetTarget $ \p ->  shootWithSound 0 
+    , _wpFire = maybeSetTarget $ \p ->  
+        shootWithSound 0 
         . withMuzFlare 
         . withRecoil 40
         . torqueBefore 0.05 -- I believe that this doesn't affect
@@ -600,8 +560,6 @@ startZoomInLongGun  _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatur
 startZoomOutLongGun :: Int -> World -> World
 startZoomOutLongGun  _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                                 . itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5)
---                             (\x -> - 10) 
-
 
 poisonSprayer = defaultAutoGun 
     { _itName = "POISON"
@@ -640,8 +598,6 @@ flamer = defaultAutoGun
     , _itAmount = 1
     , _itMaxStack = 1
     , _itAimingSpeed = 0.5
---    , _itAimingSpeed = 1
---    , _itAimingSpeed = 0.2
     , _itAimingRange = 0
     , _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
     , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
@@ -694,9 +650,13 @@ aLaser cid w = over particles ((makeLaserAt phaseV pos dir (Just cid)) : )
     i = newProjectileKey w
     pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
     dir = _crDir cr
-    phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV
+    phaseV = charToPhaseV $ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . _Just . itCharMode
     j = _crInvSel cr
 
+charToPhaseV 'V'    = 0.2
+charToPhaseV '/'   = 1
+charToPhaseV 'Z'    = 5
+
 aTractorBeam :: Int -> Int -> World -> World
 aTractorBeam col cid w
         = set (creatures . ix cid . crInv . ix itRef . wpFire)

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -7,32 +7,22 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Item.Attachment.Data
 
+import Data.Sequence
 import Control.Lens
 import Control.Monad
 
--- MODES SHOULD BE MADE UNIFORM
+-- not sure if this is in the right place...
 
 basicWeaponDisplay :: Item -> String
 basicWeaponDisplay it = case it ^? itAttachment . _Just . itCharMode of
-    Just c -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c]
+    Just (c :<| _) -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c]
-    otherwise -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
+    _   -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded)
   where 
     availableAmmo = show $ _wpMaxAmmo it
     aIfLoaded = case (_wpReloadState it) of 
         0 -> show $ _wpLoadedAmmo it
         x -> "R" ++ show x
 
-displayAutoGun :: Item -> String
-displayAutoGun it@(Weapon {_itAttachment = mayMode})
-        = midPadL 10 ' ' "AUTOGUN" (' ':aIfLoaded)  ++ (' ':phaseS)
-  where aIfLoaded = case (_wpReloadState it) of
-                        0 -> show $ _wpLoadedAmmo it
-                        x -> "R" ++ show x
-        phaseS = case mayMode of
-                    Just (ItMode 0) -> "M"
-                    Just (ItMode 1) -> "S"
-                    Just (ItMode 2) -> "B"
-
 displayLasGun :: Item -> String
 displayLasGun it@(Weapon {_itAttachment = mayPhase})
         = midPadL 10 ' ' "LASER" (' ':aIfLoaded)  ++ (' ':phaseS)

src/Dodge/Item/Weapon/TriggerType.hs

@@ -134,12 +134,26 @@ shootWithSound soundid f cid w
                       && _wpFireState item == 0
                       && _wpLoadedAmmo item > 0
     reloadCondition = _wpLoadedAmmo item == 0
+{- | Applies a world effect after a hammer position check. -}
+hammerCheck
+    :: (Int -> World -> World)  -- ^ Underlying effect
+    -> Int                      -- ^ Creature id
+    -> World
+    -> World
+hammerCheck f cid w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
+    Just HammerUp -> f cid $ setHammerDown w
+    _             -> setHammerDown w
+  where 
+    cr = _creatures w IM.! cid
+    setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
+
 {- | Applies a world effect after an ammo check. -}
 shoot 
     :: (Int -> World -> World) 
             -- ^ Underlying effect, takes creature id as input
     -> Int  -- ^ Creature id
-    -> World -> World
+    -> World
+    -> World
 shoot f cid w 
     | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
                           $ set (pointerToItem . wpFireState) (_wpFireRate item)