Magnets

src/Dodge/Creature/Impulse/UseItem.hs

@@ -22,45 +22,45 @@ tryUseItem cr' w = case w ^? creatures . ix (_crID cr') of
     Nothing -> w
 
 itemEffect :: Creature -> Item -> World -> World
---itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w)
 itemEffect cr it w = case it ^? itUse of
     Just RightUse {_rUse = eff,_useMods = usemods} -> foldr ($) eff usemods it cr w
     Just LeftUse {} -> lhammer setEquipLeftItem
---    Just LeftUse {} -> w 
---        & lSelHammerPosition .~ HammerDown
---        & docycle
-    --Just EquipUse -> w & creatures . ix (_crID cr) . crInvEquipped . at (_crInvSel cr) %~ f
-    Just EquipUse -> lhammer setEquipment
+    Just EquipUse{} -> lhammer setEquipment
     Just NoUse -> w
     Nothing -> w
   where
-    f Nothing = Just ()
-    f (Just ()) = Nothing
---    toggleEquip invid = 
-    lhammer f = w
+    lhammer f' = w
         & lSelHammerPosition .~ HammerDown
         & case _lSelHammerPosition w of
-            HammerUp -> creatures . ix (_crID cr) %~ f
+            HammerUp -> creatures . ix (_crID cr) %~ f'
             _ -> id
-    setEquipLeftItem cr = case _crLeftInvSel cr of
-        Just i | i == _crInvSel cr -> cr & crLeftInvSel .~ Nothing
-        _ -> cr & crLeftInvSel .~ (Just $ _crInvSel cr)
-    setEquipment = crInvEquipped . at (_crInvSel cr) %~ f
-    docycle | _lSelHammerPosition w == HammerUp = creatures . ix (_crID cr) . crLeftInvSel %~ cyclelsel
-        | otherwise = id
-    cyclelsel mi = case mi of
-        Just i | i == _crInvSel cr -> Nothing
-        _ -> Just $ _crInvSel cr
+    setEquipLeftItem cr' = case _crLeftInvSel cr' of
+        Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
+        _ -> cr' & crLeftInvSel ?~ _crInvSel cr'
+    setEquipment = toggleEquipmentAt (_crInvSel cr)
+
+toggleEquipmentAt :: Int -> Creature -> Creature
+toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f
+  where
+    f Nothing = Just ()
+    f (Just ()) = Nothing
 
 --this is ugly
 useLeftItem :: Int -> World -> World
-useLeftItem cid w | _crInvLock $ _creatures w IM.! cid = w
+useLeftItem cid w 
+    | _crInvLock $ _creatures w IM.! cid = w
     | otherwise = useLeftItem' cid w
+    
 
 useLeftItem' :: Int -> World -> World
-useLeftItem' cid w = case cr ^? crInv . ix crinvsel . itUse . lUse of
-    Just f -> f cr crinvsel (w & creatures . ix cid . crLeftInvSel ?~ crinvsel)
-    Nothing -> case _crLeftInvSel cr of
+useLeftItem' cid w = case cr ^? crInv . ix crinvsel . itUse of
+    Just EquipUse{} -> w
+        & lSelHammerPosition .~ HammerDown
+        & case _lSelHammerPosition w of
+            HammerUp -> creatures . ix cid %~ toggleEquipmentAt crinvsel
+            _ -> id
+    Just LeftUse {_lUse = f} -> f cr crinvsel (w & creatures . ix cid . crLeftInvSel ?~ crinvsel)
+    _ -> case _crLeftInvSel cr of
         Just invid -> case _itUse $ _crInv cr IM.! invid of
             LeftUse {_lUse = f}  -> f cr invid w
             _ -> w & creatures . ix cid . crLeftInvSel .~ Nothing

src/Dodge/Creature/State.hs

@@ -19,6 +19,7 @@ import Picture
 import qualified IntMapHelp as IM
 --import StrictHelp
 
+import qualified Data.IntSet as IS
 import Data.Maybe
 import Data.Function
 import Control.Lens
@@ -134,8 +135,11 @@ invItemUpdate = itUse %~ useupdate
         . (useDelay . rateTime %~ decreaseToZero)
 
 invSideEff :: Creature -> World -> World
-invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
+invSideEff cr w = weaponReloadSounds cr 
+    . flip (IS.foldr useeq) (_crInvEquipped cr)
+    $ IM.foldrWithKey f w (_crInv cr)
   where 
