From 031af611cd8ab3c6871c9a846c2b200c9328a3e7 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 5 May 2023 01:59:40 +0100 Subject: [PATCH] Cleanup, stop assigning hotkeys to unequipped items --- src/Dodge/Creature/Impulse/UseItem.hs | 23 +-- src/Dodge/Creature/ReaderUpdate.hs | 4 +- src/Dodge/Creature/YourControl.hs | 90 ++++++++--- src/Dodge/Data/Creature.hs | 2 +- src/Dodge/Data/Equipment/Misc.hs | 6 + .../Data/Item/Use/Consumption/LoadAction.hs | 7 - src/Dodge/Default/Creature.hs | 1 - src/Dodge/Inventory.hs | 132 +++++++++-------- src/Dodge/Inventory/SelectionList.hs | 20 ++- src/Dodge/ItEffect.hs | 3 +- src/Dodge/Render/HUD.hs | 140 +++++------------- src/Dodge/Terminal.hs | 2 +- src/Dodge/TestString.hs | 12 +- 13 files changed, 227 insertions(+), 215 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index a85a1d40f..410ecb9f7 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -2,8 +2,10 @@ module Dodge.Creature.Impulse.UseItem ( useItem, doTopInvLeftClick, itemEffect, + tryUseL, ) where +import Dodge.Hotkey import Control.Lens import Control.Monad import Data.Foldable @@ -50,7 +52,6 @@ itemEffect cr it w = case it ^. itUse of setuhamdown $ hammerTest ( toggleEquipmentAt (_rbOptions w) itRef cr - . activateEquipmentAt (_rbOptions w) cr ) tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World @@ -68,13 +69,6 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic) where ic = _heldConsumption (_itUse it) -activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World -activateEquipmentAt rbo cr = - cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of - (Just i, _) -> crLeftInvSel . lisMPos ?~ i - (_, Just _) -> crLeftInvSel . lisMPos .~ Nothing - _ -> id - toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of Just DoNotMoveEquipment -> w @@ -83,6 +77,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of & crpoint . crEquipment . at newp ?~ invid & crpoint . crInvEquipped . at invid ?~ newp & onequip itm cr + & assignNewHotkey invid Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} -> w & crpoint . crEquipment . at newp ?~ invid @@ -101,11 +96,14 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of & crpoint . crInvEquipped . at rid .~ Nothing & onremove (itmat rid) cr & onequip itm cr + & crpoint %~ removeHotkey rid + & assignNewHotkey invid Just RemoveEquipment{_allocOldPos = oldp} -> w & crpoint . crEquipment . at oldp .~ Nothing & crpoint . crInvEquipped . at invid .~ Nothing & onremove itm cr + & crpoint %~ removeHotkey invid Nothing -> error "tried to toggle equipment when not prepared" where crpoint = cWorld . lWorld . creatures . ix (_crID cr) @@ -118,10 +116,6 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of doTopInvLeftClick :: Creature -> World -> World doTopInvLeftClick cr w = fromMaybe w $ do guard . not $ _crInvLock cr - return $ doTopInvLeftClick' cr w - -doTopInvLeftClick' :: Creature -> World -> World -doTopInvLeftClick' cr w = fromMaybe (doTopInvLeftClickSearch cr w) $ do invid <- cr ^? crManipulation . manObject . inInventory . ispItem ituse <- cr ^? crInv . ix invid . itUse case ituse of @@ -136,11 +130,6 @@ equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of | otherwise -> useItem cr w _ -> tryUseL (_crID cr) invid w -doTopInvLeftClickSearch :: Creature -> World -> World -doTopInvLeftClickSearch cr w = fromMaybe w $ do - invid <- cr ^. crLeftInvSel . lisMPos - return $ tryUseL (_crID cr) invid w - tryUseL :: Int -> Int -> World -> World tryUseL crid invid w = fromMaybe w $ do cr <- w ^? cWorld . lWorld . creatures . ix crid diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 98670fd4c..539cbf0dd 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -56,7 +56,7 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos mtpos = do tpos <- _crPos <$> _targetCr int guard $ hasLOSIndirect (_crPos cr) tpos w - return $ tpos + return tpos mpos = mtpos <|> _mvToPoint int setViewPos :: World -> Creature -> Creature @@ -67,7 +67,7 @@ setViewPos w cr = cr & crIntention . viewPoint %~ ((<|> mpos) . (attentionViewPo attentionViewPoint :: World -> Creature -> Maybe Point2 attentionViewPoint w cr = do attention <- cr ^? crPerception . cpAttention . getAttentiveTo - cid <- (sortOn snd $ IM.toList attention) ^? ix 0 . _1 + cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1 tcr <- w ^? cWorld . lWorld . creatures . ix cid guard $ visionCheck cr (_crPos tcr) > 0 return (_crPos tcr) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 57cd3264a..3cc42f510 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -2,16 +2,19 @@ module Dodge.Creature.YourControl ( yourControl, ) where -import Dodge.WASD -import Dodge.Base.You import Dodge.Creature.Impulse.UseItem +import Dodge.Hotkey +import Control.Monad +import Data.Foldable import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base.Coordinate +import Dodge.Base.You import Dodge.Creature.Impulse.Movement import Dodge.Creature.Test import Dodge.Data.World import Dodge.InputFocus +import Dodge.WASD import Geometry import LensHelp import qualified SDL @@ -20,13 +23,15 @@ import qualified SDL yourControl :: Creature -> World -> World yourControl cr w | inInputFocus w = w - | not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr) - %~ wasdWithAiming w (_mvSpeed $ _crMvType cr) + | not intopinv = + w & cWorld . lWorld . creatures . ix (_crID cr) + %~ wasdWithAiming w (_mvSpeed $ _crMvType cr) | otherwise = w & cWorld . lWorld . creatures . ix (_crID cr) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w))) & pressedMBEffectsTopInventory pkeys + & handleHotkeys where pkeys = w ^. input . mouseButtons intopinv = fromMaybe False $ do @@ -35,12 +40,60 @@ yourControl cr w NoSubInventory -> True _ -> False ---dimCreatureLight :: Creature -> World -> World ---dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) +handleHotkeys :: World -> World +handleHotkeys w + | SDL.ButtonRight `M.member` _mouseButtons (_input w) = foldl' tryAssignHotkey w allHotkeys + | otherwise = foldl' useHotKey w (M.intersection hotkeys (w ^. input . pressedKeys)) + where + hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys --- note the order of operation, setting the posture first--this prevents the twist fire bug +useHotKey :: World -> Int -> World +useHotKey w invid = tryUseL 0 invid w + +allHotkeys :: [SDL.Scancode] +allHotkeys = map hotkeyToScancode [minBound .. maxBound] + +hotkeyToScancode :: Hotkey -> SDL.Scancode +hotkeyToScancode x = case x of + HotkeyQ -> SDL.ScancodeQ + HotkeyE -> SDL.ScancodeE + Hotkey1 -> SDL.Scancode1 + Hotkey2 -> SDL.Scancode2 + Hotkey3 -> SDL.Scancode3 + Hotkey4 -> SDL.Scancode4 + Hotkey5 -> SDL.Scancode5 + Hotkey6 -> SDL.Scancode6 + Hotkey7 -> SDL.Scancode7 + Hotkey8 -> SDL.Scancode8 + Hotkey9 -> SDL.Scancode9 + Hotkey0 -> SDL.Scancode0 + +scancodeToHotkey :: SDL.Scancode -> Hotkey +scancodeToHotkey x = case x of + SDL.ScancodeQ -> HotkeyQ + SDL.ScancodeE -> HotkeyE + SDL.Scancode1 -> Hotkey1 + SDL.Scancode2 -> Hotkey2 + SDL.Scancode3 -> Hotkey3 + SDL.Scancode4 -> Hotkey4 + SDL.Scancode5 -> Hotkey5 + SDL.Scancode6 -> Hotkey6 + SDL.Scancode7 -> Hotkey7 + SDL.Scancode8 -> Hotkey8 + SDL.Scancode9 -> Hotkey9 + SDL.Scancode0 -> Hotkey0 + _ -> undefined + +tryAssignHotkey :: World -> SDL.Scancode -> World +tryAssignHotkey w sc = fromMaybe w $ do + pt <- w ^? input . pressedKeys . ix sc + guard (pt == InitialPress) + cr <- w ^? cWorld . lWorld . creatures . ix 0 + itid <- cr ^? crManipulation . manObject . inInventory . ispItem + return $ assignHotkey itid (scancodeToHotkey sc) w -- | Turn key presses into creature movement. +-- | note the order of operation, setting the posture first--this prevents the twist fire bug wasdWithAiming :: World -> -- | Base speed @@ -63,9 +116,11 @@ wasdWithAiming w speed cr itRef <- cr ^? crManipulation . manObject . inInventory . 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) + case (astance, currenttwistamount) of + (TwoHandTwist, 0) -> + return $ + (crTwist .~ twistamount * pi) + . (crDir -~ twistamount * pi) _ -> Nothing theMovement | movDir == V2 0 0 = id @@ -78,8 +133,8 @@ wasdWithAiming w speed cr dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir) movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming - mouseDir = fromMaybe - (argV (_mousePos (_input w)) + (w ^. wCam . camRot) ) + mouseDir = fromMaybe + (argV (_mousePos (_input w)) + (w ^. wCam . camRot)) $ do itRef <- cr ^? crManipulation . manObject . inInventory . ispItem _ <- cr ^? crInv . ix itRef . itScope . scopePos @@ -92,7 +147,6 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr itRef <- cr ^? crManipulation . manObject . inInventory . ispItem cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed - -- | Set posture according to mouse presses. mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature mouseActionsCr pkeys cr @@ -114,10 +168,12 @@ pressedMBEffectsTopInventory pkeys w | otherwise = w where inTopInv = case w ^. hud . hudElement of - DisplayInventory {_subInventory = NoSubInventory} -> True + DisplayInventory{_subInventory = NoSubInventory} -> True _ -> False isDown but = but `M.member` pkeys theinput = w ^. input - rotation = maybe 0 - (angleBetween (theinput ^. mousePos)) - (theinput ^. heldPos . at SDL.ButtonMiddle) + rotation = + maybe + 0 + (angleBetween (theinput ^. mousePos)) + (theinput ^. heldPos . at SDL.ButtonMiddle) diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index ec005f2de..f9d484103 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -56,7 +56,7 @@ data Creature = Creature , _crInvLock :: Bool , _crInvEquipped :: IM.IntMap EquipPosition , _crEquipment :: M.Map EquipPosition Int - , _crLeftInvSel :: LeftInvSel +-- , _crLeftInvSel :: LeftInvSel , _crInvHotkeys :: IM.IntMap Hotkey , _crHotkeys :: M.Map Hotkey Int , _crState :: CreatureState diff --git a/src/Dodge/Data/Equipment/Misc.hs b/src/Dodge/Data/Equipment/Misc.hs index dfeaf33fa..6b34bcf56 100644 --- a/src/Dodge/Data/Equipment/Misc.hs +++ b/src/Dodge/Data/Equipment/Misc.hs @@ -33,6 +33,12 @@ data Hotkey = HotkeyQ | Hotkey2 | Hotkey3 | Hotkey4 + | Hotkey5 + | Hotkey6 + | Hotkey7 + | Hotkey8 + | Hotkey9 + | Hotkey0 deriving (Eq, Show, Read, Ord, Bounded, Enum) --Generic, Flat) diff --git a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs index 5e76d00c6..ae4290a78 100644 --- a/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs +++ b/src/Dodge/Data/Item/Use/Consumption/LoadAction.hs @@ -27,7 +27,6 @@ data Manipulation -- should be ManipulatedObject? data ManipulatedObject = InInventory {_inInventory :: InventoryManipulation} | SelNothing --- | SelCloseObject {_ispCloseObject :: Int} | InNearby {_inNearby :: NearbyManipulation} deriving (Eq, Ord, Show, Read) --Generic, Flat) @@ -46,16 +45,11 @@ data InvSelAction | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction} deriving (Eq, Ord, Show, Read) --Generic, Flat) -data LeftInvSel = LeftInvSel - { _lisMPos :: Maybe Int - } - makeLenses ''LoadAction makeLenses ''ManipulatedObject makeLenses ''Manipulation makeLenses ''InventoryManipulation makeLenses ''NearbyManipulation -makeLenses ''LeftInvSel makeLenses ''InvSelAction deriveJSON defaultOptions ''LoadAction deriveJSON defaultOptions ''InvSelAction @@ -63,4 +57,3 @@ deriveJSON defaultOptions ''InventoryManipulation deriveJSON defaultOptions ''NearbyManipulation deriveJSON defaultOptions ''ManipulatedObject deriveJSON defaultOptions ''Manipulation -deriveJSON defaultOptions ''LeftInvSel diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index bacab0dbf..90c2bb27a 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -30,7 +30,6 @@ defaultCreature = , _crManipulation = Manipulator SelNothing , _crInvCapacity = 25 , _crInvLock = False - , _crLeftInvSel = LeftInvSel Nothing , _crState = defaultState , _crCorpse = MakeDefaultCorpse , _crMaterial = Flesh diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 959450343..049c2dc06 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -51,13 +51,21 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount _ -> w & pointcid %~ crCancelReloading - & removeAnySlotEquipment -- the ordering - & dounequipfunction -- of these is - & pointcid . crInv %~ f -- important - & pointcid . crLeftInvSel . lisMPos %~ g' & doanyitemeffect + & dounequipfunction --the ordering of these is + & pointcid . crInv %~ f -- important +-- & pointcid . crLeftInvSel . lisMPos %~ g' + + & removeAnySlotEquipment + & pointcid . crEquipment . each %~ g & pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.mapKeys g + + & removeanyactivation + & pointcid . crHotkeys . each %~ g + & pointcid . crInvHotkeys %~ IM.delete invid + & pointcid . crInvHotkeys %~ IM.mapKeys g + & updateselection & worldEventFlags . at InventoryChange ?~ () where @@ -81,6 +89,9 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount removeAnySlotEquipment = fromMaybe id $ do epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid return $ pointcid . crEquipment . at epos .~ Nothing + removeanyactivation = fromMaybe id $ do + epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid + return $ pointcid . crHotkeys . at epos .~ Nothing maxk = fmap fst $ IM.lookupMax $ cr ^. crInv f inv = let (xs, ys) = IM.split invid inv @@ -89,11 +100,11 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount g x | x > invid || Just x == maxk = max 0 $ x - 1 | otherwise = x - g' Nothing = Nothing - g' (Just x) - | x == invid = Nothing - | x > invid || Just x == maxk = Just $ max 0 $ x - 1 - | otherwise = Just x +-- g' Nothing = Nothing +-- g' (Just x) +-- | x == invid = Nothing +-- | x > invid || Just x == maxk = Just $ max 0 $ x - 1 +-- | otherwise = Just x rmSelectedInvItem :: Int -> World -> World rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of @@ -131,7 +142,7 @@ updateCloseObjects w = updateRBList :: World -> World updateRBList w | w ^? rbOptions . opItemID == mcurrentitemid = - w & setEquipAllocationActivation + w & setEquipAllocation | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do i <- cr ^? crManipulation . manObject . inInventory . ispItem esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite @@ -146,7 +157,7 @@ updateRBList w , _opAllocateEquipment = DoNotMoveEquipment , _opActivateEquipment = NoChangeActivateEquipment } - & setEquipAllocationActivation + & setEquipAllocation where mcurrentitemid = do i <- cr ^? crManipulation . manObject . inInventory . ispItem @@ -164,9 +175,6 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment where hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep -setEquipAllocationActivation :: World -> World -setEquipAllocationActivation = setEquipActivation . setEquipAllocation - setEquipAllocation :: World -> World setEquipAllocation w = fromMaybe w $ do curpos <- you w ^? crManipulation . manObject . inInventory . ispItem @@ -196,46 +204,46 @@ setEquipAllocation w = fromMaybe w $ do } Nothing -> PutOnEquipment{_allocNewPos = es} -setEquipActivation :: World -> World -setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of - Just DoNotMoveEquipment -> w - Just RemoveEquipment{} -> - case you w ^. crLeftInvSel . lisMPos of - Just i - | Just i == minvsel -> - w & rbOptions . opActivateEquipment - .~ DeactivateEquipment - { _deactivateEquipment = i - } - _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Just rbos -> - case you w ^. crLeftInvSel . lisMPos of - Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Just i - | invselcanactivate -> - w & rbOptions . opActivateEquipment - .~ ActivateDeactivateEquipment - { _activateEquipment = fromJust minvsel - , _deactivateEquipment = i - } - Just i - | Just i == rbos ^? allocRemoveID -> - w & rbOptions . opActivateEquipment .~ DeactivateEquipment i - Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Nothing - | invselcanactivate -> - w & rbOptions . opActivateEquipment - .~ ActivateEquipment - { _activateEquipment = fromJust minvsel - } - Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment - where - minvsel = cr ^? crManipulation . manObject . inInventory . ispItem - cr = you w - invselcanactivate = isJust $ do - i <- minvsel - return $ cr ^? crInv . ix i . itUse . leftUse +--setEquipActivation :: World -> World +--setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of +-- Just DoNotMoveEquipment -> w +-- Just RemoveEquipment{} -> +-- case you w ^. crLeftInvSel . lisMPos of +-- Just i +-- | Just i == minvsel -> +-- w & rbOptions . opActivateEquipment +-- .~ DeactivateEquipment +-- { _deactivateEquipment = i +-- } +-- _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment +-- Just rbos -> +-- case you w ^. crLeftInvSel . lisMPos of +-- Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment +-- Just i +-- | invselcanactivate -> +-- w & rbOptions . opActivateEquipment +-- .~ ActivateDeactivateEquipment +-- { _activateEquipment = fromJust minvsel +-- , _deactivateEquipment = i +-- } +-- Just i +-- | Just i == rbos ^? allocRemoveID -> +-- w & rbOptions . opActivateEquipment .~ DeactivateEquipment i +-- Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment +-- Nothing +-- | invselcanactivate -> +-- w & rbOptions . opActivateEquipment +-- .~ ActivateEquipment +-- { _activateEquipment = fromJust minvsel +-- } +-- Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment +-- Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment +-- where +-- minvsel = cr ^? crManipulation . manObject . inInventory . ispItem +-- cr = you w +-- invselcanactivate = isJust $ do +-- i <- minvsel +-- return $ cr ^? crInv . ix i . itUse . leftUse equipSiteToPositions :: EquipSite -> [EquipPosition] equipSiteToPositions es = case es of @@ -288,21 +296,27 @@ changeSwapInv f i w = fromMaybe w $ do & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k & worldEventFlags . at InventoryChange ?~ () where - updateLeftInvSel k li - | i == li = k - | k == li = i - | otherwise = li +-- updateLeftInvSel k li +-- | i == li = k +-- | k == li = i +-- | otherwise = li updatecreature k = (crInv %~ IM.safeSwapKeys i k) - . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k) +-- . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k) . (crManipulation . manObject . inInventory . ispItem .~ k) . (crInvEquipped %~ IM.safeSwapKeys i k) . swapSite i k . swapSite k i + . (crInvHotkeys %~ IM.safeSwapKeys i k) + . swapSite' i k + . swapSite' k i cr = you w swapSite a b = case cr ^? crInvEquipped . ix a of Just epos -> crEquipment . ix epos .~ b Nothing -> id + swapSite' a b = case cr ^? crInvHotkeys . ix a of + Just epos -> crHotkeys . ix epos .~ b + Nothing -> id changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index c77e49456..cac081323 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -3,6 +3,7 @@ module Dodge.Inventory.SelectionList ( closeObjectToSelectionItem, ) where +import Dodge.Equipment.Text import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.Item.SlotsTaken @@ -13,7 +14,7 @@ import Picture.Base invSelectionItem :: Creature -> Int -> Item -> SelectionItem () invSelectionItem cr i it = SelectionItem - { _siPictures = pics + { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey) , _siHeight = length pics , _siIsSelectable = True , _siColor = col @@ -21,12 +22,29 @@ invSelectionItem cr i it = , _siPayload = () } where + anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i) + anyequippos = maybe [] ((' ':) . eqPosText) (cr ^? crInvEquipped . ix i) col = _itInvColor it pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of UndroppableIdentified -> itemDisplay it _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it _ -> itemDisplay it +hotkeyToString :: Hotkey -> String +hotkeyToString x = case x of + HotkeyQ -> "[Q]" + HotkeyE -> "[E]" + Hotkey1 -> "[1]" + Hotkey2 -> "[2]" + Hotkey3 -> "[3]" + Hotkey4 -> "[4]" + Hotkey5 -> "[5]" + Hotkey6 -> "[6]" + Hotkey7 -> "[7]" + Hotkey8 -> "[8]" + Hotkey9 -> "[9]" + Hotkey0 -> "[0]" + closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem () closeObjectToSelectionItem e = SelectionItem diff --git a/src/Dodge/ItEffect.hs b/src/Dodge/ItEffect.hs index bc9e85383..78e715bac 100644 --- a/src/Dodge/ItEffect.hs +++ b/src/Dodge/ItEffect.hs @@ -1,5 +1,6 @@ module Dodge.ItEffect where +import qualified IntMapHelp as IM import Control.Lens import Dodge.Data.World import Dodge.Euse @@ -49,7 +50,7 @@ chargeIfInInventory itm cr w = chargeIfEquipped :: Item -> Creature -> World -> World chargeIfEquipped itm cr - | Just invid == cr ^. crLeftInvSel . lisMPos = + | invid `IM.member` (cr ^. crInvHotkeys) = ptrWpCharge %~ (min maxcharge . (+ 1)) | otherwise = ptrWpCharge .~ 0 where diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 23f5aa698..13fc5944b 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,9 +3,8 @@ module Dodge.Render.HUD ( drawHUD, ) where -import Dodge.SelectionSections import Control.Lens -import Data.Foldable +import Control.Monad import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Vector as V @@ -18,11 +17,13 @@ import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.Default.SelectionList +import Dodge.Equipment.Text import Dodge.Inventory import Dodge.Item.Info import Dodge.ListDisplayParams import Dodge.Render.Connectors import Dodge.Render.List +import Dodge.SelectionSections import Dodge.SelectionSections.Draw import Dodge.Tweak.Show import Geometry @@ -50,7 +51,7 @@ drawInventory sss = drawSelectionSections sss . invDisplayParams drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of LockedInventory -> mempty -- topInvCursor col cursPos cfig w - NoSubInventory -> drawNoSubInventory cfig w + NoSubInventory -> drawRBOptions cfig w ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w @@ -109,30 +110,36 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i _ -> x -drawNoSubInventory :: Configuration -> World -> Picture -drawNoSubInventory cfig w = - fold - [ equipcursors - , equipcursor -- the order is important, this should go on top of the other equipcursors - , rboptions - ] +drawRBOptions :: Configuration -> World -> Picture +drawRBOptions cfig w = fromMaybe mempty $ do + guard $ ButtonRight `M.member` _mouseButtons (_input w) + es <- w ^? rbOptions . opEquip + i <- w ^? rbOptions . opSel + ae <- w ^? rbOptions . opAllocateEquipment + sss <- w ^? hud . hudElement . diSections + (i', j) <- sss ^? sssExtra . sssSelPos . _Just + curpos <- selSecSelPos i' j sss + 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 - equipcursor = fromMaybe mempty $ do - invid <- cr ^. crLeftInvSel . lisMPos - sss <- w ^? hud . hudElement . diSections - pos <- selSecSelPos 0 invid sss - return $ - listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $ - _crInvEquipped cr IM.! invid - f col invid epos = fromMaybe mempty $ do - sss <- w ^? hud . hudElement . diSections - pos <- selSecSelPos 0 invid sss - return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos - equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) - cr = you w - rboptions - | ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w) - | otherwise = mempty + deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of + Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) + Nothing -> "" + otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j) examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do @@ -148,7 +155,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do cpos <- selSecSelPos i j sss let col = _siColor si return $ - pictures + mconcat [ fromMaybe mempty $ do strs <- si ^? siPayload . ciInfo return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs @@ -164,42 +171,6 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do sss' <- w ^? hud . hudElement . diSections return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i --- fromMaybe mempty $ do --- i <- mi --- let cpos = getIthPos i (sm ^. smShownItems) --- col <- sm ^? smShownItems . ix i . siColor --- return $ --- pictures --- [ fromMaybe mempty $ do --- strs <- sm ^? smShownItems . ix i . siPayload . ciInfo --- return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs --- , fromMaybe mempty $ do --- lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs --- return $ --- lnkMidPosInvSelsCol cfig w cpos col lnks --- -- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks --- <> foldMap invcursor lnks --- <> combineCounts cfig w lnks --- ] --- where --- invcursor i = fromMaybe mempty $ do --- sss <- w ^? hud . hudElement . diSections --- return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i - ---thirdColumnPara :: [String] -> SelectionList () ---thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs) --- where --- f str = --- SelectionItem --- { _siPictures = [text str] --- , _siHeight = 1 --- , _siIsSelectable = True --- , _siWidth = length str --- , _siColor = white --- , _siOffX = 0 --- , _siPayload = () --- } - displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do tm <- w ^? terminals . ix tid @@ -215,8 +186,8 @@ displayTerminal tid cfig w = fromMaybe mempty $ do . take (_tmMaxLines tm) $ _tmDisplayedLines tm displayTermInput tm = case _tmInput tm of - TerminalInput {_tiText = s, _tiFocus = hasfoc} - -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) + TerminalInput{_tiText = s, _tiFocus = hasfoc} -> + (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString displayInputText tm s | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s @@ -225,45 +196,6 @@ displayTerminal tid cfig w = fromMaybe mempty $ do | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w | otherwise = [] -drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture -drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} = - fromMaybe mempty $ do - sss <- w ^? hud . hudElement . diSections - (i', j) <- sss ^? sssExtra . sssSelPos . _Just - curpos <- selSecSelPos i' j sss - 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 - deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of - Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) - Nothing -> "" - otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j) -drawRBOptions _ _ _ = mempty - -eqPosText :: EquipPosition -> String -eqPosText ep = case ep of - OnHead -> "HEAD" - OnChest -> "CHEST" - OnBack -> "BACK" - OnLeftWrist -> "L.WRIST" - OnRightWrist -> "R.WRIST" - OnLegs -> "LEGS" - OnSpecial -> "EQUIPPED" - combineCounts :: Configuration -> World -> [Int] -> Picture combineCounts cfig w = foldMap f . group where diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 10bac342c..a7143aa5f 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -262,7 +262,7 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do makeTermPara ("Expects " ++ argtype ++ " as an argument") | otherwise = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) : - makeTermPara ("No argument input, cancelling") + makeTermPara "No argument input, cancelling" in Just $ fromMaybe setpartial $ safeHead args >>= (m M.!?) diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index d157ffeea..ef56f9d2a 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -18,10 +18,14 @@ import Dodge.Data.Universe --import qualified Data.Map.Strict as M --import qualified IntMapHelp as IM testStringInit :: Universe -> [String] -testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount - , show $ getSmoothScrollValue (u ^. uvWorld . input) - , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY) - ] +testStringInit u = getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys) + <> ["---"] + <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys) + +-- [show $ u ^. uvWorld . input . smoothScrollAmount +-- , show $ getSmoothScrollValue (u ^. uvWorld . input) +-- , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY) +-- ] -- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam) -- (u ^. uvWorld . cWorld . lWorld) -- , show a