Tweak "magnets" that affect bullet movement

src/Dodge/Bullet.hs

@@ -10,7 +10,6 @@ import Data.Maybe
 import Dodge.Creature.Test
 import Dodge.Data.World
 import Dodge.EnergyBall
-import Dodge.MagnetBuBu
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.ThingsHit
@@ -35,7 +34,22 @@ updateBullet w bu
 
 applyMagnetsToBul :: Bullet -> World -> Bullet
 applyMagnetsToBul bu =
-    foldl' (flip doMagnetBuBu) bu . _magnets . _lWorld . _cWorld
+    foldl' (flip doMagnetBuBu) bu . _oldMagnets . _lWorld . _cWorld
+
+doMagnetBuBu :: Magnet -> Bullet -> Bullet
+doMagnetBuBu mg bu = case _mgField mg of
+    MagnetAlign | isclose -> bu
+    MagnetDeflect | isclose -> bu & buVel %~ vecTurnTo (50 * pi / d) bpos mgdeflectpos
+    _ -> bu
+  where
+    bvel = bu ^. buVel
+    mpos = mg ^. mgPos
+    bpos = bu ^. buPos
+    mgdeflectpos
+        | isLHS mpos (mpos + bvel) bpos = bpos + vNormal (bpos - mpos)
+        | otherwise = bpos - vNormal (bpos - mpos)
+    d = dist (bu ^. buPos) (mg ^. mgPos)
+    isclose = d < 100
 
 updateBulVel :: Bullet -> Bullet
 updateBulVel bt = case _buTrajectory bt of

src/Dodge/Creature.hs

@@ -286,6 +286,7 @@ testInventory =
 stackedInventory :: [Item]
 stackedInventory =
     [ torch
+    , magShield
     , bangCone
     , megaTinMag 100
     , augmentedHUD

src/Dodge/Data/LWorld.hs

@@ -122,7 +122,8 @@ data LWorld = LWorld
     , _doors :: IM.IntMap Door
     , _machines :: IM.IntMap Machine
     , _terminals :: IM.IntMap Terminal
-    , _magnets :: IM.IntMap Magnet
+    , _oldMagnets :: [Magnet]
+    , _magnets :: [Magnet]
     , _blocks :: IM.IntMap Block
     , _coordinates :: IM.IntMap Point2
     , _triggers :: IM.IntMap Bool

src/Dodge/Data/Machine.hs

@@ -50,7 +50,7 @@ data MachineType
     = McStatic
     | McTerminal
     | McSensor Sensor
-    | McTurret Turret
+    | McTurret {_mctTurret :: Turret}
     --deriving (Eq, Show, Read) --, Generic)
     --hderiving (Eq, Show, Read) --Generic, Flat)
 
@@ -63,6 +63,7 @@ data Turret = Turret
     --deriving (Eq, Show, Read) --, Generic)
     --hderiving (Eq, Show, Read) --Generic, Flat)
 
+makeLenses ''MachineType
 makeLenses ''Machine
 makeLenses ''Turret
 makePrisms ''MachineType

src/Dodge/Data/Magnet.hs

