Move toward adding multiple equipable items that are not directly usable

src/Dodge/Combine/Combinations.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TupleSections #-}
 module Dodge.Combine.Combinations where
 import Dodge.Data
+import Dodge.Item.Equipment
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.SprayGuns
@@ -24,8 +25,9 @@ itemCombinations =
     , p [p 2 PIPE,o HARDWARE] bangCane
     , p [p 2 PIPE,o BANGCANE] (bangCaneX 2)
     , po [BANGCANE,TIN] rifle
-    , po [RIFLE,SPRING,HARDWARE] autoRifle
+    , po [RIFLE,PLANK]  repeater
-    , po [RIFLE,SPRING,CAN] assaultRifle
+    , po [REPEATER,SPRING,HARDWARE] autoRifle
+    , po [REPEATER,SPRING,CAN] assaultRifle
     , po [MOTOR,BANGCANE,BANGCANE,BANGCANE] miniGun
 
     , p [p 3 PIPE,o HARDWARE] bangRod
@@ -40,6 +42,8 @@ itemCombinations =
     , po [FLAMESTICK,CAN,PUMP] blowTorch
     , po [FLAMESTICK,IRONBAR,DRUM] flameThrower
     , po [FLAMESTICK,DRUM,DRUM] flameWall
+
+    , po [MAGNET,TIN] magShield
     ] 
     ++ map (\i -> po [PIPE,BANGSTICK i] $ bangStick (i+1)) [1..8]
     ++ map (\i -> po [REVOLVERX i,CAN]  $ revolverX (i+1)) [1..5]

src/Dodge/Combine/Data.hs

@@ -23,6 +23,7 @@ data CombineType
     | MINIGUN
     | BANGCANEX Int
     | RIFLE
+    | REPEATER
     | AUTORIFLE
     | ASSAULTRIFLE
     | BANGROD

src/Dodge/Creature.hs

@@ -171,7 +171,8 @@ startInventory = IM.fromList $ zip [0..] startInvList
 testInventory :: IM.IntMap Item
 testInventory = IM.fromList $ zip [0..] 
     [ makeTypeCraftNum 9 PIPE
-    , makeTypeCraftNum 3 TUBE
+    , makeTypeCraftNum 1 TUBE
+    , makeTypeCraftNum 1 MAGNET
     , makeTypeCraftNum 5 HARDWARE
     , makeTypeCraftNum 3 SPRING
     , makeTypeCraftNum 3 CAN

src/Dodge/Creature/Impulse/UseItem.hs

@@ -25,11 +25,27 @@ 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 {} -> w 
+    Just LeftUse {} -> lhammer setEquipLeftItem
-        & lSelHammerPosition .~ HammerDown
+--    Just LeftUse {} -> w 
-        & docycle
+--        & lSelHammerPosition .~ HammerDown
-    _ -> w
+--        & docycle
+    --Just EquipUse -> w & creatures . ix (_crID cr) . crInvEquipped . at (_crInvSel cr) %~ f
+    Just EquipUse -> lhammer setEquipment
+    Just NoUse -> w
+    Nothing -> w
   where
+    f Nothing = Just ()
+    f (Just ()) = Nothing
+--    toggleEquip invid = 
+    lhammer f = w
+        & lSelHammerPosition .~ HammerDown
+        & case _lSelHammerPosition w of
+            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

src/Dodge/Creature/Picture.hs

@@ -181,9 +181,14 @@ scalp cr
     fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 4 5
 
 crInStance :: AimStance -> Creature -> Bool
-crInStance as cr = crIsAiming' cr 
+crInStance as cr = crIsAiming' cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr)
     && cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance == Just as
 
+--hasAmmo :: Creature -> Bool
+--hasAmmo cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded of
+--    Just x -> x > 0
+--    _ -> False
+
 oneH :: Creature -> Bool
 oneH = crInStance OneHand
 

src/Dodge/Data.hs

@@ -82,6 +82,7 @@ data World = World
     , _walls                :: !(IM.IntMap Wall)
     , _doors                :: IM.IntMap Door
     , _machines             :: IM.IntMap Machine
+    , _magnets              :: IM.IntMap Magnet
     , _blocks               :: IM.IntMap Block
     , _coordinates          :: IM.IntMap Point2
     , _triggers             :: IM.IntMap (World -> Bool)
@@ -130,6 +131,13 @@ data WorldTerminal = WorldTerminal Int [(Int,String)]
 data SaveSlot = QuicksaveSlot | LevelStartSlot
   deriving (Eq,Ord)
 
+data Magnet = Magnet
+    { _mgID :: Int
+    , _mgUpdate :: Magnet -> Maybe Magnet
+    , _mgPos :: Point2
+    , _mgField  :: Magnet -> Particle -> Particle
+    }
+
 data OptionScreenFlag = NormalOptions | GameOverOptions
 data ScreenLayer
     = OptionScreen
@@ -230,6 +238,7 @@ data Creature = Creature
     , _crInvSel         :: Int
     , _crInvCapacity    :: Int
     , _crInvLock        :: Bool
+    , _crInvEquipped    :: IS.IntSet
     , _crLeftInvSel     :: Maybe Int
     , _crState          :: CreatureState
     , _crCorpse         :: Picture
@@ -308,6 +317,7 @@ data ItemUse
         , _useDelay     :: UseDelay
         , _useHammer    :: HammerType
         }
