From 3759434d9236f97fbf850fdb44db7bc4cde9e96b Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 7 Jul 2022 08:27:56 +0100 Subject: [PATCH] Make use hammers and item positions slightly more logical --- src/Dodge/Creature/Action.hs | 4 ++-- src/Dodge/Creature/Impulse/UseItem.hs | 5 ++++- src/Dodge/Creature/State.hs | 6 ++++-- src/Dodge/Data.hs | 8 ++++---- src/Dodge/Default/Item.hs | 2 +- src/Dodge/Default/Weapon.hs | 10 ++++------ src/Dodge/Item/Draw.hs | 6 +++--- src/Dodge/Item/Equipment.hs | 9 ++++----- src/Dodge/Item/Equipment/Booster.hs | 4 ++-- src/Dodge/Item/Equipment/Shape.hs | 2 +- src/Dodge/Item/Location.hs | 6 +++--- src/Dodge/Item/Weapon/ExtraEffect.hs | 4 ++-- src/Dodge/Item/Weapon/Grenade.hs | 4 ++-- src/Dodge/Item/Weapon/Launcher.hs | 2 +- src/Dodge/Item/Weapon/TriggerType.hs | 16 ++++++++-------- src/Dodge/Item/Weapon/Utility.hs | 8 +++----- 16 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 8af8ae5a8..fb846d250 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -277,11 +277,11 @@ youDropItem' w = case yourItem w ^? _Just . itCurseStatus of where cr = you w -{- | Copy an inventory item to the floor. -} +{- | Copy an inventory item to the floor. -} copyInvItemToFloor :: Creature -> Int -> World -> World copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) $ _crInv cr IM.! i - & itInvPos .~ Nothing + & itPos .~ VoidItm & itIsHeld .~ False sizeSelf :: Float -> Creature -> World -> Maybe World diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index cbd2495c2..2607399dc 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -5,6 +5,7 @@ module Dodge.Creature.Impulse.UseItem import Dodge.Data import Dodge.Inventory import Dodge.Reloading +import Dodge.Item.Location import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M @@ -43,7 +44,9 @@ tryClickReload :: Creature -> Item -> World -> (World -> World) -> World -> Worl tryClickReload cr it w f | _crID cr == _yourID w && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False = crToggleReloading cr - | otherwise = f + | otherwise = + (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer' .~ HammerDown))) + . f itNeedsLoading :: Item -> Bool itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 62cb44167..10355fff2 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -195,7 +195,7 @@ movementSideEff cr w (randAng,_) = randomR (0,2*pi) $ _randGen w useUpdate :: ItemUse -> ItemUse -useUpdate = (useHammer . hammerPosition %~ moveHammerUp) +useUpdate = (useHammer' %~ moveHammerUp) . (useDelay . warmTime %~ decreaseToZero) . (useDelay . rateTime %~ decreaseToZero) @@ -220,7 +220,9 @@ itemUpdate cr i | i == crSel cr = baseupdate True | otherwise = baseupdate False where - baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate) . (itInvPos ?~ i) . (itIsHeld .~ bool) + baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate) + . (itPos .~ InInv (_crID cr) i) + . (itIsHeld .~ bool) updateAutoRecharge :: Item -> Item updateAutoRecharge it = case _itConsumption it of AutoRecharging l m t p diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f5e3eb558..4f382b8d0 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -465,7 +465,7 @@ data PressPlate = PressPlate } data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int} data ItemPos - = InInv { _ipCrId :: Int , _ipInvId :: Int } + = InInv { _ipCrID :: Int , _ipInvID :: Int } | OnFloor { _ipFlID :: Int } | VoidItm data ItemUse @@ -473,14 +473,14 @@ data ItemUse { _rUse :: Item -> Creature -> World -> World , _useDelay :: UseDelay , _useMods :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World] - , _useHammer' :: HammerPosition + , _useHammer :: HammerPosition , _useAim :: AimParams , _heldScroll :: Float -> Creature -> Item -> Item } | LeftUse { _lUse :: Item -> Creature -> World -> World , _useDelay :: UseDelay - , _useHammer :: HammerType + , _useHammer :: HammerPosition , _eqEq :: Equipment } | ConsumeUse @@ -532,7 +532,7 @@ data Item = Item , _itType :: ItemType , _itAttachment :: ItAttachment , _itID :: Maybe Int - , _itInvPos :: Maybe Int + , _itPos :: ItemPos , _itIsHeld :: Bool , _itEffect :: ItEffect , _itInvSize :: Float diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs index b1ec39395..3a42d6354 100644 --- a/src/Dodge/Default/Item.hs +++ b/src/Dodge/Default/Item.hs @@ -15,7 +15,7 @@ defaultItem = Item , _itIsHeld = False , _itInvColor = yellow , _itInvSize = 1 - , _itInvPos = Nothing + , _itPos = VoidItm , _itDimension = ItemDimension 0 0 NoPortage (const mempty) , _itConsumption = NoConsumption , _itUse = NoUse diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 6257305b0..b316e9ef7 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -74,7 +74,7 @@ defaultlUse :: ItemUse defaultlUse = LeftUse { _lUse = \_ _ -> id , _useDelay = FixedRate {_rateMax = 8, _rateTime = 0} - , _useHammer = NoHammer + , _useHammer = HammerUp , _eqEq = defaultEquip } defaultEquip :: Equipment @@ -88,11 +88,9 @@ defaultEquip = Equipment } luseInstantNoH :: (Item -> Creature -> World -> World) -> ItemUse -luseInstantNoH f = defaultlUse - { _lUse = f - , _useDelay = NoDelay - , _useHammer = NoHammer - } +luseInstantNoH f = defaultlUse + & lUse .~ f + & useDelay .~ NoDelay defaultAimParams :: AimParams defaultAimParams = AimParams { _aimWeight = 0 diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 250e943c4..2fa9114c1 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -29,9 +29,9 @@ pictureWeaponAim -> Creature -> Item -> SPic -pictureWeaponAim f cr itm = case _itInvPos itm of - Just i -> pictureWeaponOnAimItem (f itm) cr i - Nothing -> mempty +pictureWeaponAim f cr itm = case _itPos itm of + InInv _ i -> pictureWeaponOnAimItem (f itm) cr i + _ -> mempty {- | Places an item picture onto a creature when the item is selected. -} pictureWeaponOnAimItem diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 9fecc3a19..d09c32322 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -34,7 +34,6 @@ import qualified IntMapHelp as IM import LensHelp --import ShortShow -import Data.Maybe magShield :: Item magShield = defaultEquipment { _itEquipPict = \_ _ -> (,) emptySH blank @@ -91,7 +90,7 @@ wristArmour = defaultEquipment onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w - & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ EquipID i + & creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i & walls . at i ?~ forceField {_wlID = i} & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr where @@ -99,7 +98,7 @@ onEquipWristShield itm cr w = w onRemoveWristShield :: Item -> Creature -> World -> World onRemoveWristShield itm cr w = w - & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams + & creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams & deleteWallID i where i = _eparamID $ _eqParams $ _eqEq $ _itUse itm @@ -109,7 +108,7 @@ setWristShieldPos itm cr w = w where i = _eparamID $ _eqParams $ _eqEq $ _itUse itm wlline = (f (V3 (-10) 7 0), f (V3 10 7 0)) - invid = fromJust (_itInvPos itm) + invid = _ipInvID (_itPos itm) --wlline = (V2 10 0, V2 (-10) 100) handtrans = case cr ^? crInvEquipped . ix invid of Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g @@ -205,7 +204,7 @@ effectOnOffHeld f f' = ItInvEffectID | crSel cr == invid = f cr invid w | otherwise = f' cr invid w where - invid = fromJust $ _itInvPos itm + invid = _ipInvID $ _itPos itm {- | Increases speed, reduces friction, cannot only move forwards. -} jetPack :: Item diff --git a/src/Dodge/Item/Equipment/Booster.hs b/src/Dodge/Item/Equipment/Booster.hs index ec524646d..b3820ffe9 100644 --- a/src/Dodge/Item/Equipment/Booster.hs +++ b/src/Dodge/Item/Equipment/Booster.hs @@ -38,7 +38,7 @@ boostSelfL x itm cr w = case boostPoint x cr w of Left p -> crEff p (itConsumption . laLoaded .~ 0) Right p -> crEff p (itConsumption . laLoaded -~ 1) where - invid = fromJust $ _itInvPos itm + invid = _ipInvID $ _itPos itm cid = _crID cr cpos = _crPos cr r = _crRad cr @@ -124,5 +124,5 @@ resetAttachmentID = ItInvEffect f 0 | otherwise = w & pointToIt . itEffect . ieCounter -~ 1 where iteff = _itEffect itm - invid = fromJust $ _itInvPos itm + invid = _ipInvID $ _itPos itm pointToIt = creatures . ix (_crID cr) . crInv . ix invid diff --git a/src/Dodge/Item/Equipment/Shape.hs b/src/Dodge/Item/Equipment/Shape.hs index 0c6267a20..3b3601ae7 100644 --- a/src/Dodge/Item/Equipment/Shape.hs +++ b/src/Dodge/Item/Equipment/Shape.hs @@ -15,7 +15,7 @@ spicForWrist :: SPic -> Creature -> Item -> SPic spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4)) pictureOnEquip :: SPic -> Creature -> Item -> SPic pictureOnEquip sp cr itm = fromMaybe mempty $ do - i <- _itInvPos itm + i <- itm ^? itPos . ipInvID epos <- cr^? crInvEquipped . ix i return $ equipPosition epos cr sp equipPosition :: EquipPosition -> Creature -> SPic -> SPic diff --git a/src/Dodge/Item/Location.hs b/src/Dodge/Item/Location.hs index badfc16f5..e3cce2f0e 100644 --- a/src/Dodge/Item/Location.hs +++ b/src/Dodge/Item/Location.hs @@ -28,10 +28,10 @@ getItem itid w = do case itpos of OnFloor flitid -> w ^? floorItems . ix flitid . flIt InInv cid invid -> w ^? creatures . ix cid . crInv . ix invid + VoidItm -> Nothing pointToItem :: Applicative f => - ItemPos -> (Item -> f Item) -> World -> f World + ItemPos -> (Item -> f Item) -> World -> f World pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid pointToItem (OnFloor flid) = floorItems . ix flid . flIt - ---itToPointer :: Item -> +pointToItem _ = const pure diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 0a95db6fc..f839b6e37 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -40,11 +40,11 @@ import qualified SDL autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World autoEffect eff t sid itm cr w | _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w - & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) + & creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) . itUse . eqEq . eqParams . eparamInt .~ t & soundStart OnceSound (_crPos cr) sid Nothing | otherwise = w - & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) + & creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm) . itUse . eqEq . eqParams . eparamInt -~ 1 {- | Automatically send out radar pulses that detect walls. -} diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 4b90930ec..f8482b2ad 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -121,10 +121,10 @@ throwArmReset x = ItInvEffect {_ieInv = f ,_ieCounter = x } where f itm cr = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i where - i = fromJust $ _itInvPos itm + i = _ipInvID $ _itPos itm counterDown it | _ieCounter (_itEffect it) == 0 = it - & itUse . useHammer . hammerPosition .~ HammerUp + & itUse . useHammer' .~ HammerUp & itEquipPict .~ pictureWeaponAim (\_ -> grenadePic 50) | otherwise = it & itEffect . ieCounter -~ 1 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 3da4c73b9..0152e22fa 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -322,7 +322,7 @@ moveRemoteShell cid itid pj w newPos = oldPos +.+ vel newdir | SDL.ButtonRight `M.member` _mouseButtons w - && w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvId + && w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvID = _cameraRot w + argV (_mousePos w) | otherwise = _pjDir pj accel = rotateV newdir (V2 2 0) diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index e27e44e33..35e5141b7 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -137,14 +137,14 @@ ammoHammerCheck :: ChainEffect ammoHammerCheck eff it cr w | _laLoaded ic <= 0 || not (_laPrimed ic) = w -- fromMaybe w (startReloadingWeapon cr w) & setHammerDown - | otherwise = case it ^? itUse . useHammer . hammerPosition of + | otherwise = case it ^? itUse . useHammer' of Just HammerUp -> eff it cr $ setHammerDown w & creatures . ix (_crID cr) %~ crCancelReloading _ -> setHammerDown w where ic = _itConsumption it cid = _crID cr setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse - . useHammer . hammerPosition .~ HammerDown + . useHammer' .~ HammerDown itUseCharge :: Int -> Item -> Item itUseCharge x = itConsumption . arLoaded %~ (max 0 . subtract x) @@ -307,13 +307,13 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of userate = fromMaybe 0 $ item ^? itUse . useDelay . rateMax {- | Applies a world effect after a hammer position check. -} hammerCheckI :: ChainEffect -hammerCheckI f it cr w = case it ^? itUse . useHammer . hammerPosition of +hammerCheckI f it cr w = case it ^? itUse . useHammer' of Just HammerUp | _laPrimed (_itConsumption it) -> f it cr $ setHammerDown w _ -> setHammerDown w where cid = _crID cr setHammerDown = creatures . ix cid . crInv . ix (crSel cr) . itUse - . useHammer . hammerPosition .~ HammerDown + . useHammer' .~ HammerDown {- | Applies a world effect after an ammo check. -} -- this should be made "safe" incase there is no _rateTime ammoUseCheck :: ChainEffect @@ -336,14 +336,14 @@ Arbitrary inventory position. -} hammerCheckL :: (Item -> Creature -> World -> World) -- ^ Underlying effect -> Item -> Creature -> World -> World -hammerCheckL f itm cr w = case itm ^? itUse . useHammer . hammerPosition of +hammerCheckL f itm cr w = case itm ^? itUse . useHammer' of Just HammerUp -> f itm cr $ setHammerDown w _ -> setHammerDown w where cid = _crID cr - invid = fromJust $ _itInvPos itm + invid = _ipInvID $ _itPos itm setHammerDown = creatures . ix cid . crInv . ix invid - . itUse . useHammer . hammerPosition .~ HammerDown + . itUse . useHammer' .~ HammerDown {- | Applies a world effect after an ammo check. Arbitrary inventory position -- cannot be replaced with ammoUseCheck. -} shootL @@ -361,7 +361,7 @@ shootL f item cr w | otherwise = w where cid = _crID cr - invid = fromJust $ _itInvPos item + invid = _ipInvID $ _itPos item pointerToItem = creatures . ix cid . crInv . ix invid fireCondition = _rateTime (_useDelay (_itUse item)) == 0 && _arLoaded (_itConsumption item) > 0 diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 942c33bb4..beff845fe 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -41,7 +41,7 @@ rewindEffect itm cr w | otherwise = w & rewindWorlds .~ [] & ptrWpCharge .~ 0 where - invid = fromJust $ _itInvPos itm + invid = _ipInvID $ _itPos itm ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge maxcharge = _wpMaxCharge . _itConsumption $ itm w' = w & rewindWorlds .~ [] @@ -65,7 +65,6 @@ useRewindGun _ _ w = case _rewindWorlds w of shrinkGun :: Item shrinkGun = defaultLeftItem {_itUse = defaultlUse {_lUse = hammerCheckL useShrinkGun} - & useHammer .~ upHammer -- , _itFloorPict = shrinkGunPic , _itAttachment = AttachBool True } @@ -82,7 +81,7 @@ useShrinkGun it cr w = if _atBool $ _itAttachment it then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr where - invid = fromJust $ _itInvPos it + invid = _ipInvID $ _itPos it tryResize x g = maybe w g $ sizeSelf x cr w f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix invid %~ ( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) ) @@ -92,7 +91,6 @@ blinkGun = defaultLeftItem { _itInvColor = cyan , _itUse = defaultlUse & lUse .~ hammerCheckL (shootL $ const blinkAction) - & useHammer .~ upHammer & eqEq . eqSite .~ GoesOnWrist -- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2 } @@ -137,7 +135,7 @@ useForceFieldGun itm cr w = fromMaybe w $ do wlline = (a,b) return $ w & walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i} - & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itParams . paramMID ?~ i + & creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i & moveWallIDUnsafe i wlline where i = fromMaybe (IM.newKey (_walls w)) $ itm ^? itParams . paramMID . _Just