diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index aaef8f68e..b6014e588 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/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 diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index 4426ca70e..dad8d93b0 100644 --- a/src/Dodge/Data/Item.hs +++ b/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) diff --git a/src/Dodge/Data/Item/HeldUse.hs b/src/Dodge/Data/Item/HeldUse.hs index 19c86ca4b..3e5982343 100644 --- a/src/Dodge/Data/Item/HeldUse.hs +++ b/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 diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index f7bee4437..0aad7ba60 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/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 diff --git a/src/Dodge/Data/Laser.hs b/src/Dodge/Data/Laser.hs index 972e39916..4c6941d55 100644 --- a/src/Dodge/Data/Laser.hs +++ b/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) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 1bc58fed9..c990e4b7c 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Euse.hs b/src/Dodge/Euse.hs index 0c11e3598..a2e3f7903 100644 --- a/src/Dodge/Euse.hs +++ b/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 diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 78482b80d..9463d0740 100644 --- a/src/Dodge/Item/Display.hs +++ b/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 diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 38bb8e10f..f5e5b0b28 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/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 = diff --git a/src/Dodge/Laser/Draw.hs b/src/Dodge/Laser/Draw.hs index 76d5ea5b4..96103d3a3 100644 --- a/src/Dodge/Laser/Draw.hs +++ b/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 diff --git a/src/Dodge/Laser/Update.hs b/src/Dodge/Laser/Update.hs index b3f0559a0..44684d244 100644 --- a/src/Dodge/Laser/Update.hs +++ b/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 diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs index 8ddda922e..da575f768 100644 --- a/src/Dodge/Particle/Draw.hs +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 467cdf85f..117f44885 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index eec56e353..7c8103ba9 100644 --- a/src/Dodge/Update.hs +++ b/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