+    | EquipUse
     | NoUse
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse
@@ -524,6 +534,7 @@ data GunBarrels
         }
     | RotBarrel
         { _brlNum    :: Int
+        , _brlInaccuracy :: Float
         }
     | SingleBarrel  {_brlInaccuracy :: Float}
     
@@ -914,3 +925,4 @@ makeLenses ''ItemTweaks
 makeLenses ''Maybe'
 makeLenses ''InventoryMode
 makeLenses ''ItemPortage
+makeLenses ''Magnet

src/Dodge/Default.hs

@@ -40,6 +40,7 @@ defaultCreature = Creature
     , _crInvSel = 0
     , _crInvCapacity = 25
     , _crInvLock = False
+    , _crInvEquipped = mempty
     , _crLeftInvSel = Nothing
     , _crState  = defaultState
     , _crCorpse = setLayer 0 $ onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
@@ -145,7 +146,7 @@ defaultEquipment = Item
     , _itInvSize = 1
     , _itDimension = defItDimCol yellow
     , _itConsumption = NoConsumption
-    , _itUse = NoUse
+    , _itUse = EquipUse
     , _itScroll = \ _ _ -> id
     , _itAttachment = NoItAttachment
     , _itParams = NoParams

src/Dodge/Default/World.hs

@@ -19,6 +19,7 @@ import Data.Graph.Inductive.Graph hiding ((&))
 defaultWorld :: World
 defaultWorld = World
     { _keys = S.empty
+    , _magnets = IM.empty
     , _mouseButtons = S.empty
     , _cameraCenter = V2 0 0
     , _cameraRot = 0

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

@@ -1,6 +1,7 @@
 module Dodge.Item.Weapon.BulletGun.Cane 
     ( bangCane
     , bangCaneX
+    , repeater
     , rifle
     , autoRifle
     , assaultRifle
@@ -69,16 +70,12 @@ bangCane = defaultGun
             ,_muzPos    = 20
             }
         , _dimSPic = \it -> noPic $ baseCaneShape
-            <> caneClip it
+            <> makeSingleClipAt (V3 5 0 3) it
         }
     } & itUse . useAim . aimSpeed .~ 0.4
       & itUse . useAim . aimRange .~ 1
       & itUse . useAim . aimStance .~ OneHand
       & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
-caneClip :: Item -> Shape
-caneClip it = case it ^? itConsumption . ammoLoaded of
-    Just 0 -> mempty
-    _ -> translateSH (V3 5 0 3) $ upperPrismPoly 1 $ square 1.5
 bangCaneX :: Int -> Item
 bangCaneX i = bangCane
     { _itName = "BANGCANEx"++show i
@@ -129,7 +126,6 @@ caneClipX i it = case  it ^? itConsumption . ammoLoaded of
             [0..la-1]
     _ -> mempty
            
-
 rifle :: Item
 rifle = bangCane
     { _itDimension = ItemDimension
@@ -139,20 +135,32 @@ rifle = bangCane
             {_handlePos =  5
             ,_muzPos    = 25
             }
-        , _dimSPic = \it -> noPic $ baseCaneShape
+        , _dimSPic = \it -> noPic $ baseRifleShape
-            <> makeClipAt 0 (V3 10 (-2) 0) it
+            <> makeSingleClipAt (V3 5 0 3) it
         }
     }
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itName .~ "RIFLE"
     & itType .~ RIFLE
