Commit before moving targeting

src/Dodge/Data/CWorld.hs

@@ -17,6 +17,7 @@ import Data.Aeson.TH
 import Dodge.GameRoom
 import Geometry.ConvexPoly
 import Dodge.Data.CamPos
+import qualified Data.IntSet as IS
 
 data CWorld = CWorld
     { _lWorld :: LWorld
@@ -25,6 +26,7 @@ data CWorld = CWorld
     , _cClock :: Int
     , _pastWorlds :: [LWorld]
     , _timeFlow :: TimeFlowStatus
+    , _seenWalls :: IS.IntSet
     }
 
 data TimeFlowStatus

src/Dodge/Data/Item.hs

@@ -46,7 +46,6 @@ data Item = Item
     , _itCurseStatus :: CurseStatus
     , _itTweaks :: ItemTweaks
     , _itScope :: Scope
-    --, _itValue :: ItemValue
     , _itParams :: ItemParams
     }
     --deriving (Eq, Show, Read) --Generic, Flat)

src/Dodge/Data/Item/HeldUse.hs

@@ -9,6 +9,7 @@ import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.CamouflageStatus
 import Dodge.Data.Item.Combine
+import Control.Lens
 
 data Huse
     = HeldDoNothing
@@ -35,13 +36,14 @@ data Cuse
 
 data Euse
     = EDoNothing
-    | EDetector Detector
+    | EDetector {_euseDetector :: Detector}
     | EMagShield
     | EWristShield
     | EHeadLamp
-    | ECamouflage CamouflageStatus
+    | ECamouflage {_euseCamouflageStatus :: CamouflageStatus}
     | EonWristShield
     | EoffWristShield
+    | EFuelSource {_euseFuelAmount :: Int, _euseFuelMax :: Int}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Luse
@@ -93,6 +95,7 @@ data HeldMod
     | BangConeMod
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+makeLenses ''Euse
 deriveJSON defaultOptions ''Cuse
 deriveJSON defaultOptions ''HeldMod
 deriveJSON defaultOptions ''Euse

src/Dodge/Data/LWorld.hs

@@ -126,7 +126,6 @@ data LWorld = LWorld
     , _linearShockwaves :: IM.IntMap LinearShockwave
     , _tractorBeams :: [TractorBeam]
     , _walls :: IM.IntMap Wall
-    , _seenWalls :: IS.IntSet
     , _wallDamages :: IM.IntMap [Damage]
     , _doors :: IM.IntMap Door
     , _machines :: IM.IntMap Machine

src/Dodge/Data/Laser.hs

