This commit is contained in:
2022-12-27 14:46:13 +00:00
parent 85738adff1
commit 9ada489993
4 changed files with 62 additions and 56 deletions
+2 -2
View File
@@ -20,8 +20,8 @@ data HUDElement
data SubInventory data SubInventory
= NoSubInventory = NoSubInventory
| ExamineInventory {_examineInvSel :: Maybe Int} | ExamineInventory {_subInvSel :: Maybe Int}
| CombineInventory {_combineInvSel :: Maybe Int} | CombineInventory {_subInvSel :: Maybe Int}
| LockedInventory | LockedInventory
| DisplayTerminal {_termID :: Int} | DisplayTerminal {_termID :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show, Read) --Generic, Flat)
+19 -24
View File
@@ -50,22 +50,25 @@ rmInvItem ::
Int -> Int ->
World -> World ->
World World
rmInvItem cid invid w = case w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of
Just x | x > 1 -> w & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1 Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount %~ subtract 1
_ -> _ ->
w w
& cWorld . lWorld . creatures . ix cid . crInv %~ f & pointcid . crInv %~ f
& cWorld . lWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction & pointcid . crInvSel %~ stopCrInvSelAction
& cWorld . lWorld . creatures . ix cid . crInvSel . iselPos %~ g & pointcid . crInvSel . iselPos %~ g
& cWorld . lWorld . creatures . ix cid . crLeftInvSel %~ g' & pointcid . crLeftInvSel %~ g'
& removeAnySlotEquipment & removeAnySlotEquipment
& dounequipfunction & dounequipfunction
& doanyitemeffect & doanyitemeffect
& cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.delete invid
& cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g & pointcid . crInvEquipped %~ IM.mapKeys g
where where
-- TODO check whether this can be mapKeysMonotonic -- TODO check whether this can be mapKeysMonotonic
getcid = cWorld . lWorld . creatures . ix cid
pointcid = cWorld . lWorld . creatures . ix cid
stopCrInvSelAction (InvSel i a) stopCrInvSelAction (InvSel i a)
| i == invid = InvSel i NoInvSelAction | i == invid = InvSel i NoInvSelAction
| otherwise = InvSel i a | otherwise = InvSel i a
@@ -78,9 +81,9 @@ rmInvItem cid invid w = case w ^? cWorld . lWorld . creatures . ix cid . crInv .
rmf <- itm ^? itEffect . ieOnDrop rmf <- itm ^? itEffect . ieOnDrop
return $ doInvEffect rmf itm cr return $ doInvEffect rmf itm cr
removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> cWorld . lWorld . creatures . ix cid . crEquipment . at epos .~ Nothing Just epos -> pointcid . crEquipment . at epos .~ Nothing
Nothing -> id Nothing -> id
maxk = fmap fst $ IM.lookupMax $ w ^?! cWorld . lWorld . creatures . ix cid . crInv maxk = fmap fst $ IM.lookupMax $ cr ^?! crInv
f inv = f inv =
let (xs, ys) = IM.split invid inv let (xs, ys) = IM.split invid inv
in xs `IM.union` IM.mapKeys (subtract 1) ys in xs `IM.union` IM.mapKeys (subtract 1) ys
@@ -143,13 +146,7 @@ selNumCol :: Int -> World -> Color
selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i selNumCol i w = fromMaybe white $ trimapAugmentInv _itInvColor invDimColor closeObjectCol w IM.!? i
invSelPos :: World -> Int invSelPos :: World -> Int
invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w)) invSelPos w = sum . fst $ IM.split (yourInvSel w) (augmentedInvSizes w)
where
invsel = yourInvSel w
splitgap = 0
-- splitgap
-- | invsel < length (yourInv w) = 0
-- | otherwise = 1
updateTerminal :: World -> World updateTerminal :: World -> World
updateTerminal = checkTermDist updateTerminal = checkTermDist
@@ -204,8 +201,6 @@ updateRBList w
& setEquipActivation & setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions Nothing -> w & rbOptions .~ NoRightButtonOptions
where where
-- | otherwise = w & rbOptions .~ NoRightButtonOptions
curinvid = crSel cr curinvid = crSel cr
cr = you w cr = you w
@@ -318,15 +313,15 @@ changeInvSel i w
| n == 0 = w | n == 0 = w
| yourInvSel w < n = | yourInvSel w < n =
w w
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ (`mod` n) . subtract i & pointcrInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselAction .~ NoInvSelAction & pointcrInvSel . iselAction .~ NoInvSelAction
| otherwise = | otherwise =
w w
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n)) & pointcrInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselAction .~ NoInvSelAction & pointcrInvSel . iselAction .~ NoInvSelAction
where where
-- arguably this should jump the invpos into the inventory proper -- arguably this should jump the invpos into the inventory proper
pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel
n = length $ w ^?! cWorld . lWorld . creatures . ix 0 . crInv n = length $ w ^?! cWorld . lWorld . creatures . ix 0 . crInv
numCO = length $ w ^. cWorld . lWorld . closeObjects numCO = length $ w ^. cWorld . lWorld . closeObjects
-2
View File
@@ -4,8 +4,6 @@ module Dodge.Update.Input
, doInputScreenInput , doInputScreenInput
) where ) where
--import Dodge.Inventory.SelectionList
--import Dodge.Render.HUD
import Dodge.Terminal.LeftButton import Dodge.Terminal.LeftButton
import Dodge.Save import Dodge.Save
import Dodge.Debug.Terminal import Dodge.Debug.Terminal
+37 -24
View File
@@ -1,4 +1,6 @@
module Dodge.Update.Scroll where module Dodge.Update.Scroll (
updateWheelEvent,
) where
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
@@ -26,7 +28,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
-- this lock can be sensibly applied, perhaps -- this lock can be sensibly applied, perhaps
| w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
(_, EquipOptions{}) -> scrollRBOption y w (_, EquipOptions{}) -> scrollRBOption yi w
(Nothing, _) -> closeObjScrollDir y w (Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> doHeldScroll f y (you w) w (Just f, _) -> doHeldScroll f y (you w) w
| lbDown -> w & cWorld . camPos . camZoom +~ y | lbDown -> w & cWorld . camPos . camZoom +~ y
@@ -37,19 +39,41 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| rbDown -> w & changeTweakParam mi yi | rbDown -> w & changeTweakParam mi yi
| otherwise -> w & moveTweakSel yi | otherwise -> w & moveTweakSel yi
DisplayInventory CombineInventory{} -> DisplayInventory CombineInventory{} -> w & moveCombineSel yi
w DisplayInventory (DisplayTerminal tmid) -> terminalWheelEvent yi tmid w
& cWorld . lWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) _ -> w
DisplayInventory (DisplayTerminal tmid) where
| rbDown && inTermFocus w -> y = fromIntegral yi
numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
rbDown = ButtonRight `M.member` _mouseButtons (_input w)
lbDown = ButtonLeft `M.member` _mouseButtons (_input w)
invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
moveCombineSel :: Int -> World -> World
moveCombineSel yi w = moveSubSel yi (length $ combineItemListYou w) w
moveSubSel :: Int -> Int -> World -> World
moveSubSel yi maxyi =
cWorld . lWorld . hud . hudElement . subInventory . subInvSel . _Just
%~ ((`mod` maxyi) . subtract yi)
guardDisconnectedID :: Int -> World -> World -> World
guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
Just TerminalReady -> w'
_ -> w
terminalWheelEvent :: Int -> Int -> World -> World
terminalWheelEvent yi tmid w
| rbDown && inTermFocus w =
guardDisconnectedID tmid w $ guardDisconnectedID tmid w $
w w
& cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
| inTermFocus w -> | inTermFocus w =
w w
& cWorld . lWorld . terminals . ix tmid %~ updatetermsel & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
_ -> w | otherwise = w
where where
rbDown = ButtonRight `M.member` _mouseButtons (_input w)
updatetermsel tm = case tm ^? tmInput . tiSel of updatetermsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm & tmInput . tiSel .~ (0, 0) Nothing -> tm & tmInput . tiSel .~ (0, 0)
Just (i, _) -> Just (i, _) ->
@@ -67,27 +91,16 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
where where
tc = scrollCommands tm !! i tc = scrollCommands tm !! i
arg = getArguments' tc tm w' !! j arg = getArguments' tc tm w' !! j
numcombs = length $ combineItemListYou w
y = fromIntegral yi
numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
rbDown = ButtonRight `M.member` _mouseButtons (_input w)
lbDown = ButtonLeft `M.member` _mouseButtons (_input w)
invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
guardDisconnectedID :: Int -> World -> World -> World scrollRBOption :: Int -> World -> World
guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
Just TerminalReady -> w'
_ -> w
scrollRBOption :: Float -> World -> World
scrollRBOption y w scrollRBOption y w
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1)) | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ y))
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1) | y > 0 = w & rbOptions . opSel %~ (max 0 . subtract y)
| otherwise = w | otherwise = w
moveTweakSel :: Int -> World -> World moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . examineInvSel . _Just %~ (`mod` length l) . subtract i Just l -> moveSubSel i (length l) w
_ -> w _ -> w
changeTweakParam :: Maybe Int -> Int -> World -> World changeTweakParam :: Maybe Int -> Int -> World -> World