-    & itConsumption . ammoMax .~ 15
+    & itConsumption . ammoMax .~ 1
+
+repeater :: Item
+repeater = rifle
+    & itName .~ "REPEATER"
+    & itType .~ REPEATER
     & itConsumption . reloadType .~ ActiveClear
     & itConsumption . reloadTime .~ 80
+    & itConsumption . ammoMax .~ 15
+    & itDimension . dimSPic .~ (\it -> noPic $ baseRifleShape
+            <> makeTinClipAt 0 (V3 10 (-2) 0) it
+            )
 
 baseCaneShape :: Shape
 baseCaneShape = colorSH red $ upperPrismPoly 3 $ rectXH 15 2
 
+baseRifleShape :: Shape
+baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
+
 
 autoRifle :: Item
 autoRifle = rifle

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

@@ -5,8 +5,13 @@ import Geometry
 import Data.Maybe
 import Control.Lens
 
-makeClipAt :: Float -> Point3 -> Item -> Shape
+makeSingleClipAt :: Point3 -> Item -> Shape
-makeClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1 $ rectNSEW 0 (-y) (-2) 2
+makeSingleClipAt p it = case it ^? itConsumption . ammoLoaded of
+    Just 0 -> mempty
+    _ -> translateSH p $ upperPrismPoly 1 $ square 1.5
+
+makeTinClipAt :: Float -> Point3 -> Item -> Shape
+makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1 $ rectNSEW 0 (-y) (-2) 2
   where
     y = fromIntegral y' * 0.3
     y' = fromMaybe 0 $ it ^? itConsumption . ammoLoaded

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

@@ -0,0 +1,116 @@
+module Dodge.Item.Weapon.BulletGun.Rod 
+    ( bangRod
+    , elephantGun
+    , amr
+    , sniperRifle
+    , machineGun
+    ) where
+import Dodge.Data
+import Dodge.Item.Weapon.BulletGun.Clip
+--import Dodge.ChainEffect
+--import Dodge.TweakBullet
+import Dodge.Default.Weapon
+--import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Default
+--import Dodge.Item.Attachment
+--import Dodge.Item.Weapon.ExtraEffect
+--import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.AmmoParams
+--import Dodge.Item.Draw
+import Dodge.Item.Weapon.Bullet
+import Dodge.Item.Weapon.TriggerType
+import Dodge.SoundLogic.LoadSound
+import Picture
+import Geometry
+import ShapePicture
+import Shape
+--import Sound.Data
+import LensHelp
+
+--import Data.Maybe
+--import qualified Data.Sequence as Seq
+--import Control.Lens
+--import Control.Monad.State
+--import System.Random
+
+bangRod :: Item
+bangRod = defaultGun
+    { _itName = "BANGROD"
+    , _itType = BANGROD
+    , _itParams = BulletShooter
+        { _muzVel = 0.8
+        , _rifling = 1
+        , _bore = 2
+        , _gunBarrels = SingleBarrel 0.1
+        }
+    , _itUse = useAmmoParamsRate 6 upHammer
+        [ ammoHammerCheck
+        , useTimeCheck
+        , withSoundStart autoGunS
+        , useAmmoAmount 1
+        , torqueAfterI 0.3
+        , applyInaccuracy
+        , withMuzFlareI
+        , withRecoilI 50
+        ]
+    , _itDimension = ItemDimension
+        { _dimRad = 12
+        , _dimCenter = V3 5 0 0
+        , _dimPortage = HeldItem
+            {_handlePos =  5
+            ,_muzPos    = 30
+            }
+        , _dimSPic = \it -> noPic $ baseRodShape
+            <> makeSingleClipAt (V3 5 0 3) it
+        }
+    , _itConsumption = defaultAmmo 
+        { _aoType = basicBullet
+        , _ammoMax = 1
+        , _reloadTime = 20
+        , _reloadType = ActiveClear
+        }
+    } 
+    & itUse . useAim . aimSpeed .~ 0.2
+    & itUse . useAim . aimRange .~ 1
+    & itUse . useAim . aimStance .~ OneHand
+    & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
+baseRodShape :: Shape
+baseRodShape = colorSH orange $ upperPrismPoly 3 $ rectXH 20 2
+baseAMRShape :: Shape
+baseAMRShape = colorSH orange $ upperPrismPoly 3 $ rectXH 30 2
+elephantGun :: Item
+elephantGun = bangRod
+    & itName .~ "ELEPHANTGUN"
+    & itType .~ ELEPHANTGUN
+    & itUse . useAim . aimStance .~ TwoHandTwist
+    & itParams . gunBarrels .~ SingleBarrel 0.05
+    & itDimension . dimSPic .~ (\it -> noPic $ baseAMRShape
+            <> makeSingleClipAt (V3 5 0 3) it
+            )
+    & itUse . useMods .~
+        [ ammoHammerCheck
+        , useTimeCheck
+        , withSoundStart autoGunS
+        , useAmmoAmount 1
+        , torqueAfterI 0.1
+        , applyInaccuracy
+        , withMuzFlareI
+        , withRecoilI 50
+        ]
+amr :: Item
+amr = elephantGun
+    & itName .~ "AMR"
+    & itType .~ AMR
+    & itConsumption . ammoMax .~ 15
+    & itDimension . dimSPic .~ (\it -> noPic $ baseAMRShape
+            <> makeTinClipAt 0 (V3 10 (-2) 0) it
+            )
+sniperRifle :: Item
+sniperRifle = elephantGun
+    & itName .~ "SNIPERRIFLE"
+    & itType .~ SNIPERRIFLE
+    & itParams . gunBarrels .~ SingleBarrel 0
+machineGun :: Item
+machineGun = bangRod
+    & itName .~ "MACHINEGUN"
+    & itType .~ MACHINEGUN

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