@@ -14,14 +14,12 @@ newtype MagnetUpdate = MagnetUpdateTimer Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data MagnetBuBu
-    = MagnetBuId
-    | MagnetBuBuCurveAroundField Float Float
+    = MagnetAlign
+    | MagnetDeflect
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Magnet = Magnet
-    { _mgID :: Int
-    , _mgUpdate :: MagnetUpdate
-    , _mgPos :: Point2
+    { _mgPos :: Point2
     , _mgField :: MagnetBuBu
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Default/World.hs

@@ -94,7 +94,8 @@ defaultCWorld =
 defaultLWorld :: LWorld
 defaultLWorld =
     LWorld
-        { _magnets = IM.empty
+        { _magnets = mempty
+        , _oldMagnets = mempty
         , _modifications = IM.empty
         , _creatures = IM.empty
         , _creatureGroups = IM.empty

src/Dodge/Euse.hs

@@ -43,18 +43,14 @@ useE loc cr = case eo of
     eo = itm ^? itUse . uequipEffect . eeUse
 
 useMagShield :: Item -> Creature -> World -> World
-useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet
+useMagShield _ cr w = w & cWorld . lWorld . magnets .:~ themagnet
   where
     themagnet =
         Magnet
-            { _mgID = mgid
-            , _mgUpdate = MagnetUpdateTimer 1
-            , _mgPos = _crPos cr
-            , _mgField = MagnetBuBuCurveAroundField 50 200
+            { _mgPos = _crPos cr
+            --, _mgField = MagnetBuBuCurveAroundField 50 200
+            , _mgField = MagnetDeflect
             }
-    mgid = case it ^? itParams . magShieldMgMIX . _Just of
-        Just mgid' -> mgid'
-        Nothing -> IM.newKey $ w ^. cWorld . lWorld . magnets
 
 onEquipWristShield :: Item -> Creature -> World -> World
 onEquipWristShield itm cr w =

src/Dodge/HeldUse.hs

@@ -492,7 +492,7 @@ makeBullet thebullet itm cr mz w =
 mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
 mcUseHeld hit = case hit of
     LASER -> mcShootLaser
-    _ -> \_ _ -> id
+    _ -> mcShootAuto
 
 useGasParams :: Maybe Int -> Muzzle -> Item -> Creature -> World -> World
 useGasParams mmagid mz itm cr w =
@@ -554,6 +554,9 @@ mcShootLaser _ mc = cWorld . lWorld . lasers .:~ lasRayAt yellow dam phasev pos
     phasev = 1
     dam = 11
 
+mcShootAuto :: Item -> Machine -> World -> World
+mcShootAuto _ _ = id
+
 -- | assumes that the item is held
 shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World
 shootTeslaArc itm cr mz w =

src/Dodge/Magnet.hs

@@ -1,33 +0,0 @@
-module Dodge.Magnet where
-
-import Control.Lens
-import Dodge.Data.Bullet
-import Dodge.Data.Magnet
-import Geometry
-
-dampField :: Magnet -> Bullet -> Bullet
-dampField mg pt = case pt of
-    Bullet{} | dist (_buPos pt) (_mgPos mg) < 100 -> pt & buVel *~ 0.5
-    _ -> pt
-
-curveLeftField :: Magnet -> Bullet -> Bullet
-curveLeftField mg pt = case pt of
-    Bullet{} | dist (_buPos pt) (_mgPos mg) < 500 -> pt & buVel %~ rotateV 0.2
-    _ -> pt
-
-curveAroundField :: Float -> Float -> Magnet -> Bullet -> Bullet
-curveAroundField minrad maxrad mg pt = case pt of
-    Bullet{} | thedist < maxrad -> pt & buVel %~ rotateToCircle
-      where
-        thedist = dist btpos mgpos
-        mgpos = _mgPos mg
-        btpos = _buPos 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
-            | thedist < minrad = 0.5
-            | otherwise = 0.5 * ((maxrad - thedist) / (maxrad - minrad)) ** 2
-    _ -> pt

src/Dodge/Magnet/Update.hs

@@ -1,10 +0,0 @@
-module Dodge.Magnet.Update where
-
-import Control.Lens
-import Dodge.Data.Magnet
-
-doMagnetUpdate :: MagnetUpdate -> Magnet -> Maybe Magnet
-doMagnetUpdate mu = case mu of
-    MagnetUpdateTimer i
-        | i < 1 -> const Nothing
-        | otherwise -> Just . (mgUpdate .~ MagnetUpdateTimer (i - 1))

src/Dodge/MagnetBuBu.hs

@@ -1,11 +0,0 @@
-module Dodge.MagnetBuBu
-    where
-import Dodge.Magnet
-import Dodge.Data.Bullet
-import Dodge.Data.Magnet
-
-doMagnetBuBu :: Magnet -> Bullet -> Bullet
-doMagnetBuBu mg = case _mgField mg of
-    MagnetBuId -> id
-    MagnetBuBuCurveAroundField x y -> curveAroundField x y mg
-

src/Dodge/Placement/Instance/Turret.hs

@@ -20,12 +20,14 @@ putLasTurret rotSpeed =
             )
             defaultMachineWall
 
+turret :: Item -> MachineType
+turret wp = lasTurret & mctTurret . tuWeapon .~ wp
+
 lasTurret :: MachineType
 lasTurret = McTurret $
     Turret
         { _tuWeapon = laser
-        , --    { _tuWeapon = autoRifle
-          _tuTurnSpeed = 0.1
+        , _tuTurnSpeed = 0.1
         , _tuFireTime = 0
         , _tuDir = 0
         }

src/Dodge/TestString.hs

@@ -27,7 +27,9 @@ import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
 testStringInit u = 
-    map show $ M.toList $ u ^. uvWorld . input . pressedKeys
+    (map show $ u ^.. uvWorld . cWorld . lWorld . oldMagnets)
+    <>
+    (map show $ u ^.. uvWorld . cWorld . lWorld . bullets)
 --  fromMaybe mempty $ do
 --        cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
 --        let itms = IM.elems $ cr ^. crInv

src/Dodge/Update.hs

@@ -30,7 +30,6 @@ import Dodge.Laser.Update
 import Dodge.LinearShockwave.Update
 import Dodge.ListDisplayParams
 import Dodge.Machine.Update
-import Dodge.Magnet.Update
 import Dodge.Menu
 import Dodge.ModificationEffect
 import Dodge.PosEvent
@@ -251,10 +250,12 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
         _ <- w ^? timeFlow . scrollItemID . unNInt
         return id -- pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
 
+
 -- | The update step.
 functionalUpdate :: Universe -> Universe
 functionalUpdate u =
     checkEndGame
+        . over (uvWorld . cWorld . lWorld) updateMagnets
         . over uvWorld (cWorld . lWorld . lClock +~ 1)
         . over uvWorld updateDistortions
         . over uvWorld updateCreatureSoundPositions
@@ -282,7 +283,6 @@ functionalUpdate u =
         . over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile)
         . over uvWorld updateClouds
         . over uvWorld updateGusts
-        . over uvWorld (updateMIM (cWorld . lWorld . magnets) (doMagnetUpdate . _mgUpdate))
         . over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) tmUpdate)
         --    . updateIMl _machines mcChooseUpdate
         . over uvWorld (updateIMl' (_machines . _lWorld . _cWorld) updateMachine)
@@ -304,6 +304,10 @@ functionalUpdate u =
         . set (uvWorld . cWorld . lWorld . lights) []
         $ over uvWorld updatePastWorlds u
 
+updateMagnets :: LWorld -> LWorld
+updateMagnets lw = lw & oldMagnets .~ (lw ^. magnets)
+    & magnets .~ mempty
+
 checkTermDist :: World -> World
 checkTermDist w = fromMaybe w $ do
     tmid <- w ^? hud . hudElement . subInventory . termID
@@ -657,8 +661,8 @@ updateInstantBullets w = case w ^. cWorld . lWorld . instantBullets of
 --    ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps
 --        in updateInstantParticles $ w' & particles .++~ catMaybes ps'
 
-updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
-updateMIM f up = f %~ IM.mapMaybe (dbArg up)
+--updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
+--updateMIM f up = f %~ IM.mapMaybe (dbArg up)
 
 -- Note that this updates the randgen
 --updateCreatures :: World -> World

src/Dodge/Update/Camera.hs

@@ -31,7 +31,7 @@ update where your avatar's view is from.  -}
 updateCamera :: Configuration -> World -> World
 updateCamera cfig w = case w ^. wCam . camControl of
     CamInGame {} -> updateInGameCamera cfig w
-    CamFloat -> updateFloatingCamera cfig w
+    CamFloat -> rotateCamera cfig $ updateFloatingCamera cfig w
 
 updateFloatingCamera :: Configuration -> World -> World
 updateFloatingCamera cfig w =