Cleanup
This commit is contained in:
@@ -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
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user