From c354949ca9c455809b66fe391d0f914c243022ca Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 7 Feb 2023 12:07:13 +0000 Subject: [PATCH] Partially working change to selected items --- src/Dodge/Base/You.hs | 8 +- src/Dodge/Creature/Action.hs | 61 +++--- src/Dodge/Creature/Impulse.hs | 2 +- src/Dodge/Creature/Impulse/UseItem.hs | 52 +++-- src/Dodge/Creature/ReaderUpdate.hs | 11 +- src/Dodge/Creature/State.hs | 17 +- src/Dodge/Creature/Statistics.hs | 4 +- src/Dodge/Creature/Test.hs | 11 +- src/Dodge/Creature/YourControl.hs | 28 ++- src/Dodge/Data/Creature.hs | 4 +- .../Data/Item/Use/Consumption/LoadAction.hs | 12 +- src/Dodge/Default/Creature.hs | 2 +- src/Dodge/Euse.hs | 4 +- src/Dodge/HeldScroll.hs | 5 +- src/Dodge/HeldUse.hs | 7 +- src/Dodge/Inventory.hs | 204 ++++++++++-------- src/Dodge/Inventory/Add.hs | 3 +- src/Dodge/Inventory/SelectionList.hs | 44 ++-- src/Dodge/Item/Display.hs | 2 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 12 +- src/Dodge/Item/Weapon/TriggerType.hs | 29 ++- src/Dodge/Luse.hs | 3 +- src/Dodge/Projectile/Update.hs | 2 +- src/Dodge/Reloading.hs | 54 +++-- src/Dodge/Render/HUD.hs | 66 +++--- src/Dodge/Update/Camera.hs | 24 ++- src/Dodge/Update/Scroll.hs | 3 +- 27 files changed, 386 insertions(+), 288 deletions(-) diff --git a/src/Dodge/Base/You.hs b/src/Dodge/Base/You.hs index c470d2818..afde250ad 100644 --- a/src/Dodge/Base/You.hs +++ b/src/Dodge/Base/You.hs @@ -11,10 +11,12 @@ youc :: CWorld -> Creature youc w = w ^?! lWorld . creatures . ix 0 yourItem :: World -> Maybe Item -yourItem w = _crInv (you w) IM.!? crSel (you w) +yourItem w = do + i <- you w ^? crInvSel . isel . ispItem + _crInv (you w) IM.!? i yourInv :: World -> IM.IntMap Item yourInv = _crInv . you -yourInvSel :: World -> Int -yourInvSel = crSel . you +--yourInvSel :: World -> Int +--yourInvSel = crSel . you diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 63cd7b0d4..816ceaddb 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -3,9 +3,9 @@ -- | Actions performed by creatures within the world module Dodge.Creature.Action ( performActions, - stripNoItems, +-- stripNoItems, setMinInvSize, - dropUnselected, +-- dropUnselected, dropExcept, dropItem, blinkActionMousePos, @@ -19,7 +19,7 @@ module Dodge.Creature.Action ( ) where import Data.Bifunctor -import Data.List (findIndex) +--import Data.List (findIndex) import Data.Maybe import Dodge.Base import Dodge.Creature.Action.Blink @@ -36,6 +36,7 @@ import Dodge.WallCreatureCollisions import Geometry import qualified IntMapHelp as IM import LensHelp +import Control.Monad performActions :: World -> Creature -> Creature performActions w cr = @@ -147,29 +148,29 @@ performAction cr w ac = case ac of setMinInvSize :: Int -> Creature -> World -> World setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n --- maybe this should be removed... -stripNoItems :: Creature -> World -> World -stripNoItems cr = - organiseInvKeys (_crID cr) - . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just) +---- maybe this should be removed... +--stripNoItems :: Creature -> World -> World +--stripNoItems cr = +-- organiseInvKeys (_crID cr) +-- . (cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just) +-- +--organiseInvKeys :: Int -> World -> World +--organiseInvKeys cid w = +-- w & cWorld . lWorld . creatures . ix cid +-- %~ ( (crInvSel . iselPos .~ newSelKey) +-- . (crInv .~ newInv) +-- . (crInvSel . iselAction .~ NoInvSelAction) +-- ) +-- where +-- cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid +-- pairs = IM.toList (_crInv cr) +-- newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs +-- newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs -organiseInvKeys :: Int -> World -> World -organiseInvKeys cid w = - w & cWorld . lWorld . creatures . ix cid - %~ ( (crInvSel . iselPos .~ newSelKey) - . (crInv .~ newInv) - . (crInvSel . iselAction .~ NoInvSelAction) - ) - where - cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid - pairs = IM.toList (_crInv cr) - newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs - newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs - -dropUnselected :: Creature -> World -> World -dropUnselected cr w = - foldr (dropItem cr) w . IM.keys $ - crSel cr `IM.delete` _crInv cr +--dropUnselected :: Creature -> World -> World +--dropUnselected cr w = +-- foldr (dropItem cr) w . IM.keys $ +-- crSel cr `IM.delete` _crInv cr dropExcept :: Creature -> Int -> World -> World dropExcept cr invid w = @@ -188,11 +189,11 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . maybe -- | Get your creature to drop the item under the cursor. youDropItem :: World -> World -youDropItem w - | _crInvLock (you w) || cursed = w - | otherwise = - w - & dropItem cr (crSel cr) +youDropItem w = fromMaybe w $ do + curpos <- you w ^? crInvSel . isel . ispItem + guard $ not $ _crInvLock (you w) || cursed + return $ w + & dropItem cr curpos & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing where cr = you w diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 8ef26cab8..1a7dd5724 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -47,7 +47,7 @@ followImpulse cr w imp = case imp of TurnTo p -> crup $ creatureTurnTo p cr ChangePosture post -> crup $ cr & crStance . posture .~ post UseItem -> (useItem cr, cr) - SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction + SwitchToItem i -> crup $ cr & crInvSel .~ InvSel (SelItem i NoInvSelAction) Melee cid' -> ( hitCr cid' , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20 diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index f30d1a86c..52abaae1a 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -4,6 +4,7 @@ module Dodge.Creature.Impulse.UseItem ( itemEffect, ) where +import Control.Monad import Data.Foldable import Control.Lens import qualified Data.Map.Strict as M @@ -22,7 +23,8 @@ import qualified SDL useItem :: Creature -> World -> World useItem cr' w = fromMaybe (f w) $ do cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr') - it <- cr ^? crInv . ix (crSel cr) + itRef <- cr ^? crInvSel . isel . ispItem + it <- cr ^? crInv . ix itRef return $ itemEffect cr it w where f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown @@ -34,9 +36,10 @@ itemEffect cr it w = case it ^. itUse of LeftUse{} -> doequipmentchange EquipUse{} -> doequipmentchange -- ConsumeUse will cause problems if the item is not selected - (ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr) + (ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) itRef CraftUse{} -> setuhamdown w where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change hammerTest f = case _crHammerPosition cr of HammerUp -> f w _ -> w & setuhamdown @@ -44,7 +47,7 @@ itemEffect cr it w = case it ^. itUse of doequipmentchange = setuhamdown $ hammerTest - ( toggleEquipmentAt (_rbOptions w) (crSel cr) cr + ( toggleEquipmentAt (_rbOptions w) itRef cr . activateEquipmentAt (_rbOptions w) cr ) @@ -105,29 +108,34 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of where crpoint = cWorld . lWorld . creatures . ix (_crID cr) itmat i = _crInv cr IM.! i - itm = itmat (crSel cr) + itm = itmat itRef + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm' onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm' useLeftItem :: Int -> World -> World -useLeftItem cid w - | _crInvLock cr = w - | itmIsConsumable = useItem cr w -- I believe this ONLY sets equipment options - | itmIsEquipable = useItem cr w -- I believe this ONLY sets equipment options - | otherwise = fromMaybe w $ do - invid <- cr ^. crLeftInvSel . lisMPos - itm <- cr ^? crInv . ix invid - f <- cr ^? crInv . ix invid . itUse . leftUse - return - . (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown))) - . useL f itm cr - $ w +useLeftItem cid w = fromMaybe w $ do + cr <- w ^? cWorld . lWorld . creatures . ix cid + guard . not $ _crInvLock cr + let mitRef = cr ^? crInvSel . isel . ispItem + itmIsConsumable = isJust $ do + itRef <- mitRef + cr ^? crInv . ix itRef . itUse . cUse + itmIsEquipable = isJust $ do + itRef <- mitRef + guard . not $ cr ^. crLeftInvSel . lisMPos /= Just itRef + cr ^? crInv . ix itRef . itUse . equipEffect . eeUse + if itmIsConsumable || itmIsEquipable + then return $ useItem cr w -- I believe this ONLY sets equipment options + else do + invid <- cr ^. crLeftInvSel . lisMPos + itm <- cr ^? crInv . ix invid + f <- cr ^? crInv . ix invid . itUse . leftUse + return + . (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown))) + . useL f itm cr + $ w + where - cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid - itmIsConsumable = - isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse) - itmIsEquipable = - isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse) - && cr ^. crLeftInvSel . lisMPos /= Just (crSel cr) -- TODO determine itmShouldBeUsed with reference to config options diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 7deeb030e..9ad4edc95 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -26,6 +26,7 @@ import Dodge.Data.World import Dodge.Zoning.Creature import FoldableHelp import Geometry +import Control.Monad overrideMeleeCloseTarget :: Creature -> Creature overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr) @@ -150,11 +151,11 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of _ -> cr reloadOverride :: Creature -> Creature -reloadOverride cr - | cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0 - && cr ^. crStance . posture == Aiming = - cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions - | otherwise = cr +reloadOverride cr = fromMaybe cr $ do + guard $ cr ^. crStance . posture == Aiming + itRef <- cr ^? crInvSel . isel . ispItem + guard $ cr ^? crInv . ix itRef . itUse . heldConsumption . laLoaded == Just 0 + return $ cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions where reloadActions = [ holsterWeapon diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 9e6b17d18..df3131d9a 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -68,7 +68,7 @@ stateUpdate f = heldAimEffects :: Creature -> World -> World heldAimEffects cr = fromMaybe id $ do guard (crIsAiming cr) - ipos <- cr ^? crInvSel . iselPos + ipos <- cr ^? crInvSel . isel . ispItem itm <- cr ^? crInv . ix ipos f <- itm ^? itEffect . ieWhileAiming return $ doInvEffect f itm cr @@ -258,15 +258,12 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff attachoff = it ^?! itDimension . dimAttachPos itemUpdate :: Creature -> Int -> Item -> Item -itemUpdate cr i - | i == crSel cr = baseupdate True - | otherwise = baseupdate False - where - baseupdate bool = - updateAutoRecharge +itemUpdate cr i = updateAutoRecharge . (itUse %~ useUpdate) . (itLocation .~ InInv (_crID cr) i) - . (itIsHeld .~ bool) + . (itIsHeld .~ itmisheld) + where + itmisheld = Just i == (cr ^? crInvSel . isel . ispItem) updateAutoRecharge :: Item -> Item updateAutoRecharge it = case it ^? itUse . leftConsumption of @@ -282,12 +279,12 @@ crGetTargeting cr = do where hastargeting itm = isJust (itm ^? itUse . useTargeting . _Just) helditem = fromMaybe [] $ do - i <- cr ^? crInvSel . iselPos + i <- cr ^? crInvSel . isel . ispItem itm <- cr ^? crInv . ix i return [itm] weaponReloadSounds :: Creature -> World -> World -weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of +weaponReloadSounds cr w = case cr ^? crInvSel . isel . iselAction of Just ReloadAction{_reloadAction = la} -> soundContinue (CrReloadSound cid) diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index aca7e130f..02cb19f90 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/src/Dodge/Creature/Statistics.hs @@ -37,5 +37,7 @@ crCurrentEquipment cr = strFromHeldItem :: Creature -> Int strFromHeldItem cr | _posture (_crStance cr) == Aiming || crIsReloading cr = - negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimWeight + negate $ fromMaybe 0 $ cr ^? crInv . ix itRef . itUse . heldAim . aimWeight | otherwise = 0 + where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 132194082..81b29bd1d 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -32,13 +32,14 @@ import Dodge.Data.World import Geometry crIsReloading :: Creature -> Bool -crIsReloading cr = case cr ^? crInvSel . iselAction of +crIsReloading cr = case cr ^? crInvSel . isel . iselAction of Just ReloadAction{} -> True _ -> False crWeaponReady :: Creature -> Bool crWeaponReady cr = fromMaybe False $ do - ic <- cr ^? crInv . ix (crSel cr) . itUse . heldConsumption + i <- cr ^? crInvSel . isel . ispItem + ic <- cr ^? crInv . ix i . itUse . heldConsumption return (_laLoaded ic > 0 && _laPrimed ic) crCanSeeCr :: Creature -> (World, Creature) -> Bool @@ -79,7 +80,11 @@ crCanShoot cr = crIsAiming cr && crWeaponReady cr crInAimStance :: AimStance -> Creature -> Bool crInAimStance as cr = crIsAiming cr - && cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance == Just as + && mitstance == Just as + where + mitstance = do + i <- cr ^? crInvSel . isel . ispItem + cr ^? crInv . ix i . itUse . heldAim . aimStance oneH :: Creature -> Bool oneH = crInAimStance OneHand diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index fbe1d71a1..eb3d43a69 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -51,10 +51,14 @@ wasdWithAiming w speed cr cr' & crDir +~ _crTwist cr' & crTwist .~ 0 - addAnyTwist = case (cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance, cr^. crTwist) of - (Just TwoHandTwist, 0) -> (crTwist .~ twistamount * pi) + addAnyTwist = fromMaybe id $ do + itRef <- cr ^? crInvSel . isel . ispItem + astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance + let currenttwistamount = cr ^. crTwist + case (astance,currenttwistamount) of + ( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi) . (crDir -~ twistamount * pi) - _ -> id + _ -> Nothing theMovement | movDir == V2 0 0 = id | otherwise = crMvAbsolute (speed *.* movAbs) @@ -66,14 +70,19 @@ wasdWithAiming w speed cr dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir) movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming - mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of - Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr - _ -> argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) + mouseDir = fromMaybe + (argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) ) + $ do + itRef <- cr ^? crInvSel . isel . ispItem + _ <- cr ^? crInv . ix itRef . itScope . scopePos + return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr aimTurn :: Float -> Creature -> Creature aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr where - x = fromMaybe 1 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimTurnSpeed + x = fromMaybe 1 $ do + itRef <- cr ^? crInvSel . isel . ispItem + cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of @@ -89,8 +98,11 @@ wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _inpu -- | Set posture according to mouse presses. mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature mouseActionsCr pkeys cr - | rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction = + | rbPressed && noaction = cr & crStance . posture .~ Aiming | otherwise = cr & crStance . posture .~ AtEase where rbPressed = SDL.ButtonRight `M.member` pkeys + noaction = fromMaybe True $ do + theaction <- cr ^? crInvSel . isel . iselAction + return $ theaction == NoInvSelAction diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 976ca942a..87af15d57 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -97,8 +97,8 @@ data Intention = Intention --deriving (Eq, Show, Read) --Generic, Flat) -crSel :: Creature -> Int -crSel = _iselPos . _crInvSel +crSel :: Creature -> ManipulatedObject +crSel = _isel . _crInvSel makeLenses ''Creature makeLenses ''CreatureTargeting diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs index 3f4304c74..248abf797 100644 --- a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -18,14 +18,16 @@ data LoadAction deriving (Eq, Ord, Show, Read) --Generic, Flat) data InvSel -- should be ManipulatedObject? - = InvSel {_iselPos :: Int, _iselAction :: InvSelAction} + -- = InvSel {_isel :: SelPos} + = InvSel {_isel :: ManipulatedObject} | Brute deriving (Eq, Ord, Show, Read) --Generic, Flat) -data SelPos - = SelItem Int +data ManipulatedObject + = SelItem { _ispItem :: Int + , _iselAction :: InvSelAction} | SelNothing - | SelCloseObject Int + | SelCloseObject {_ispCloseObject :: Int} deriving (Eq, Ord, Show, Read) --Generic, Flat) data InvSelAction @@ -39,10 +41,12 @@ data LeftInvSel = LeftInvSel } makeLenses ''LoadAction +makeLenses ''ManipulatedObject makeLenses ''InvSel makeLenses ''LeftInvSel makeLenses ''InvSelAction deriveJSON defaultOptions ''LoadAction deriveJSON defaultOptions ''InvSelAction +deriveJSON defaultOptions ''ManipulatedObject deriveJSON defaultOptions ''InvSel deriveJSON defaultOptions ''LeftInvSel diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index bc398fbcc..f167271b5 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -26,7 +26,7 @@ defaultCreature = , _crHP = 100 , _crMaxHP = 150 , _crInv = IM.empty - , _crInvSel = InvSel 0 NoInvSelAction + , _crInvSel = InvSel SelNothing , _crInvCapacity = 25 , _crInvLock = False , _crInvEquipped = mempty diff --git a/src/Dodge/Euse.hs b/src/Dodge/Euse.hs index a2e3f7903..f2c0b0dda 100644 --- a/src/Dodge/Euse.hs +++ b/src/Dodge/Euse.hs @@ -37,8 +37,8 @@ useE eo = case eo of 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) + hix <- cr ^? crInvSel . isel . ispItem + guard (cr ^? crInvSel . isel . iselAction == Just NoInvSelAction) la <- cr ^? crInv . ix hix . itUse . heldConsumption atype <- la ^? laAmmoType guard (isGas atype) diff --git a/src/Dodge/HeldScroll.hs b/src/Dodge/HeldScroll.hs index 293cf3bf0..d6ab155ae 100644 --- a/src/Dodge/HeldScroll.hs +++ b/src/Dodge/HeldScroll.hs @@ -8,6 +8,7 @@ import Data.Sequence import Dodge.Data.Creature import Dodge.Data.World import Dodge.Item.Weapon.ZoomScope +import Data.Maybe --import LensHelp hiding ((|>), (<|)) -- should be able to just import data.item @@ -17,7 +18,9 @@ doHeldScroll hs = case hs of HeldScrollZoom -> overYourItem (const . setZoomScopeChange) HeldScrollCharMode{} -> overYourItem $ \x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x where - overYourItem f x cr w = w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ f x cr + overYourItem f x cr w = fromMaybe w $ do + i <- cr ^? crInvSel . isel . ispItem + return $ w & cWorld . lWorld . creatures . ix 0 . crInv . ix i %~ f x cr cycleSignum :: Float -> Seq a -> Seq a cycleSignum x diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 24f024ff3..2372ed808 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -408,7 +408,7 @@ overNozzles' :: overNozzles' eff it cr w = neww & cWorld . lWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles where cid = _crID cr - i = crSel $ w ^?! cWorld . lWorld . creatures . ix cid + i = w ^?! cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem (neww, newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it) overNozzle :: @@ -461,7 +461,7 @@ fireRemoteShell it cr w = , PJThrust 330 0 , PJRemoteDirection 340 0 cid itid ] - j = crSel cr + j = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change caneStickSoundChoice :: Item -> SoundID caneStickSoundChoice it @@ -500,8 +500,9 @@ mcShootLaser it mc = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParam shootTeslaArc :: Item -> Creature -> World -> World shootTeslaArc it cr w = w' - & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip + & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change (w', ip) = makeTeslaArc (_itParams it) pos dir w pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir dir = _crDir cr diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index a3f9046ac..4220521e9 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -3,7 +3,7 @@ module Dodge.Inventory ( checkInvSlotsYou, rmSelectedInvItem, - invSelPos, + --invSelPos, invSelSize, selNumPos, selNumTextPos, @@ -59,7 +59,8 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount w & pointcid . crInv %~ f & pointcid %~ crCancelReloading - & pointcid . crInvSel . iselPos %~ g + -- & pointcid . crInvSel . iselPos %~ g THIS NEEDS CHECKING + & pointcid . crInvSel . isel . ispItem %~ g & pointcid . crLeftInvSel . lisMPos %~ g' & removeAnySlotEquipment & dounequipfunction @@ -97,7 +98,9 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount | otherwise = Just x rmSelectedInvItem :: Int -> World -> World -rmSelectedInvItem cid w = rmInvItem cid (crSel (w ^?! cWorld . lWorld . creatures . ix cid)) w +rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem of + Just i -> rmInvItem cid i w + Nothing -> w augmentedInvSizes :: World -> IM.IntMap Int augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize @@ -146,8 +149,8 @@ selNumMidHeight cfig w i = V2 (150 - hw) (hh + bump - (20 * fromIntegral ipos + selNumCol :: Int -> World -> Color selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i -invSelPos :: World -> Int -invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w) +--invSelPos :: World -> Int +--invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w) updateTerminal :: World -> World updateTerminal = checkTermDist @@ -164,12 +167,14 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of updateCloseObjects :: World -> World updateCloseObjects w = w - & hud . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose - & cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ updateinvsel + & hud . closeObjects .~ newcloseobjects + & updatecursorposifnecessary where - updateinvsel curinvsel - | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1 - | otherwise = curinvsel + newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose + updatecursorposifnecessary + = case w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject of + Just i | i >= length newcloseobjects -> changeAugInvSel 1 + _ -> id filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w ypos = _crPos $ you w activeButtons = @@ -188,7 +193,8 @@ updateRBList w | w ^? rbOptions . opItemID == mcurrentitemid = w & setEquipAllocation & setEquipActivation | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do - esite <- cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite + i <- cr ^? crInvSel . isel . ispItem + esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite itid <- mcurrentitemid return $ w @@ -203,13 +209,16 @@ updateRBList w & setEquipAllocation & setEquipActivation where - mcurrentitemid = cr ^? crInv . ix curinvid . itID - curinvid = crSel cr + mcurrentitemid = do + i <- cr ^? crInvSel . isel . ispItem + cr ^? crInv . ix i . itID + --curinvid = crSel cr cr = you w chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do - ep <- cr ^? crInvEquipped . ix (crSel cr) + i <- cr ^? crInvSel . isel . ispItem + ep <- cr ^? crInvEquipped . ix i elemIndex ep eps chooseFreeSite :: Creature -> [EquipPosition] -> Int @@ -218,42 +227,44 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep setEquipAllocation :: World -> World -setEquipAllocation w = case _rbOptions w of - EquipOptions{_opEquip = es, _opSel = i} -> - case you w ^? crInvEquipped . ix (crSel (you w)) of - Just epos - | es !! i == epos -> +setEquipAllocation w = fromMaybe w $ do + curpos <- you w ^? crInvSel . isel . ispItem + return $ case _rbOptions w of + EquipOptions{_opEquip = es, _opSel = i} -> + case you w ^? crInvEquipped . ix curpos of + Just epos + | es !! i == epos -> + w & rbOptions . opAllocateEquipment + .~ RemoveEquipment + { _allocOldPos = epos + } + Just epos + | isJust (you w ^? crEquipment . ix (es !! i)) -> + w & rbOptions . opAllocateEquipment + .~ SwapEquipment + { _allocOldPos = epos + , _allocNewPos = es !! i + , _allocSwapID = _crEquipment (you w) M.! (es !! i) + } + Just epos -> w & rbOptions . opAllocateEquipment - .~ RemoveEquipment - { _allocOldPos = epos - } - Just epos - | isJust (you w ^? crEquipment . ix (es !! i)) -> - w & rbOptions . opAllocateEquipment - .~ SwapEquipment + .~ MoveEquipment { _allocOldPos = epos , _allocNewPos = es !! i - , _allocSwapID = _crEquipment (you w) M.! (es !! i) } - Just epos -> - w & rbOptions . opAllocateEquipment - .~ MoveEquipment - { _allocOldPos = epos - , _allocNewPos = es !! i - } - Nothing - | isJust (you w ^? crEquipment . ix (es !! i)) -> + Nothing + | isJust (you w ^? crEquipment . ix (es !! i)) -> + w & rbOptions . opAllocateEquipment + .~ ReplaceEquipment + { _allocNewPos = es !! i + , _allocRemoveID = _crEquipment (you w) M.! (es !! i) + } + Nothing -> w & rbOptions . opAllocateEquipment - .~ ReplaceEquipment + .~ PutOnEquipment { _allocNewPos = es !! i - , _allocRemoveID = _crEquipment (you w) M.! (es !! i) } - Nothing -> - w & rbOptions . opAllocateEquipment - .~ PutOnEquipment - { _allocNewPos = es !! i - } - _ -> w + _ -> w setEquipActivation :: World -> World setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of @@ -261,7 +272,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of Just RemoveEquipment{} -> case you w ^. crLeftInvSel . lisMPos of Just i - | i == invsel -> + | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment { _deactivateEquipment = i @@ -269,12 +280,12 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Just rbos -> case you w ^. crLeftInvSel . lisMPos of - Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment - { _activateEquipment = invsel + { _activateEquipment = fromJust minvsel , _deactivateEquipment = i } Just i @@ -285,13 +296,17 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment - { _activateEquipment = invsel + { _activateEquipment = fromJust minvsel } Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment where - invsel = crSel (you w) - invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . leftUse) + --invsel = crSel (you w) + minvsel = cr ^? crInvSel . isel . ispItem + cr = you w + invselcanactivate = isJust $ do + i <- minvsel + return $ cr ^? crInv . ix i . itUse . leftUse equipSiteToPositions :: EquipSite -> [EquipPosition] equipSiteToPositions es = case es of @@ -310,14 +325,10 @@ closeObjScrollDir x changeInvSel :: Int -> World -> World changeInvSel i w | i == 0 || n == 0 = w - | yourInvSel w < n = - w - & pointcrInvSel . iselPos %~ (`mod` n) . subtract i - & pointcrInvSel . iselAction .~ NoInvSelAction - | otherwise = - w - & pointcrInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n)) - & pointcrInvSel . iselAction .~ NoInvSelAction + | otherwise = w + & pointcrInvSel . isel . ispItem %~ (`mod` n) . subtract i + & pointcrInvSel . isel . iselAction .~ NoInvSelAction + & pointcrInvSel . isel . ispCloseObject %~ (`mod` numCO) . subtract i where -- arguably this should jump the invpos into the inventory proper pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel @@ -325,47 +336,58 @@ changeInvSel i w numCO = length $ w ^. hud . closeObjects changeSwapInvSel :: Int -> World -> World -changeSwapInvSel k w - | k == 0 = w - | yourInvSel w < n = - w - & cWorld . lWorld . creatures . ix 0 %~ updatecreature - | yourInvSel w > n = - w - & cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos .~ ico' - & hud . closeObjects %~ swapIndices (i - (n + 1)) (ico' - (n + 1)) - | otherwise = w +changeSwapInvSel k w = case you w ^? crInvSel . isel of + Just (SelItem i _) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i + Just (SelCloseObject i) -> w + & cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispCloseObject + .~ ((i - k) `mod` numCO) + & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO) + _ -> w where - updatecreature = - (crInv %~ IM.safeSwapKeys (i `mod` n) swapi) - . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel) - . (crInvSel . iselPos %~ (`mod` n) . subtract k) - . (crInvEquipped %~ IM.safeSwapKeys i swapi) - . swapSite i swapi - . swapSite swapi i + updatecreature i = + (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i)) + . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i) + . (crInvSel . isel . ispItem %~ (`mod` n) . subtract k) + . (crInvEquipped %~ IM.safeSwapKeys i (swapi i)) + . swapSite i (swapi i) + . swapSite (swapi i) i swapSite a b = case cr ^? crInvEquipped . ix a of Just epos -> crEquipment . ix epos .~ b Nothing -> id cr = you w - swapi = (i - k) `mod` n - updateLeftInvSel li - | i == li = swapi - | swapi == li = i + swapi i = (i - k) `mod` n + updateLeftInvSel i li + | i == li = swapi i + | swapi i == li = i | otherwise = li - i = crSel cr - ico' = ((i - (k + n + 1)) `mod` numCO) + n + 1 n = length $ _crInv cr numCO = length $ w ^. hud . closeObjects changeAugInvSel :: Int -> World -> World -changeAugInvSel i w - | i == 0 = w +changeAugInvSel yi w + | yi == 0 = w | otherwise = - w - & cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ (`mod` n) . subtract i - & cWorld . lWorld . creatures . ix 0 . crInvSel . iselAction .~ NoInvSelAction + w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f where - n = length (yourInv w) + length (w ^. hud . closeObjects) + 1 + f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w + ninv = length (yourInv w) + nclose = length (w ^. hud . closeObjects) + +toAugSelPos :: World -> ManipulatedObject -> Int +toAugSelPos w mo = case mo of + SelItem i _ -> i + SelNothing -> ninv + SelCloseObject i -> ninv + i + 1 + where + ninv = length (yourInv w) + +fromAugSelPos :: World -> Int -> ManipulatedObject +fromAugSelPos w i + | i > ninv = SelCloseObject (i - ninv - 1) + | i == ninv = SelNothing + | otherwise = SelItem i NoInvSelAction + where + ninv = length (yourInv w) bestCloseObjectIndex :: World -> Maybe Int bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects @@ -375,13 +397,9 @@ bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects ycr = you w selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button) -selectedCloseObject w - | invsel >= (length inv + 1) = selectNthCloseObject w (invsel - (length inv + 1)) - | otherwise = selectNthCloseObject w =<< bestCloseObjectIndex w - where - invsel = crSel cr - cr = you w - inv = _crInv cr +selectedCloseObject w = case you w ^? crInvSel . isel . ispCloseObject of + Just i -> selectNthCloseObject w i + Nothing -> selectNthCloseObject w =<< bestCloseObjectIndex w selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button) selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_hud w) !? n) diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 6185ae334..4c0e98eb7 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -37,7 +37,8 @@ tryPutItemInInv cid flit w = case maybeInvSlot of createAndSelectItem :: Item -> World -> World createAndSelectItem itm w = case createPutItem itm w of - (Just i, w') -> w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i NoInvSelAction + (Just i, w') -> w' + & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel (SelItem i NoInvSelAction) (Nothing, w') -> w' createPutItem :: Item -> World -> (Maybe Int, World) diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index a3d42b98c..2601467c1 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -1,6 +1,10 @@ -module Dodge.Inventory.SelectionList where +module Dodge.Inventory.SelectionList + ( invSelectionItem + , closeObjectToSelectionItem + ) + where -import Dodge.Default.SelectionList +--import Dodge.Default.SelectionList import Dodge.Inventory.Color import Dodge.Item.Display import Dodge.Inventory.ItemSpace @@ -12,11 +16,11 @@ import Dodge.Data.World import qualified Data.IntMap.Strict as IM import LensHelp -makeInventorySelectionList :: World -> SelectionList () -makeInventorySelectionList w = defaultSelectionList - & slItems .~ inventorySelectionList w - & slSelPos .~ inventoryCursorPos w - +--makeInventorySelectionList :: World -> SelectionList () +--makeInventorySelectionList w = defaultSelectionList +-- & slItems .~ inventorySelectionList w +-- & slSelPos .~ inventoryCursorPos w +-- inventorySelectionList :: World -> [SelectionItem ()] inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv) ++ [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()] @@ -29,12 +33,12 @@ inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv) 0 -> " INVENTORY FULL" 1 -> " +1 FREE SLOT" x -> " +" ++ show x ++ " FREE SLOTS" - -inventoryCursorPos :: World -> Maybe Int -inventoryCursorPos w = case w ^? hud . hudElement . subInventory of - Just CombineInventory{} -> Nothing - _ -> Just $ yourInvSel w - +-- +--inventoryCursorPos :: World -> Maybe Int +--inventoryCursorPos w = case w ^? hud . hudElement . subInventory of +-- Just CombineInventory{} -> Nothing +-- _ -> Just $ yourInvSel w +-- invSelectionItem :: Creature -> (Int,Item) -> SelectionItem () invSelectionItem cr (i,it) = SelectionItem { _siPictures = pics @@ -49,9 +53,9 @@ invSelectionItem cr (i,it) = SelectionItem col = _itInvColor it pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of UndroppableIdentified -> itemDisplay it - _ | crSel cr == i -> selectedItemDisplay cr it + _ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it _ -> itemDisplay it - +-- closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem () closeObjectToSelectionItem n e = SelectionItem { _siPictures = pics @@ -64,7 +68,7 @@ closeObjectToSelectionItem n e = SelectionItem } where (pics,col) = closeObjectToTextPictures' n e - +-- closeObjectToTextPictures' :: Int -> Either FloorItem Button -> ([String],Color) closeObjectToTextPictures' nfreeslots e = case e of Left flit -> let it = _flIt flit @@ -75,9 +79,9 @@ closeObjectToTextPictures' nfreeslots e = case e of thecol it | nfreeslots >= itSlotsTaken it = _itInvColor it | otherwise = invDimColor - +-- clObjIntIn :: Int clObjIntIn = 2 - -clObjFloatIn :: Float -clObjFloatIn = fromIntegral clObjIntIn * 9 +-- +--clObjFloatIn :: Float +--clObjFloatIn = fromIntegral clObjIntIn * 9 diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 675b703cb..f95781073 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -65,7 +65,7 @@ showAutoRechargeProgress lc = case lc of ChargeableAmmo{} -> show (_wpCharge lc) showReloadProgress :: Creature -> HeldConsumption -> String -showReloadProgress cr ic = case cr ^? crInvSel . iselAction of +showReloadProgress cr ic = case cr ^? crInvSel . isel . iselAction of Just (ReloadAction i la) -> show i ++ showLoadActionType la (_laLoaded ic) _ -> case ic ^? laProgress . _Just . ix 0 of Nothing -> show $ _laLoaded ic diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index ab74da533..73bc9ae03 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -136,7 +136,8 @@ shootLaser it cr = cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams where pos = _crPos cr dir = _crDir cr - phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr + phasev = _phaseV . _itParams $ _crInv cr IM.! itRef + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change dam = _lasDamage $ _itParams it -- this has the feel of a left click item @@ -151,7 +152,8 @@ circleLaser it cr w mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp)) dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000 - phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr + phasev = _phaseV . _itParams $ _crInv cr IM.! itRef + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change dam = _lasDamage $ _itParams it shootDualLaser :: Item -> Creature -> World -> World @@ -173,7 +175,8 @@ shootDualLaser it cr w = | otherwise = mwp dirl = argV $ mwp' -.- posl dirr = argV $ mwp' -.- posr - phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr + phasev = _phaseV . _itParams $ _crInv cr IM.! itRef + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change dam = _lasDamage $ _itParams it basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam @@ -207,7 +210,8 @@ aTractorBeam _ cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos xpos = cpos +.+ 400 *.* unitVectorAtAngle dir dir = _crDir cr outpos = fst $ collidePointWallsFilter (const True) cpos xpos w - power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr + power = _attractionPower . _itParams $ _crInv cr IM.! itRef + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam tractorBeamAt pos outpos dir power = diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 72d2a05f3..e7d2ccf8a 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -191,7 +191,7 @@ rateIncAB exeffFirst exeffCont eff item cr w fastRate = _rateMinMax . _heldDelay $ _itUse item startRate = _rateMaxMax . _heldDelay $ _itUse item cid = _crID cr - itRef = crSel cr + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change pointItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef currentRate = _rateMax (_heldDelay (_itUse item)) repeatFire = crWeaponReady cr && _rateTime (_heldDelay (_itUse item)) == 1 @@ -215,7 +215,7 @@ withWarmUp soundID f item cr w & f item cr where cid = _crID cr - itRef = crSel cr + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef curWarmUp = _warmTime . _heldDelay $ _itUse item maxWarmUp = _warmMax . _heldDelay $ _itUse item @@ -341,19 +341,25 @@ withSidePushAfterI maxSide eff item cr w = useAllAmmo :: ChainEffect useAllAmmo eff item cr = eff item cr - . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0) + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded .~ 0) + where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change useAmmoUpTo :: Int -> ChainEffect useAmmoUpTo amAmount eff item cr = eff item cr - . ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded + . ( cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded %~ (max 0 . subtract amAmount) ) + where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change useAmmoAmount :: Int -> ChainEffect useAmmoAmount amAmount eff item cr = eff item cr - . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount) + . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itUse . heldConsumption . laLoaded -~ amAmount) + where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change {- | Applies a world effect after an item use cooldown check. @@ -364,7 +370,8 @@ useTimeCheck f item cr w = case item ^? itUse . heldDelay . rateTime of _ -> w where cid = _crID cr - setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . heldDelay . rateTime +~ userate + setUseTime = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTime +~ userate + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change userate = fromMaybe 0 $ item ^? itUse . heldDelay . rateMax -- | Applies a world effect after a hammer position check. @@ -389,7 +396,7 @@ ammoUseCheck f item cr w | otherwise = w where cid = _crID cr - itRef = crSel cr + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change pointerToItem = cWorld . lWorld . creatures . ix cid . crInv . ix itRef fireCondition = crWeaponReady cr @@ -444,10 +451,14 @@ withItem g f it = g it f it -- not ideal withItemUpdate' :: (Item -> Item) -> ChainEffect -withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) +withItemUpdate' up f it cr = f (up it) cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up) + where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect -withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up) +withItemUpdate up g f it cr = g it f it cr . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef %~ up) + where + itRef = cr ^?! crInvSel . isel . ispItem -- unsafe!! TODO change withTempLight :: Int -> Float -> V3 Float -> ChainEffect withTempLight time rad col eff item cr = diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 0482454cc..1888e9edd 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -58,7 +58,8 @@ useRewindGun itm _ w = w -- 22.05.23 this has been changed from using invids to items useShrinkGun :: Item -> Creature -> World -> World useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of - Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid + --Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid + Just FullSize -> tryResize 0.5 $ f Shrunk UndroppableIdentified . dropExcept cr invid Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr Nothing -> error "useShrinkGun applied to item with incorrect ItParam" where diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 473a3f395..dc5783b74 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -95,7 +95,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj) --i = _prjID pj newdir | SDL.ButtonRight `M.member` _mouseButtons (_input w) - && w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos + && w ^? cWorld . lWorld . creatures . ix cid . crInvSel . isel . ispItem == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID = (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w)) | otherwise = _prjDir pj diff --git a/src/Dodge/Reloading.hs b/src/Dodge/Reloading.hs index dad0512ff..9e49c86d9 100644 --- a/src/Dodge/Reloading.hs +++ b/src/Dodge/Reloading.hs @@ -5,57 +5,67 @@ module Dodge.Reloading ( tryStartLoading, ) where +import Dodge.Data.Item.Use.Consumption.LoadAction import Control.Lens import Dodge.Data.Creature +import Data.Maybe crCancelReloading :: Creature -> Creature crCancelReloading cr = cr - & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress %~ const Nothing - & crInvSel . iselAction .~ NoInvSelAction + & updateProgress + & crInvSel . isel . iselAction .~ NoInvSelAction + where + updateProgress = case crSel cr of + SelItem i _ -> crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing + _ -> id stepReloading :: Creature -> Creature -stepReloading cr = case cr ^?! crInvSel . iselAction of - ReloadAction x la +stepReloading cr = case cr ^?! crInvSel . isel of + SelItem i (ReloadAction x la) | x > 0 -> - cr & crInvSel . iselAction . actionProgress -~ 1 + cr & crInvSel . isel . iselAction . actionProgress -~ 1 | otherwise -> cr - & crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la - & crInv . ix (crSel cr) . itUse . heldConsumption %~ rotateActionProgress + & crInv . ix i . itUse . heldConsumption %~ doLoadAction la + & crInv . ix i . itUse . heldConsumption %~ rotateActionProgress & tryNextLoadAction _ -> cr tryNextLoadAction :: Creature -> Creature -tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laProgress . _Just . ix 0 of - Nothing -> cr & crInvSel . iselAction .~ NoInvSelAction - Just la -> - cr & crInvSel . iselAction . actionProgress .~ _actionTime la - & crInvSel . iselAction . reloadAction .~ la +tryNextLoadAction cr = case cr ^? crInvSel . isel of + Just (SelItem i _) -> case cr ^? crInv . ix i . itUse . heldConsumption . laProgress . _Just . ix 0 of + Nothing -> cr & crInvSel . isel . iselAction .~ NoInvSelAction + Just la -> + cr & crInvSel . isel . iselAction . actionProgress .~ _actionTime la + & crInvSel . isel . iselAction . reloadAction .~ la + _ -> cr crToggleReloading :: Creature -> Creature -crToggleReloading cr = case cr ^? crInvSel . iselAction of - Just ReloadAction{} -> cr & crInvSel . iselAction .~ NoInvSelAction +crToggleReloading cr = case cr ^? crInvSel . isel . iselAction of + Just ReloadAction{} -> cr & crInvSel . isel . iselAction .~ NoInvSelAction _ -> cr & tryStartLoading tryStartLoading :: Creature -> Creature -tryStartLoading cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption of - Just hc -> startLoading hc cr - Nothing -> cr +tryStartLoading cr = fromMaybe cr $ do + i <- cr ^? crInvSel . isel . ispItem + hc <- cr ^? crInv . ix i . itUse . heldConsumption + return $ startLoading hc cr startLoading :: HeldConsumption -> Creature -> Creature startLoading ic cr = case ic ^? laProgress . _Just . ix 0 of Just la -> cr & startLoadingStep la Nothing -> case ic ^? laCycle of Nothing -> cr - Just [] -> error ("item has empty load cycle" ++ show (cr ^?! crInv . ix (crSel cr) . itType)) + Just [] -> error ("item has empty load cycle") Just _ | _laLoaded ic >= _laMax ic -> cr - Just (la : las) -> - cr & startLoadingStep la - & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la : las) + Just (la : las) -> fromMaybe (error "item loading error") $ do + i <- cr ^? crInvSel . isel . ispItem + return $ cr & startLoadingStep la + & crInv . ix i . itUse . heldConsumption . laProgress ?~ (la : las) startLoadingStep :: LoadAction -> Creature -> Creature -startLoadingStep la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la +startLoadingStep la cr = cr & crInvSel . isel . iselAction .~ ReloadAction (_actionTime la) la rotateActionProgress :: HeldConsumption -> HeldConsumption rotateActionProgress ic = case ic ^? laProgress . _Just of diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b04187499..7a69cc189 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -143,32 +143,33 @@ floorItemPickupInfo n itm | n >= ceiling (_itInvSize itm) = ", but you have space to pick it up." | otherwise = ", and you don't have space to pick it up." +-- this should not produce Nothing, and the logic should be changed to reflect +-- this yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a -yourAugmentedItem f x g w - | i < n = f $ yourInv w ^?! ix i - | i == n = x - | otherwise = g $ w ^?! hud . closeObjects . ix (i - n - 1) +yourAugmentedItem f x g w = case you w ^? crInvSel . isel of + Just (SelItem i _) -> f $ yourInv w ^?! ix i + Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix (i - n - 1) + _ -> x where - i = crSel (you w) n = length $ yourInv w drawNoSubInventory :: Configuration -> World -> Picture drawNoSubInventory cfig w = pictures - [ closeobjectcursor - , equipcursors + [ --closeobjectcursor + equipcursors , equipcursor -- the order is important, this should go on top of the other equipcursors , rboptions ] where - closeobjectcursor = case selectedCloseObject w of - Nothing -> mempty - Just (i, _) -> - drawCursorAt - (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South]) - cfig - (Just i) - (inventorySelectionList w) +-- closeobjectcursor = case selectedCloseObject w of +-- Nothing -> mempty +-- Just (i, _) -> +-- drawCursorAt +-- (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South]) +-- cfig +-- (Just i) +-- (inventorySelectionList w) equipcursor = case cr ^. crLeftInvSel . lisMPos of Just invid -> f cyan invid (_crInvEquipped cr IM.! invid) _ -> mempty @@ -267,27 +268,28 @@ displayTerminal tid cfig w = fromMaybe mempty $ do | otherwise = [] drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture -drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} = - listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) - <> case ae of - DoNotMoveEquipment -> mempty - PutOnEquipment{} -> - midtext "PUT ONTO" - MoveEquipment{} -> - midtext "MOVE TO" <> extratext [] - SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} -> - midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp) - ReplaceEquipment{_allocRemoveID = rid} -> - midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid) - RemoveEquipment{} -> - midtext "TAKE OFF" +drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} + = fromMaybe mempty $ do + curpos <- you w ^? crInvSel . isel . ispItem + let midtext str = listTextPictureAt 252 0 cfig curpos (text str) + let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) + return $ listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) + <> case ae of + DoNotMoveEquipment -> mempty + PutOnEquipment{} -> + midtext "PUT ONTO" + MoveEquipment{} -> + midtext "MOVE TO" <> extratext [] + SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} -> + midtext "MOVE TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp) + ReplaceEquipment{_allocRemoveID = rid} -> + midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid) + RemoveEquipment{} -> + midtext "TAKE OFF" where - midtext str = listTextPictureAt 252 0 cfig curpos (text str) - extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) Nothing -> "" - curpos = invSelPos w otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j) drawRBOptions _ _ _ = mempty diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 0d4aa3a09..8d8977ebb 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -43,7 +43,9 @@ moveZoomCamera cfig theinput cr campos = & camItemZoom .~ newItemZoom where cpos = _crPos cr - mitm = cr ^? crInv . ix (crSel cr) + mitm = do + i <- cr ^? crInvSel . isel . ispItem + cr ^? crInv . ix i newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset vfoffset = do iscam <- mitm ^? _Just . itScope . scopeIsCamera @@ -83,11 +85,16 @@ moveZoomCamera cfig theinput cr campos = zoomOutSpeed = 15 updateScopeZoom :: World -> World -updateScopeZoom w +updateScopeZoom w = fromMaybe w $ do + i <- w ^? cWorld . lWorld . creatures . ix 0 . crInvSel . isel . ispItem + return $ updateScopeZoom' i w + +updateScopeZoom' :: Int -> World -> World +updateScopeZoom' i w | SDL.ButtonRight `M.member` _mouseButtons (_input w) = w & wppointer %~ doScopeZoom mp | otherwise = w & wppointer %~ resetscope where - wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope + wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl resetscope otherAtt = otherAtt mp = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w) @@ -170,10 +177,13 @@ rotateCameraBy :: Float -> CWorld -> CWorld rotateCameraBy x w = w & camPos . camRot +~ x - & lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! lWorld . creatures . ix 0)) - . itScope - . scopePos - %~ rotateV x + & fromMaybe id (do + i <- w ^? lWorld . creatures . ix 0 . crInvSel . isel . ispItem + return $ lWorld . creatures . ix 0 . crInv . ix i + . itScope + . scopePos + %~ rotateV x + ) rotateCamera :: Configuration -> World -> World rotateCamera cfig w diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index d6105aa00..159a004bb 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -105,11 +105,12 @@ moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of changeTweakParam :: Maybe Int -> Int -> World -> World changeTweakParam mi i w = fromMaybe w $ do + curpos <- you w ^? crInvSel . isel . ispItem paramid <- mi params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid let x = (_tweakVal params + i) `mod` _tweakMax params return $ - w & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (you w)) + w & cWorld . lWorld . creatures . ix 0 . crInv . ix curpos %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x) . doTweak (_tweakType params) x )