+    useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
     f i it w' = case it ^? itEffect . itInvEffect of
         Nothing -> w' & doitemupdate
         Just g  -> g (_itEffect it) cr i w' & doitemupdate

src/Dodge/Data.hs

@@ -318,6 +318,8 @@ data ItemUse
         , _useHammer    :: HammerType
         }
     | EquipUse
+        { _eqUse :: Creature -> Int -> World -> World
+        }
     | NoUse
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse

src/Dodge/Default.hs

@@ -146,7 +146,7 @@ defaultEquipment = Item
     , _itInvSize = 1
     , _itDimension = defItDimCol yellow
     , _itConsumption = NoConsumption
-    , _itUse = EquipUse
+    , _itUse = EquipUse {_eqUse = \_ _ -> id}
     , _itScroll = \ _ _ -> id
     , _itAttachment = NoItAttachment
     , _itParams = NoParams

src/Dodge/Inventory.hs

@@ -36,12 +36,12 @@ import qualified IntMapHelp as IM
 import ListHelp
 import Color
 
+import qualified Data.IntSet as IS
 import Data.Maybe
 --import Data.List
 --import System.Random
 import Control.Lens
 
-
 -- | after this the item at the inventory position will no longer exist
 rmInvItem :: Int      -- ^ Creature id
     -> Int      -- ^ Inventory position
@@ -51,6 +51,8 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
     _ -> w & creatures . ix cid . crInv %~ f
         & creatures . ix cid . crInvSel %~ g
         & creatures . ix cid . crLeftInvSel . _Just %~ g
+        & creatures . ix cid . crInvEquipped %~ IS.delete invid
+        & creatures . ix cid . crInvEquipped %~ IS.map g
   where
     maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
     f inv = let (xs,ys) = IM.split invid inv
@@ -155,6 +157,7 @@ changeSwapInvSel k w
     updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
         . (crLeftInvSel . _Just %~ updateLeftInvSel)
         . (crInvSel %~ (`mod` n) . subtract k)
+        . (crInvEquipped %~ swapIntSetKeys i swapi)
     swapi = (i - k) `mod` n
     updateLeftInvSel li | i == li = swapi
         | swapi == li = i
@@ -164,6 +167,13 @@ changeSwapInvSel k w
     n = length $ _crInv $ _creatures w IM.! _yourID w
     numCO = length $ _closeObjects w
 
+swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet
+swapIntSetKeys i j is
+    | i `IS.member` is && j `IS.member` is = is
+    | i `IS.member` is = j `IS.insert` (i `IS.delete` is)
+    | j `IS.member` is = i `IS.insert` (j `IS.delete` is)
+    | otherwise = is
+
 changeAugInvSel :: Int -> World -> World
 changeAugInvSel i w 
     | n == 0    = w

src/Dodge/Item/Attachment/Data.hs

@@ -19,6 +19,7 @@ data ItAttachment
     | ItCharMode {_itCharMode :: Seq.Seq Char }
     | ItTargetPos { _itTargetPos :: Point2 }
     | ItInt { _itInt :: Int }
+    | ItMInt { _itMInt :: Maybe Int }
     | ItFloat { _itFloat :: Float }
     | ItBool  { _itBool  :: Bool  }
     | NoItAttachment

src/Dodge/Item/Equipment.hs

@@ -8,21 +8,39 @@ import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Creature.Test
 import Dodge.Wall.Reflect
 import Dodge.Wall
+import Dodge.Magnet
 import Picture
 import Geometry
 import ShapePicture
 import Shape
+import qualified IntMapHelp as IM
 
-import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
 magShield :: Item
 magShield = defaultEquipment
     { _itType = MAGSHIELD
     , _itName = "MAGSHIELD"
+    , _itUse = EquipUse useMagShield
     , _itEquipPict = \_ _ -> (,) emptySH blank
     , _itID = Nothing
+    , _itAttachment = ItMInt Nothing
     }
+useMagShield :: Creature -> Int -> World -> World
+useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
+  where
+    themagnet = Magnet
+        {_mgID = mgid
+        ,_mgUpdate = Just . (mgUpdate .~ const Nothing)
+        ,_mgPos = _crPos cr
+        ,_mgField = curveAroundField
+        }
+    mgid = case it ^? itAttachment . itMInt . _Just of
+        Just mgid' -> mgid'
+        Nothing -> IM.newKey $ _magnets w
+    it = _crInv cr IM.! invid
+
+
 flameShield :: Item 
 flameShield = defaultEquipment
     { _itType = FLAMESHIELD

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -33,8 +33,14 @@ defaultAimParams = AimParams
     }
 
 useAmmoParams :: Item -> Creature -> World -> World