@@ -57,9 +57,10 @@ bangStick i = defaultGun
         , useTimeCheck
         , withSoundItemChoiceStart bangStickSoundChoice
         , useAllAmmo
---        , applyInaccuracy
         , withMuzFlareI
+        , torqueAfterI (0.18 + 0.02 * fromIntegral i)
         , spreadLoaded
+        , applyInaccuracy
         , withRecoilI 25
         ]
     , _itID = Nothing
@@ -71,8 +72,8 @@ bangStick i = defaultGun
         , _bore = 2
         , _gunBarrels = MultiBarrel
             {_brlNum = i
-            ,_brlSpread = SpreadBarrels 0.2
+            ,_brlSpread = SpreadBarrels baseStickSpread
-            ,_brlInaccuracy = 0
+            ,_brlInaccuracy = 0.05
             }
         }
     , _itTweaks = defaultBulletSelTweak
@@ -84,16 +85,33 @@ bangStick i = defaultGun
             {_handlePos =  5
             ,_muzPos    = 10
             }
-        , _dimSPic = \it -> noPic $ baseStickShape
+        , _dimSPic = \it -> noPic $ baseStickShapeX i
             <> stickClip it
         }
     }
+baseStickShapeX :: Int -> Shape
+baseStickShapeX i = foldMap f [0..i-1]
+  where
+    f j = rotateSH ang baseStickShape
+      where
+        ang = fromIntegral j * baseStickSpread - (fromIntegral i - 1) * baseStickSpread * 0.5
+baseStickSpread :: Float
+baseStickSpread = 0.2
+
+baseSMGShape :: Shape
+baseSMGShape = colorSH green $ upperPrismPoly 3 $ rectXH 20 2
+
 baseStickShape :: Shape
 baseStickShape = colorSH green $ upperPrismPoly 3 $ rectXH 10 2
 stickClip :: Item -> Shape
 stickClip it = case it ^? itConsumption . ammoLoaded of
-    Just 0 -> mempty
+    Just x | x > 0 -> foldMap f [0..x-1] 
-    _ -> translateSH (V3 5 0 3) $ upperPrismPoly 1 $ square 1.5
+    _ -> mempty
+  where
+    f i = rotateSH ang $ translateSH (V3 5 0 3) $ upperPrismPoly 2 $ square 1.5
+      where
+        ang = baseStickSpread * fromIntegral i 
+                - 0.5 * baseStickSpread * fromIntegral (_brlNum (_gunBarrels (_itParams it))-1)
 
 revolver :: Item
 revolver = pistol