@@ -26,9 +26,9 @@ data LaserStart = LaserStart
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Laser = Laser
-    { _laColor :: Color
-    , _laPoints :: [Point2]
-    , _laType :: LaserType
+    { _lzColor :: Color
+    , _lzPoints :: [Point2]
+    , _lzType :: LaserType
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Default/World.hs

@@ -75,6 +75,7 @@ defaultCWorld =
         , _cClock = 0
         , _pastWorlds = []
         , _timeFlow = NormalTimeFlow
+        , _seenWalls = mempty
         }
 
 defaultLWorld :: LWorld
@@ -110,7 +111,6 @@ defaultLWorld =
         , _tractorBeams = mempty
         , _linearShockwaves = mempty
         , _walls = IM.empty
-        , _seenWalls = mempty
         , _wallDamages = IM.empty
         , _blocks = IM.empty
         , _machines = IM.empty

src/Dodge/Euse.hs

@@ -1,5 +1,7 @@
 module Dodge.Euse where
 
+import Control.Monad
+import Data.Maybe
 import Dodge.LightSource
 import Dodge.Item.HeldOffset
 import Dodge.Wall.Create
@@ -29,6 +31,29 @@ useE eo = case eo of
     ECamouflage vis -> overCID (crCamouflage .~ vis)
     EonWristShield -> onEquipWristShield
     EoffWristShield -> onRemoveWristShield
+    EFuelSource 0 _ -> const . const id
+    EFuelSource {} -> trySiphonFuel
+
+trySiphonFuel :: Item -> Creature -> World -> World
+trySiphonFuel itm cr w = fromMaybe w $ do
+    eix <- itm ^? itLocation . ipInvID
+    hix <- cr ^? crInvSel . iselPos
+    guard (cr ^? crInvSel . iselAction == Just NoInvSelAction)
+    la <- cr ^? crInv . ix hix . itUse . heldConsumption
+    atype <- la ^? laAmmoType
+    guard (isGas atype)
+    amax <- la ^? laMax
+    acur <- la ^? laLoaded
+    guard (amax > acur)
+    return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ 
+            ( (ix hix . itUse . heldConsumption . laLoaded +~ 1)
+            . (ix eix . itUse . equipEffect . eeUse . euseFuelAmount -~ 1)
+            )
+
+isGas :: AmmoType -> Bool
+isGas a = case a of
+    GasAmmo {} -> True
+    _ -> False
 
 useMagShield :: Item -> Creature -> World -> World
 useMagShield it cr w = w & cWorld . lWorld . magnets . at mgid ?~ themagnet

src/Dodge/Item/Display.hs

@@ -75,9 +75,14 @@ showConsumption :: ItemUse -> String
 showConsumption iu = case iu of
     HeldUse{} -> showReloadProgress' (_heldConsumption iu)
     LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
-    EquipUse{} -> ""
+    EquipUse ee -> showEUseNumber ee
     _ -> show $ iu ^?! useAmount . getItAmount
 
+showEUseNumber :: EquipEffect -> String
+showEUseNumber ee = case _eeUse ee of
+    EFuelSource x _ -> show x
+    _ -> ""
+
 showReloadProgress' :: HeldConsumption -> String
 showReloadProgress' ic = case ic ^? laProgress . _Just . ix 0 of
     Nothing -> show $ _laLoaded ic

src/Dodge/Item/Equipment.hs

@@ -65,6 +65,7 @@ fuelPack =
         & itUse . equipEffect . eeSite .~ GoesOnBack
         & itType . iyBase .~ EQUIP FUELPACK
         & itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
+        & itUse . equipEffect . eeUse .~ EFuelSource 10000 10000
 
 jetPack :: Item
 jetPack =

src/Dodge/Laser/Draw.hs

@@ -10,5 +10,5 @@ drawLaser pt =
             [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
             ]
   where
-    col = _laColor pt
-    ps = _laPoints pt
+    col = _lzColor pt
+    ps = _lzPoints pt

src/Dodge/Laser/Update.hs

@@ -10,7 +10,7 @@ import Geometry
 updateLaser :: World -> LaserStart -> (World, Laser)
 updateLaser w pt =
     ( w'
-    , Laser{_laPoints = sp : ps, _laColor = _lpColor pt, _laType = _lpType pt}
+    , Laser{_lzPoints = sp : ps, _lzColor = _lpColor pt, _lzType = _lpType pt}
     )
   where
     w' = fromMaybe w $ do

src/Dodge/Particle/Draw.hs

@@ -11,5 +11,5 @@ drawTargetLaser pt =
             , setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp : ps)
             ]
   where
-    col = _laColor pt
-    (sp : ps) = _laPoints pt
+    col = _lzColor pt
+    (sp : ps) = _lzPoints pt

src/Dodge/Render/HUD.hs

@@ -364,7 +364,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
 mapOverlay :: Configuration -> World -> [Picture]
 mapOverlay cfig w =
     (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
-    [foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (lw ^. seenWalls)]
+    [foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
     --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
   where
     lw = w ^. cWorld . lWorld

src/Dodge/Update.hs

@@ -6,7 +6,6 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
---import Dodge.Inventory.SelectionList
 import Color
 import Control.Applicative
 import Data.List
@@ -654,7 +653,7 @@ updateSeenWalls :: World -> World
 updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
 
 markWallSeen :: World -> Int -> World
-markWallSeen w i = w & cWorld . lWorld . seenWalls . at i .~ Just ()
+markWallSeen w i = w & cWorld . seenWalls . at i .~ Just ()
 --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i
 -- in the past there might have been a space leak, which the following was meant
 -- to fix