-useAmmoParams it = withVelWthHiteff (muzvel *.* _amBulVel b) (_rifling $ _itParams it) (_amBulWth b) (_amBulEff b) 
+useAmmoParams it = withVelWthHiteff 
+    (muzvel *.* _amBulVel b) 
+    (_rifling $ _itParams it) 
+    (_amBulWth b) 
+    muzlength
+    (_amBulEff b) 
   where
+    muzlength = 20
     muzvel = _muzVel $ _itParams it
     b = _aoType $ _itConsumption it
 
@@ -49,14 +55,15 @@ withVelWthHiteff
     :: Point2       -- ^ Velocity, x direction is forward with respect to the creature
     -> Float        -- ^ drag
     -> Float        -- ^ Bullet width
+    -> Float        -- ^ Distance away from creature to create
     -> HitEffect    -- ^ Bullet effect when hitting creature, wall etc
     -> Creature
     -> World 
     -> World
-withVelWthHiteff vel drag width hiteff cr = particles .:~ newbul
+withVelWthHiteff vel drag width muzlength hiteff cr = particles .:~ newbul
   where 
     newbul = aGenBulAt (Just (_crID cr)) pos (rotateV dir vel) drag hiteff width
-    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle dir
+    pos = _crPos cr +.+ muzlength *.* unitVectorAtAngle dir
     dir = _crDir cr
 
 {- | Creates a bullet with a given velocity, width, and 'HitEffect' -}

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -163,13 +163,13 @@ baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
 
 
 autoRifle :: Item
-autoRifle = rifle
+autoRifle = repeater
     & itName .~ "AUTORIFLE"
     & itType .~ AUTORIFLE
     & itUse . useMods %~ ((ammoCheckI :) . tail)
 --    & itUse . useDelay . rateMax .~ 6
 assaultRifle :: Item
-assaultRifle = rifle
+assaultRifle = repeater
     & itName .~ "ASSAULTRIFLE"
     & itType .~ ASSAULTRIFLE
     & itUse . useDelay . rateMax .~ 18

src/Dodge/Magnet.hs

@@ -8,3 +8,22 @@ dampField :: Magnet -> Particle -> Particle
 dampField mg pt = case pt of
     BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & btVel' *~ 0.5
     _ -> pt
+
+curveLeftField :: Magnet -> Particle -> Particle
+curveLeftField mg pt = case pt of
+    BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 500 -> pt & btVel' %~ rotateV 0.2
+    _ -> pt
+
+curveAroundField :: Magnet -> Particle -> Particle
+curveAroundField mg pt = case pt of
+    BulletPt{} | dist btpos mgpos < 500 -> pt & btVel' %~ rotateToCircle
+      where
+        mgpos = _mgPos mg
+        btpos = head $ _btTrail' pt
+        rotateToCircle vel 
+            | (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) )
+              || (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) )
+                = rotateV rot vel
+            | otherwise = rotateV (negate rot) vel
+        rot = 0.5
+    _ -> pt

src/Dodge/Placement/Instance/Turret.hs

@@ -7,6 +7,7 @@ import Dodge.FloorItem
 import Dodge.Wall.Delete
 import Dodge.WorldEvent.Explosion
 import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Item.Weapon.BulletGun.Cane
 import Dodge.SoundLogic.LoadSound
 import Dodge.SoundLogic
 import Dodge.Item.Draw
@@ -29,7 +30,8 @@ putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMa
     }
 lasTurret :: MachineType
 lasTurret = Turret
-    { _tuWeapon = lasGun
+    --{ _tuWeapon = lasGun
+    { _tuWeapon = autoRifle
     , _tuTurnSpeed = 0.1
     , _tuFireTime = 0
     }

src/Dodge/Update/UsingInput.hs

@@ -1,5 +1,4 @@
-{- Functions that affect the world according to what pressed buttons are stored in a Set.
--}
+{- Functions that affect the world according to what pressed buttons are stored in a Set.  -}
 module Dodge.Update.UsingInput
     ( updateUsingInput
     ) where