@@ -133,7 +151,7 @@ machinePistolAfterHamMods =
     , useAmmoAmount 1
     , withSoundStart tap1S 
     , applyInaccuracy
-    , torqueAfterI 0.3
+    , torqueAfterI 0.2
     , withSidePushI 50
     , withRecoilI 20
     , withMuzFlareI
@@ -175,7 +193,7 @@ pistol = (bangStick 1)
         , _gunBarrels = SingleBarrel 0.05
         }
     , _itTweaks = defaultBulletSelTweak
-    } & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> makeClipAt pi (V3 5 2 0) it)
+    } & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it)
 autoPistol :: Item
 autoPistol = pistol 
     & itUse . useMods .~ (ammoCheckI : pistolAfterHamMods)
@@ -193,6 +211,9 @@ smg = autoPistol -- & some parameter affecting stability
     & itName .~ "SMG"
     & itType .~ SMG
     & itUse . useAim . aimStance .~ TwoHandTwist
+    & itDimension . dimPortage . handlePos .~ 2
+    & itDimension . dimSPic .~ \it -> noPic (baseSMGShape
+        <> makeTinClipAt 0 (V3 7 (-2) 0) it)
 revolverX :: Int -> Item
 revolverX i = revolver
     { _itName = "REVx"++show i

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -1,10 +1,5 @@
 module Dodge.Item.Weapon.BulletGuns
-    ( bangRod
+    ( bangCone
-    , elephantGun
-    , amr
-    , sniperRifle
-    , machineGun
-    , bangCone
     , blunderbuss
     , grapeShotCannon
     , grenadeLauncher
@@ -18,9 +13,11 @@ module Dodge.Item.Weapon.BulletGuns
     , longGun
     , module Dodge.Item.Weapon.BulletGun.Stick
     , module Dodge.Item.Weapon.BulletGun.Cane
+    , module Dodge.Item.Weapon.BulletGun.Rod
     ) where
 import Dodge.Item.Weapon.BulletGun.Stick
 import Dodge.Item.Weapon.BulletGun.Cane
+import Dodge.Item.Weapon.BulletGun.Rod
 --import Dodge.Item.Weapon.BulletGun.Clip
 import Dodge.Data
 --import Dodge.ChainEffect
@@ -103,71 +100,6 @@ autoGunPic it = noPic $
   where
     x = fromIntegral $ _ammoLoaded $ _itConsumption it
 
-bangRod :: Item
-bangRod = defaultGun
-    { _itName = "BANGROD"
-    , _itType = BANGROD
-    , _itParams = BulletShooter
-        { _muzVel = 0.8
-        , _rifling = 1
-        , _bore = 2
-        , _gunBarrels = SingleBarrel 0.1
-        }
-    , _itUse = useAmmoParamsRate 6 upHammer
-        [ ammoHammerCheck
-        , useTimeCheck
-        , withSoundStart autoGunS
-        , useAmmoAmount 1
-        , torqueAfterI 0.3
-        , applyInaccuracy
-        , withMuzFlareI
-        , withRecoilI 50
-        ]
-    , _itDimension = ItemDimension
-        { _dimRad = 12
-        , _dimCenter = V3 5 0 0
-        , _dimPortage = HeldItem
-            {_handlePos =  5
-            ,_muzPos    = 30
-            }
-        , _dimSPic = const $ noPic $ colorSH orange $ upperPrismPoly 3 $ rectXH 30 2
-        }
-    } 
-    & itConsumption . reloadType .~ ActiveClear
-    & itUse . useAim . aimSpeed .~ 0.2
-    & itUse . useAim . aimRange .~ 1
-    & itUse . useAim . aimStance .~ TwoHandTwist
-    & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
-elephantGun :: Item
-elephantGun = bangRod
-    & itName .~ "ELEPHANTGUN"
-    & itType .~ ELEPHANTGUN
-    & itUse . useAim . aimStance .~ TwoHandTwist
-    & itParams . gunBarrels .~ SingleBarrel 0.05
-    & itUse . useMods .~
-        [ ammoHammerCheck
-        , useTimeCheck
-        , withSoundStart autoGunS
-        , useAmmoAmount 1
-        , torqueAfterI 0.1
-        , applyInaccuracy
-        , withMuzFlareI
-        , withRecoilI 50
-        ]
-amr :: Item
-amr = elephantGun
-    & itName .~ "AMR"
-    & itType .~ AMR
-    & itConsumption . ammoMax .~ 15
-sniperRifle :: Item
-sniperRifle = elephantGun
-    & itName .~ "SNIPERRIFLE"
-    & itType .~ SNIPERRIFLE
-    & itParams . gunBarrels .~ SingleBarrel 0
-machineGun :: Item
-machineGun = bangRod
-    & itName .~ "MACHINEGUN"
-    & itType .~ MACHINEGUN
 
 bangCone :: Item
 bangCone = defaultGun 

src/Dodge/Item/Weapon/TriggerType.hs

@@ -353,12 +353,12 @@ modClock n chainEff eff it cr w
     | otherwise = eff it cr w
 
 withMuzFlareI :: ChainEffect
-withMuzFlareI f it cr w = makeTlsTimeRadColPos 3 100 (V3 1 1 0.5) flashPos
+withMuzFlareI f it cr w = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) flashPos
     . muzFlareAt (V4 5 5 0 2) flarePos cdir
     $ f it cr w
   where 
-    flarePos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir muzzleOffset
+    flarePos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir (muzzleOffset +.+.+ V3 0 0 20)
-    flashPos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir (muzzleOffset +.+.+ V3 5 0 5)
+    flashPos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir (muzzleOffset +.+.+ V3 5 0 20)
     muzzleOffset = V3 (_muzPos (_dimPortage (_itDimension it))) 0 0
     cdir = _crDir cr
 {- | Applies the effect to a randomly rotated creature,
@@ -452,16 +452,9 @@ spreadLoaded :: ChainEffect
 spreadLoaded eff item cr w = foldr f w dirs
   where
     cd = 0.5 * spread * fromIntegral (numBulLoaded -1)
-    ds = subtract cd . (spread *) . fromIntegral <$> [0 .. numBulLoaded - 1]
+    dirs = subtract cd . (spread *) . fromIntegral <$> [0 .. numBulLoaded - 1]
---    dirs = ds
-    dirs = zipWith (+) 
-        ds
-        (randomRs (-spread,spread) (_randGen w))
     f dir = eff item (cr & crDir +~ dir)
     spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item
---    numBarrels = _brlNum . _gunBarrels $ _itParams item
---    spread = (_spreadAngle . _brlSpread . _gunBarrels $ _itParams item) * loadedSpreadParam
---    loadedSpreadParam = 0.5 * (fromIntegral (numBulLoaded - numBarrels) + 1)
     numBulLoaded = _ammoLoaded $ _itConsumption item
 
 -- pump the updated creature into the chain in later frames

src/Dodge/LevelGen.hs

@@ -1,7 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
--- | deals with placement of objects within the world
--- after they have had their coordinates set by the layout
 module Dodge.LevelGen where
 import Dodge.Data
 import Dodge.Floor

src/Dodge/Magnet.hs

@@ -0,0 +1,10 @@
+module Dodge.Magnet where
+import Dodge.Data
+import Geometry
+
+import Control.Lens
+
+dampField :: Magnet -> Particle -> Particle
+dampField mg pt = case pt of
+    BulletPt{} | dist (head $ _btTrail' pt) (_mgPos mg) < 100 -> pt & btVel' *~ 0.5
+    _ -> pt

src/Dodge/Particle/Bullet/Update.hs

@@ -12,14 +12,13 @@ import Geometry
 
 import Data.Bifunctor
 import Control.Lens
-{-
+{- Update for a generic bullet.  -}
-Update for a generic bullet.
--}
 mvBullet :: World -> Particle -> (World, Maybe Particle)
-mvBullet w bt 
+mvBullet w bt' 
     | t <= 0 || magV (_btVel' bt) < 1 = wAnd Nothing
     | otherwise = second (fmap dodrag) $ hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
   where
+    bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
     dodrag = btVel' %~ (drag *.*)
     drag = _btDrag bt
     wAnd    = (w,)

src/Dodge/Render.hs

@@ -2,8 +2,7 @@
 Contains the central drawing functions for the dodge loop. -}
 module Dodge.Render 
     ( doDrawing
-    )
+    ) where
-  where
 import Dodge.Data
 import Dodge.Render.Picture
 import Dodge.Render.ShapePicture
@@ -32,12 +31,12 @@ import Graphics.GL.Core43
 doDrawing :: RenderData -> Universe -> IO Word32
 doDrawing pdata u = do
     sTicks <- SDL.ticks
-    let w = _uvWorld u
+    let w       = _uvWorld u
-        cfig = _config u
+        cfig    = _config u
         rot     = _cameraRot w
-        camzoom    = _cameraZoom w
+        camzoom = _cameraZoom w
-        trans = _cameraCenter w
+        trans   = _cameraCenter w
-        wins@(V2 winx winy)  = V2 (_windowX cfig) (_windowY cfig)
+        wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
         resFact = resFactorNum $ cfig ^. resolution_factor
         (wallPointsCol,windowPoints) = wallsAndWindows cfig w
         lightPoints     = lightsForGloom w

src/Dodge/Render/HUD.hs

@@ -21,6 +21,7 @@ import ListHelp
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
+import qualified Data.IntSet as IS
 import Control.Lens
 import SDL (MouseButton (..))
 --import Data.List
@@ -42,6 +43,7 @@ drawInGameHUD cfig w = pictures
 inventoryDisplay :: Configuration -> World -> Picture
 inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
     <> equipcursor
+    <> equipcursors
   where
     cr = you w
     inv = _crInv cr
@@ -60,6 +62,9 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
         Nothing -> mempty
         Just invid -> listCursorNES 0 0 cfig (selNumPos invid w) yellow topInvW 
             (selNumSlots invid w)
+    equipcursors = foldMap f (IS.toList $ _crInvEquipped cr)
+      where
+        f ei = listCursorNES 5 5 cfig (selNumPos ei w) blue topInvW (selNumSlots ei w)
     
 
 subInventoryDisplay :: Configuration -> World -> Picture

src/Dodge/Room/Start.hs

@@ -65,13 +65,13 @@ room2 :: RandomGen g => Int -> State g (SubCompTree Room)
 room2 = lasCenSensEdge    
 
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
-startRoom i = join $ uncurry takeOneWeighted $ unzip 
+startRoom _ = join $ uncurry takeOneWeighted $ unzip 
 --    [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
     [ (,) (1::Float) rezBoxesWp
-    , (,) 1 rezBoxesThenWeaponRoom
+--    , (,) 1 rezBoxesThenWeaponRoom
-    , (,) 1 rezBoxThenWeaponRoom
+--    , (,) 1 rezBoxThenWeaponRoom
-    , (,) 1 rezBoxesWpCrit
+--    , (,) 1 rezBoxesWpCrit
-    , (,) 1 $ runPastStart i
+--    , (,) 1 $ runPastStart i
     ]
 
 runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)

src/Dodge/Update.hs

@@ -63,6 +63,7 @@ functionalUpdate cfig w = checkEndGame
     . updateLightSources
     . updateClouds
     . zoneClouds
+    . updateMIM magnets _mgUpdate
     . updateIMl _machines _mcUpdate
     . updateCreatures 
     . updateCreatureGroups
@@ -139,10 +140,8 @@ updateInstantParticles w = case _instantParticles w of
     ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps
         in updateInstantParticles $ w' & particles %~ (catMaybes ps' ++)
 
-updateMachines :: World -> World
+updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
-updateMachines w = foldr f w (_machines w)
+updateMIM f up w = w & f %~ IM.mapMaybe (dbArg up)
-  where
-    f mc = _mcUpdate mc mc
 
 -- Note that this updates the randgen
 updateCreatures :: World -> World
@@ -156,9 +155,6 @@ updateCreatures w = appEndo f $ w
         (f'',cr') = _crUpdate cr cr (w & randGen .~ g)
         (_,g') = genWord8 g
 
-updateDoors :: World -> World
-updateDoors w = IM.foldl' (\w' dr -> _drMech dr dr w') w (_doors w)
-
 ppEvents :: World -> World
 ppEvents w = IM.foldl' (flip $ \pp -> _ppEvent pp pp) w $ _pressPlates w
 

src/Dodge/WorldEvent/Flash.hs

@@ -34,7 +34,7 @@ laserGunFlashAt :: Point3 -> World -> World
 laserGunFlashAt = flareCircleAt yellow 0.2
 
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w = w & particles .:~ theFlare
+muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
   where
     theFlare = Particle
         { _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape