From 7f55ba117f08f577ca372689386ae10c5647706d Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 24 May 2022 14:03:18 +0100 Subject: [PATCH] Allow for selection of equipment position --- src/Dodge/Creature/Impulse/UseItem.hs | 55 ++++++++++++------ src/Dodge/Data.hs | 44 +++++++++++++- src/Dodge/Default.hs | 2 - src/Dodge/Default/Weapon.hs | 5 +- src/Dodge/Default/World.hs | 1 + src/Dodge/Event.hs | 13 ++++- src/Dodge/Inventory.hs | 79 ++++++++++++++++++++++++++ src/Dodge/Item/Equipment.hs | 6 +- src/Dodge/Item/Weapon/AmmoParams.hs | 1 + src/Dodge/Item/Weapon/BulletGun/Rod.hs | 2 +- src/Dodge/Item/Weapon/BulletGuns.hs | 4 +- src/Dodge/Render/HUD.hs | 43 ++++++++++++-- src/Dodge/Update.hs | 1 + src/Dodge/Update/UsingInput.hs | 2 + 14 files changed, 221 insertions(+), 37 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 7012a4dc3..7161ee62d 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -22,8 +22,10 @@ itemEffect :: Creature -> Item -> World -> World itemEffect cr it w = case it ^? itUse of Just RightUse {_rUse = eff,_useMods = usemods} -> hammerTest $ foldr ($) eff usemods it cr - Just LeftUse {} -> setuhamdown $ lhammer (setEquipLeftItem) - Just EquipUse{} -> setuhamdown $ lhammer $ toggleEquipmentAt (_crInvSel cr) it + Just LeftUse {} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr) + . activateEquipmentAt (_rbOptions w)) + Just EquipUse{} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr) + . activateEquipmentAt (_rbOptions w)) -- ConsumeUse will cause problems if the item is not selected Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr) Just NoUse -> setuhamdown w @@ -35,24 +37,41 @@ itemEffect cr it w = case it ^? itUse of lhammer f' = w & case _crHammerPosition cr of HammerUp -> creatures . ix (_crID cr) %~ f' _ -> id - setEquipLeftItem cr' = case _crLeftInvSel cr' of - Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing - & crInvEquipped . at i .~ Nothing - -- if the following causes an exception we have reached a state that - -- should not be possible - & crEquipment . at (_crInvEquipped cr' IM.! i) .~ Nothing - -- Just i -> cr' & crLeftInvSel ?~ _crInvSel cr' - -- should left use equipment be removed if replaced by left use - -- equipment that uses a different site? - _ -> cr' & crLeftInvSel ?~ _crInvSel cr' - & equipUsingSiteCheck (_crInvSel cr') it setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown -toggleEquipmentAt :: Int -> Item -> Creature -> Creature -toggleEquipmentAt invid itm cr = case cr ^? crInvEquipped . ix invid of - Just epos -> cr & crInvEquipped . at invid .~ Nothing - & crEquipment . at epos .~ Nothing - Nothing -> equipUsingSite invid itm cr +activateEquipmentAt :: RightButtonOptions -> Creature -> Creature +activateEquipmentAt rbo = case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of + (Just i,_) -> crLeftInvSel ?~ i + (_,Just _) -> crLeftInvSel .~ Nothing + _ -> id + +toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> Creature +toggleEquipmentAt rbops invid cr = case rbops ^? opAllocateEquipment of + Just DoNotMoveEquipment -> cr + Just PutOnEquipment {_allocNewPos = newp} + -> cr & crEquipment . at newp ?~ invid + & crInvEquipped . at invid ?~ newp + Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp } + -> cr & crEquipment . at newp ?~ invid + & crEquipment . at oldp .~ Nothing + & crInvEquipped . at invid ?~ newp + Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid } + -> cr & crEquipment . at newp ?~ invid + & crEquipment . at oldp ?~ sid + & crInvEquipped . at invid ?~ newp + & crInvEquipped . at sid ?~ oldp + Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid } + -> cr & crEquipment . at newp ?~ invid + & crInvEquipped . at invid ?~ newp + & crInvEquipped . at rid .~ Nothing + Just RemoveEquipment {_allocOldPos = oldp } + -> cr & crEquipment . at oldp .~ Nothing + & crInvEquipped . at invid .~ Nothing + Nothing -> error "tried to toggle equipment whilst not prepared" +-- case cr ^? crInvEquipped . ix invid of +-- Just epos -> cr & crInvEquipped . at invid .~ Nothing +-- & crEquipment . at epos .~ Nothing +-- Nothing -> equipUsingSite invid itm cr -- | First check if the item is already equiped, then do nothing equipUsingSiteCheck :: Int -> Item -> Creature -> Creature diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index dcd13ade0..f9bbf0af5 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -121,6 +121,7 @@ data World = World , _lightSources :: IM.IntMap LightSource , _tempLightSources :: [TempLightSource] , _closeObjects :: [Either FloorItem Button] + , _rbOptions :: RightButtonOptions , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int , _sideEffects :: Universe -> IO Universe @@ -139,6 +140,44 @@ data HUDElement = DisplayInventory {_subInventory :: SubInventory} | DisplayCarte -- deriving (Eq,Ord,Show) +data RightButtonOptions + = NoRightButtonOptions + | EquipOptions + {_opEquip :: [EquipPosition] + ,_opSel :: Int + ,_opCurInvPos :: Int + ,_opAllocateEquipment :: AllocateEquipment + ,_opActivateEquipment :: ActivateEquipment + } + +data ActivateEquipment + = ActivateEquipment {_activateEquipment :: Int } + | DeactivateEquipment {_deactivateEquipment :: Int} + | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} + | NoChangeActivateEquipment + +data AllocateEquipment + = DoNotMoveEquipment + | PutOnEquipment + { _allocNewPos :: EquipPosition + } + | MoveEquipment + { _allocNewPos :: EquipPosition + , _allocOldPos :: EquipPosition + } + | SwapEquipment + { _allocNewPos :: EquipPosition + , _allocOldPos :: EquipPosition + , _allocSwapID :: Int + } + | ReplaceEquipment + { _allocNewPos :: EquipPosition + , _allocRemoveID :: Int + } + | RemoveEquipment + { _allocOldPos :: EquipPosition + } + data SubInventory = NoSubInventory | TweakInventory @@ -372,6 +411,7 @@ data ItemUse , _useMods :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World] , _useHammer :: HammerType , _useAim :: AimParams + , _heldScroll :: Float -> Creature -> Item -> Item } | LeftUse { _lUse :: Item -> Creature -> World -> World @@ -431,7 +471,6 @@ data Item = Item , _itConsumption :: ItemConsumption , _itUse :: ItemUse , _itEquipPict :: Creature -> Item -> SPic - , _itScroll :: Float -> Creature -> Item -> Item , _itType :: CombineType , _itAttachment :: ItAttachment , _itID :: Maybe Int @@ -1318,3 +1357,6 @@ makeLenses ''BeamType makeLenses ''WorldBeams makeLenses ''ArcStep makeLenses ''CreatureStatistics +makeLenses ''RightButtonOptions +makeLenses ''AllocateEquipment +makeLenses ''ActivateEquipment diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index ce1de23a4..2edc48746 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -164,7 +164,6 @@ defaultEquipment = Item ,_eqOnRemove = \_ _ -> id ,_eqSite = GoesOnSpecial } - , _itScroll = \ _ _ -> id , _itAttachment = NoItAttachment , _itParams = NoParams , _itTweaks = NoTweaks @@ -190,7 +189,6 @@ defaultConsumable = Item , _itInvColor = blue , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)] , _itEffect = NoItEffect - , _itScroll = \_ _ -> id , _itAttachment = NoItAttachment , _itType = NoCombineType , _itParams = NoParams diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index e19c09aa0..0add40c41 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -37,6 +37,7 @@ ruseRate i f ht usemods = RightUse , _useMods = usemods , _useHammer = ht , _useAim = defaultAimParams + , _heldScroll = \_ _ -> id } ruseInstant @@ -50,6 +51,7 @@ ruseInstant f ht usemods = RightUse , _useMods = usemods , _useHammer = ht , _useAim = defaultAimParams + , _heldScroll = \_ _ -> id } defaultrUse :: ItemUse @@ -59,6 +61,7 @@ defaultrUse = RightUse , _useMods = [] , _useHammer = HasHammer HammerUp , _useAim = defaultAimParams + , _heldScroll = \_ _ -> id } defaultlUse :: ItemUse defaultlUse = LeftUse @@ -94,7 +97,6 @@ defaultGun = Item , _itUse = defaultrUse , _itDimension = defItDimCol white , _itEquipPict = pictureWeaponOnAim - , _itScroll = \_ _ -> id , _itAttachment = NoItAttachment , _itID = Nothing , _itInvPos = Nothing @@ -125,7 +127,6 @@ defaultCraftable = Item , _itConsumption = NoConsumption , _itUse = NoUse , _itEquipPict = pictureWeaponOnAim - , _itScroll = \_ _ -> id , _itAttachment = NoItAttachment , _itID = Nothing , _itInvPos = Nothing diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 38820a34c..4299e211d 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -77,6 +77,7 @@ defaultWorld = World , _lightSources = IM.empty , _tempLightSources = [youLight] , _closeObjects = [] + , _rbOptions = NoRightButtonOptions , _seenLocations = IM.fromList [(0, (_crPos . you, "CURRENT POSITION")) ,(1, (const (V2 0 0) , "START POSITION")) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index cee7ab1c6..898269d30 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -126,9 +126,10 @@ wheelEvent y w = case _hudElement $ _hud w of -- functions that modify the inventory should be centralised so that -- this lock can be sensibly applied, perhaps | _crInvLock (_creatures w IM.! _yourID w) -> w - | rbDown -> case yourItem w ^? _Just . itScroll of - Nothing -> closeObjScrollDir y w - Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) + | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of + (_,EquipOptions{}) -> scrollRBOption y w + (Nothing,_) -> closeObjScrollDir y w + (Just f,_) -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) | lbDown -> w & cameraZoom +~ y | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w @@ -148,6 +149,12 @@ wheelEvent y w = case _hudElement $ _hud w of lbDown = ButtonLeft `S.member` _mouseButtons w invKeyDown = ScancodeCapsLock `S.member` _keys w +scrollRBOption :: Float -> World -> World +scrollRBOption y w + | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1)) + | y > 0 = w & rbOptions . opSel %~ (max 0 . (subtract 1)) + | otherwise = w + -- nice idea, but the chain of setters and getters seems prohibitive --scrollOver :: Foldable t -- => ASetter s s Int Int -- index setter diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 4137c9650..dbd39a99b 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -12,6 +12,7 @@ module Dodge.Inventory , augmentedInvSizes , rmInvItem , updateCloseObjects + , updateRBList , updateTerminal , closeObjScrollDir , closeObjectCol @@ -38,7 +39,10 @@ import ListHelp import LensHelp --import qualified Data.IntSet as IS +import qualified Data.Map.Strict as M +import qualified Data.Set as S import Data.Maybe +import SDL --import Data.List --import System.Random @@ -169,6 +173,81 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c oldClose = filt $ _closeObjects w oldCloseFiltered = intersectBy closeObjEq oldClose currentClose +updateRBList :: World -> World +updateRBList w + | ButtonRight `S.member` _mouseButtons w && w ^? rbOptions . opCurInvPos == Just curinvid + = w & setEquipAllocation & setEquipActivation + | ButtonRight `S.member` _mouseButtons w = case cr ^? crInv . ix (_crInvSel cr) . itUse . eqSite of + Just esite -> w & rbOptions .~ EquipOptions (equipSiteToPositions esite) 0 curinvid DoNotMoveEquipment NoChangeActivateEquipment + & setEquipAllocation & setEquipActivation + Nothing -> w & rbOptions .~ NoRightButtonOptions + | otherwise = w & rbOptions .~ NoRightButtonOptions + where + curinvid = _crInvSel cr + cr = you w + +setEquipAllocation :: World -> World +setEquipAllocation w = case _rbOptions w of + EquipOptions {_opEquip = es,_opSel=i} -> + case you w ^? crInvEquipped . ix (_crInvSel (you w)) 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 .~ MoveEquipment + {_allocOldPos = epos + ,_allocNewPos = 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 .~ PutOnEquipment + {_allocNewPos = es !! i} + _ -> w +-- where +-- curpos = invSelPos w + +setEquipActivation :: World -> World +setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of + Just DoNotMoveEquipment -> w + Just RemoveEquipment { } + -> case _crLeftInvSel (you w) of + Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment + {_deactivateEquipment = i} + _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Just rbos + -> case _crLeftInvSel (you w) of + Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment + {_activateEquipment = invsel,_deactivateEquipment = i} + Just i | Just i == rbos ^? allocSwapID || Just i == rbos ^? allocRemoveID + -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i + Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment + {_activateEquipment = invsel} + Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment + where + invsel = _crInvSel (you w) + invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse) + +equipSiteToPositions :: EquipSite -> [EquipPosition] +equipSiteToPositions es = case es of + GoesOnHead -> [OnHead] + GoesOnChest -> [OnChest] + GoesOnBack -> [OnBack] + GoesOnWrist -> [OnLeftWrist,OnRightWrist] + GoesOnLegs -> [OnLegs] + GoesOnSpecial -> [OnSpecial] + + closeObjScrollDir :: Float -> World -> World closeObjScrollDir x | x > 0 = over closeObjects rotU diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 417068125..8de12fc43 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -115,6 +115,7 @@ flatShield = defaultEquipment , _aimZoom = ItZoom 20 0.2 1 , _aimStance = TwoHandFlat } + , _heldScroll = \_ _ -> id } , _itInvSize = 3 , _itInvDisplay = \it -> head (basicItemDisplay it) : @@ -236,9 +237,8 @@ headLamp = defaultEquipment & itUse . eqSite .~ GoesOnHead createHeadLamp :: Creature -> Int -> World -> World -createHeadLamp cr _ w = w - & tempLightSources .:~ tlsTimeRadColPos 1 200 0.5 - ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3))) +createHeadLamp cr _ = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 + ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3))) powerLegs :: Item powerLegs = defaultEquipment diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index e36733167..1fb6b539a 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -25,6 +25,7 @@ ruseAmmoParamsRate rate ht usemods = RightUse , _useMods = usemods , _useHammer = ht , _useAim = defaultAimParams + , _heldScroll = \_ _ -> id } defaultAimParams :: AimParams defaultAimParams = AimParams diff --git a/src/Dodge/Item/Weapon/BulletGun/Rod.hs b/src/Dodge/Item/Weapon/BulletGun/Rod.hs index f236fd721..a94cbe77c 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Rod.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Rod.hs @@ -128,7 +128,7 @@ sniperRifle = elephantGun & itType .~ SNIPERRIFLE & itParams . gunBarrels .~ SingleBarrel 0 & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} - & itScroll .~ zoomLongGun + & itUse . heldScroll .~ zoomLongGun & itScope .~ ZoomScope (V2 0 0) 0 1 False & itTargeting .~ targetLaser machineGun :: Item diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 49c64a676..7ce14cc82 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -80,7 +80,6 @@ autoGun = defaultAutoGun -- , _itZoom = defaultItZoom , _itEquipPict = pictureWeaponOnAim , _itAttachment = ItCharMode $ Seq.fromList "MS" - , _itScroll = scrollCharMode , _itParams = BulletShooter { _muzVel = 1 , _rifling = 0.9 @@ -91,6 +90,7 @@ autoGun = defaultAutoGun , _randomOffset = 0 } } + & itUse . heldScroll .~ scrollCharMode autoGunPic :: Item -> SPic autoGunPic it = noPic $ colorSH red (prismPoly @@ -295,7 +295,7 @@ longGun = defaultGun & useAim . aimRange .~ 1 & useAim . aimStance .~ TwoHandTwist & useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} - , _itScroll = zoomLongGun + & heldScroll .~ zoomLongGun , _itAttachment = NoItAttachment , _itScope = ZoomScope (V2 0 0) 0 1 False -- , _itEffect = itemLaserScopeEffect diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 53e943af5..04fef05f9 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -62,8 +62,9 @@ subInventoryDisplay subinv cfig w = case subinv of NoSubInventory -> pictures [ selcursor , closeobjectcursor - , equipcursor , equipcursors + , equipcursor -- the order is important, this should go on top of the other equipcursors + , rboptions ] TweakInventory -> pictures --[ mCurs it cfig w @@ -126,11 +127,43 @@ subInventoryDisplay subinv cfig w = case subinv of curpos = invSelPos w cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w) equipcursor = case _crLeftInvSel cr of - Nothing -> mempty - Just invid -> f' cyan invid + Just invid | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w) + -> f cyan invid (_crInvEquipped cr IM.! invid) + _ -> mempty equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) - f' col invid = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text "EQUIPPED" - f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos + f col invid epos + | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w) + = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos + | otherwise = mempty + --rboptions = listTextPicturesAtOffset 200 0 cfig (selNumPos invid w) ["TEST","ME"] + rboptions = drawRBOptions cfig w (_rbOptions w) + +drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture +drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} = + listTextPicturesAtOffset 252 0 cfig (curpos-i) (map (text . eqPosText) es) + <> case ae of + DoNotMoveEquipment -> mempty + PutOnEquipment {} + -> putontext + MoveEquipment {_allocOldPos = oldp } + -> putontext <> extratext ("MOVES FROM "++eqPosText oldp) + SwapEquipment { _allocOldPos = oldp, _allocSwapID = sid } + -> putontext <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp) + ReplaceEquipment { _allocRemoveID = rid } + -> putontext <> extratext ("REMOVES " ++ otheritem rid) + RemoveEquipment { } + -> takeofftext + where + takeofftext = listTextPictureAt 144 0 cfig curpos (text " TAKE OFF") + putontext = listTextPictureAt 144 0 cfig curpos (text " PUT ONTO") + extratext str = listTextPictureAt 350 0 cfig curpos (text (str ++ deactivatetext)) + deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of + Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k) + Nothing -> "" + curpos = invSelPos w + otheritem j = _itName (_crInv (you w) IM.! j) +drawRBOptions _ _ _ = mempty + eqPosText :: EquipPosition -> String eqPosText ep = case ep of diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d2fa382db..df1876377 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -80,6 +80,7 @@ functionalUpdate cfig w = checkEndGame . updateSeenWalls -- . (youHammerPosition %~ moveHammerUp) . updateTerminal + . updateRBList $ updateCloseObjects w where --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 07d880432..e1fd99f7d 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -25,6 +25,7 @@ updatePressedButtons pkeys w = useLeftItem (_yourID w) w | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) = w & doubleMouseHammer .~ HammerDown + | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle = w & cameraRot -~ rotation & clickMousePos .~ _mousePos w @@ -36,6 +37,7 @@ updatePressedButtons pkeys w isDown but = but `S.member` pkeys rotation = angleBetween (_mousePos w) (_clickMousePos w) + updatePressedButtonsCarte :: S.Set MouseButton -> World -> World updatePressedButtonsCarte pkeys w | isDown ButtonRight = w