justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup, delete hotkeys when deleting item from inventory

Browse Source
This commit is contained in:
justin
2025-01-01 14:04:25 +00:00
parent 0915e04b56
commit 7dd379d4bc
12 changed files with 497 additions and 492 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+2 -9
View File
@@ -13,14 +13,12 @@ import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Euse
import Dodge.HeldUse
--import Dodge.Hotkey
import Dodge.Inventory
import Dodge.Item.Grammar
--import Dodge.Item.Location
import qualified IntMapHelp as IM
useItem :: Int -> PressType -> World -> World
useItem invid pt w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
useItem :: Int -> PressType -> World -> Maybe World
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
let usedloc = useLocation itmloc
@@ -90,7 +88,6 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& onequip itm cr
-- & cWorld . lWorld %~ assignNewHotkey invid
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
@@ -109,16 +106,12 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
& crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
-- & cWorld . lWorld %~ removeHotkey rid
-- & cWorld . lWorld %~ assignNewHotkey invid
RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
& onremove itm cr
where
-- & cWorld . lWorld %~ removeHotkey invid
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat itRef
src/Dodge/Creature/YourControl.hs
+29 -36
View File
@@ -2,7 +2,7 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import Dodge.Inventory
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -12,6 +12,7 @@ import Dodge.Creature.Impulse.UseItem
import Dodge.Data.World
import Dodge.Hotkey
import Dodge.InputFocus
import Dodge.Inventory
import Dodge.WASD
import Geometry
import LensHelp
@@ -25,8 +26,8 @@ yourControl _ w
| Just NoSubInventory{} <- w ^? hud . hudElement . subInventory =
w
& cWorld . lWorld . creatures . ix 0
%~ (wasdWithAiming w . mouseActionsCr pkeys)
& pressedMBEffectsTopInventory pkeys
%~ (wasdWithAiming w . setCrPosture pkeys)
& tryClickUse pkeys
& handleHotkeys
| otherwise =
w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
@@ -36,17 +37,17 @@ yourControl _ w
handleHotkeys :: World -> World
handleHotkeys w
| SDL.ScancodeLShift `M.member` _pressedKeys (_input w)
|| SDL.ScancodeRShift `M.member` _pressedKeys (_input w) = fromMaybe w $ do
let hks = mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
invid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itID
return $ w & cWorld . lWorld %~ \lw -> foldl' (flip $ assignHotkey itid) lw hks
|| SDL.ScancodeRShift `M.member` _pressedKeys (_input w)
, hks <- mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
w & cWorld . lWorld %~ \lw' -> foldl' (flip $ assignHotkey itid) lw' hks
| SDL.ScancodeLCtrl `M.member` _pressedKeys (_input w)
|| SDL.ScancodeRCtrl `M.member` _pressedKeys (_input w) = fromMaybe w $ do
hk <- listToMaybe . mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
itid <- w ^? cWorld . lWorld . hotkeys . ix hk . unNInt
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
return $ w & augInvDirectSelect (0,invid,mempty)
|| SDL.ScancodeRCtrl `M.member` _pressedKeys (_input w)
, Just hk <- listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
, Just itid <- w ^? cWorld . lWorld . hotkeys . ix hk . unNInt
, Just invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID =
w & augInvDirectSelect (0, invid, mempty)
| otherwise =
M.foldl'
useHotkey
@@ -54,11 +55,12 @@ handleHotkeys w
(M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
where
thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
lw = w ^. cWorld . lWorld
useHotkey :: World -> (NewInt ItmInt, PressType) -> World
useHotkey w (NInt itid, pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
return $ useItem invid pt w
useItem invid pt w
hotkeyToScancode :: Hotkey -> SDL.Scancode
hotkeyToScancode x = case x of
@@ -152,34 +154,25 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
{- | Set posture according to mouse presses.
(should you be aiming without a selected item?)
-}
mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
mouseActionsCr pkeys
setCrPosture :: M.Map SDL.MouseButton Int -> Creature -> Creature
setCrPosture pkeys
| SDL.ButtonRight `M.member` pkeys = crStance . posture .~ Aiming
| otherwise = crStance . posture .~ AtEase
-- where
-- noaction = fromMaybe True $ do
-- theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
-- return $ theaction == NoInvSelAction
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
pressedMBEffectsTopInventory pkeys w
| Just ltime <- pkeys ^? ix SDL.ButtonLeft
, Just rtime <- pkeys ^? ix SDL.ButtonRight
, ltime <= rtime && inTopInv =
fromMaybe w $ do
invid <-
w
^? cWorld . lWorld . creatures . ix 0
. crManipulation
. manObject
. imSelectedItem
return $ useItem invid (f ltime) w
| otherwise = w
tryClickUse :: M.Map SDL.MouseButton Int -> World -> World
tryClickUse pkeys w = fromMaybe w $ do
ltime <- pkeys ^? ix SDL.ButtonLeft
rtime <- pkeys ^? ix SDL.ButtonRight
guard $ ltime <= rtime && inTopInv
invid <- w
^? cWorld . lWorld . creatures . ix 0
. crManipulation
. manObject
. imSelectedItem
useItem invid (f ltime) w
where
f 0 = InitialPress
f _ = ShortPress
-- youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
inTopInv = case w ^. hud . hudElement of
DisplayInventory{_subInventory = NoSubInventory{}} -> True
_ -> False
src/Dodge/Data/Item/Combine.hs
+1
View File
@@ -21,6 +21,7 @@ data ItemType
| TARGETING {_ibtTargeting :: TargetingType}
| BULLETMOD {_ibtBulletMod :: BulletMod}
| STICKYMOD
| ITEMSCANNER
deriving (Eq, Ord, Show, Read)
data CraftType
src/Dodge/Inventory.hs
+8 -2
View File
@@ -1,7 +1,6 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
checkInvSlotsYou,
rmInvItem,
rmInvItem,
destroyInvItem,
updateCloseObjects,
changeSwapSel,
@@ -46,10 +45,17 @@ destroyInvItem ::
World ->
World
destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc
& removeithotkey
where
removeitloc = fromMaybe id $ do
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
removeithotkey = fromMaybe id $ do
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
return $
(cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
. ( cWorld . lWorld . hotkeys . at hk .~ Nothing)
-- | after this the item at the inventory position will no longer exist
rmInvItem ::
src/Dodge/Inventory/Swap.hs
-22
View File
@@ -34,7 +34,6 @@ swapInvItems f i w = fromMaybe w $ do
& swapAnyExtraSelection i k
& checkConnection InventorySound disconnectItemS i k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
--x & swaphotkeys k
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -43,35 +42,15 @@ swapInvItems f i w = fromMaybe w $ do
-- a rethink is maybe in order
& checkConnection InventoryConnectSound connectItemS i k
where
-- & checkconnect k InventoryConnectSound connectItemS
-- cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos
-- checkconnect k stype s w'
-- | p (i+1) || p (i-1)
-- || p (k+1) || p (k-1) = soundStart stype cpos s Nothing w'
-- | otherwise = w'
-- where
-- p j = maybe False not $ w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j . itLocation . ilIsRoot
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . imSelectedItem .~ k)
-- . (crInvEquipped %~ IM.safeSwapKeys i k)
. swapSite i k
. swapSite k i
-- . (crInvHotkeys %~ IM.safeSwapKeys i k)
--x swaphotkeys k =
--x swapSite' i k
--x . swapSite' k i
--x . (cWorld . lWorld . imHotkeys %~ IM.safeSwapKeys i k)
cr = you w
--swapSite a b = case cr ^? crInvEquipped . ix a of
swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
Just epos -> crEquipment . ix epos .~ b
Nothing -> id
--swapSite' a b = case cr ^? crInvHotkeys . ix a of
--x swapSite' a b = case w ^? cWorld . lWorld . imHotkeys . ix a of
--x Just epos -> cWorld . lWorld . hotkeys . ix epos .~ b
--x Nothing -> id
swapAnyExtraSelection :: Int -> Int -> World -> World
swapAnyExtraSelection i k w = fromMaybe w $ do
@@ -98,4 +77,3 @@ isConnected x = case x ^. locLdtContext of
not (null $ x ^. locLDT . ldtRight)
|| not (null $ x ^. locLDT . ldtLeft)
_ -> True
src/Dodge/Item.hs
+1
View File
@@ -25,6 +25,7 @@ itemFromBase = \case
TARGETING tt -> targetingScope tt
BULLETMOD bm -> bulletModule bm
STICKYMOD -> stickyMod
ITEMSCANNER -> itemScanner
itemFromAmmoMag :: AmmoMagType -> Item
itemFromAmmoMag at = case at of
src/Dodge/Item/Display.hs
+1
View File
@@ -66,6 +66,7 @@ itemBaseName = \case
BULLETMOD (BulletModPayload btt) -> show btt
BULLETMOD (BulletModEffect btt) -> show btt
STICKYMOD -> "STICKYMOD"
ITEMSCANNER -> "ITEMSCANNER"
showAttachItem :: AttachType -> String
showAttachItem t = case t of
src/Dodge/Item/Draw/SPic.hs
+1
View File
@@ -41,6 +41,7 @@ itemSPic it = case it ^. itType of
TARGETING{} -> defSPic
BULLETMOD{} -> defSPic
STICKYMOD -> defSPic
ITEMSCANNER -> defSPic
craftItemSPic :: CraftType -> Shape
craftItemSPic = \case
src/Dodge/Item/Scope.hs
+8 -1
View File
@@ -15,6 +15,7 @@ module Dodge.Item.Scope (
bulletModule,
bulletPayloadModule,
smokeReducer,
itemScanner,
) where
import Dodge.Item.Attach
@@ -46,6 +47,12 @@ stickyMod =
& itType .~ STICKYMOD
& itUse .~ UseNothing
itemScanner :: Item
itemScanner =
defaultHeldItem
& itType .~ ITEMSCANNER
& itUse .~ UseNothing
bulletModule :: BulletMod -> Item
bulletModule bm =
@@ -80,7 +87,7 @@ remoteDetonator = makeAttach REMOTEDETONATOR
joystick :: Item
joystick = makeAttach JOYSTICK
-- & itUse . uaParams .~ APLinkProjectile Nothing
--
gimbal :: Item
gimbal = makeAttach GIMBAL
src/Dodge/Update/Camera.hs
+32 -31
View File
@@ -14,23 +14,19 @@ import Dodge.Base
import Dodge.Creature.Test
import Dodge.Data.Config
import Dodge.Data.World
--import Dodge.Equipment
--import Dodge.InputFocus
import Dodge.SmoothScroll
import Dodge.Viewpoints
import Dodge.WASD
import Dodge.Zoning.Wall
import Geometry
--import qualified IntMapHelp as IM
import LensHelp
import SDL (MouseButton (..))
--import qualified SDL
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World
updateCamera cfig w = case w ^. wCam . camControl of
CamInGame {} -> updateInGameCamera cfig w
CamInGame{} -> updateInGameCamera cfig w
CamFloat -> updateFloatingCamera cfig w
updateFloatingCamera :: Configuration -> World -> World
@@ -62,15 +58,19 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
return $ cam & camRot -~ angleBetween (theinput ^. mousePos) a
translateFloatingCameraKeys :: Input -> Camera -> Camera
translateFloatingCameraKeys theinput = (camCenter -~ thetran) . (camViewFrom -~ thetran)
translateFloatingCameraKeys theinput cam =
cam
& camCenter -~ thetran
& camViewFrom -~ thetran
where
thetran = 10 *.* wasdDir theinput
thetran = rotateV (cam ^. camRot) $ negate 10 *.* wasdDir theinput
zoomFloatingCamera :: Input -> Camera -> Camera
zoomFloatingCamera theinput
| ButtonRight `M.member` (theinput ^. mouseButtons) =
camZoom *~ ((39/40) ^^ negate (getSmoothScrollValue theinput))
camZoom *~ ((39 / 40) ^^ negate (getSmoothScrollValue theinput))
| otherwise = id
-- the 39/40 is taken from zoomSpeed
updateInGameCamera :: Configuration -> World -> World
@@ -78,14 +78,13 @@ updateInGameCamera cfig w =
w
& updateBounds cfig
& wCam %~ moveZoomCamera cfig (w ^. input) (you w) w
-- & updateScopeZoom
& rotateCamera cfig
& over wCam (setViewDistance cfig) -- I think this should be updated after the zoom?
moveZoomCamera :: Configuration -> Input -> Creature -> World -> Camera -> Camera
moveZoomCamera cfig theinput cr w campos =
campos
& camCenter .~ fromMaybe (_crPos cr +.+ offset ) mremotepos
& camCenter .~ fromMaybe (_crPos cr +.+ offset) mremotepos
& camViewFrom .~ fromMaybe (_crPos cr) mremotepos
& camZoom .~ newzoom
& camDefaultZoom .~ newDefaultZoom
@@ -101,9 +100,10 @@ moveZoomCamera cfig theinput cr w campos =
guard (SDL.ButtonRight `M.member` _mouseButtons theinput)
i <- cr ^? crManipulation . manObject . imSelectedItem
fmap docamrot (cr ^? crInv . ix i . itUse . uScope . opticPos)
noscopeoffset = docamrot $
noscopeoffset =
docamrot $
((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos theinput
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
newzoom = fromMaybe (newDefaultZoom * newItemZoom) $ do
i <- cr ^? crManipulation . manObject . imSelectedItem
cr ^? crInv . ix i . itUse . uScope . opticZoom
idealDefaultZoom = clipZoom wallZoom
@@ -135,6 +135,21 @@ moveZoomCamera cfig theinput cr w campos =
viewDistanceFromItems :: Creature -> Float
viewDistanceFromItems _ = 1
rotateCamera :: Configuration -> World -> World
rotateCamera cfig w
| Just ltime <- pkeys ^? ix SDL.ButtonLeft
, Just rtime <- pkeys ^? ix SDL.ButtonRight
, ltime > rtime =
w & wCam . camRot -~ rotation
| otherwise = ifConfigWallRotate cfig (w ^. input . mouseButtons) w
where
pkeys = w ^. input . mouseButtons
rotation =
maybe
0
(angleBetween $ w ^. input . mousePos)
(w ^. input . heldPos . at SDL.ButtonRight)
ifConfigWallRotate :: Configuration -> M.Map MouseButton Int -> World -> World
ifConfigWallRotate cfig mbs
| _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` mbs) =
@@ -163,21 +178,6 @@ doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. wC
b = a * (4 / pi)
b' = fromIntegral (round b :: Int)
rotateCamera :: Configuration -> World -> World
rotateCamera cfig w
| Just ltime <- pkeys ^? ix SDL.ButtonLeft
, Just rtime <- pkeys ^? ix SDL.ButtonRight
, ltime > rtime = w & wCam . camRot -~ rotation
| otherwise = ifConfigWallRotate cfig (w ^. input . mouseButtons) w
where
pkeys = w ^. input . mouseButtons
rotation =
maybe
0
(angleBetween $ w ^. input . mousePos)
(w ^. input . heldPos . at SDL.ButtonRight)
zoomFromItem :: ItZoom -> Float
zoomFromItem ItZoom{_izMax = zMax, _izMin = zMin, _izFac = zFac} =
min zMax $ max zMin zFac
@@ -214,10 +214,11 @@ findBoundDists cfig w
-- though I'm not sure how often it should be updated
updateBounds :: Configuration -> World -> World
updateBounds cfig w = case (w ^. cWorld . cClock) `mod` 5 of
0 -> w
& wCam . camBoundDist .~ bdists
& wCam . camBoundBox
.~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e)
0 ->
w
& wCam . camBoundDist .~ bdists
& wCam . camBoundBox
.~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e)
_ -> w
where
bdists@(n, s, e, w') = findBoundDists cfig w
src/Dodge/Update/Input/InGame.hs
+126 -101
View File
@@ -1,13 +1,10 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Update.Input.InGame (
updateUseInputInGame,
updateMouseInGame,
) where
import Dodge.Update.Input.DebugTest
import Dodge.Item.InvSize
import Data.Monoid
import NewInt
import Control.Applicative
import Control.Monad
import Data.Foldable
@@ -16,6 +13,7 @@ import qualified Data.IntSet as IS
import Data.List (sort)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Dodge.Button.Event
import Dodge.Camera
import Dodge.Creature.Action
@@ -25,16 +23,19 @@ import Dodge.DisplayInventory
import Dodge.Event.Test
import Dodge.Inventory
import Dodge.Inventory.Add
import Dodge.Item.InvSize
import Dodge.ListDisplayParams
import Dodge.Menu
import Dodge.Save
import Dodge.SelectionSections
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Update.Input.DebugTest
import Dodge.Update.Input.Text
import Dodge.WorldPos
import Geometry
import LensHelp
import NewInt
import SDL
updateUseInputInGame :: Universe -> Universe
@@ -42,18 +43,22 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
DisplayCarte -> over uvWorld updatePressedButtonsCarte u
DisplayInventory{_subInventory = si, _diSelection = disel} -> case si of
DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1,_,_))} ->
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
u
& uvWorld . hud . hudElement . subInventory
%~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_
| disel ^? _Just . _1 == Just (-1) ->
u
& uvWorld . hud . hudElement . subInventory
%~ docombineregexinput sss msel
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
_ | disel ^? _Just . _1 == Just (-1) ->
u & uvWorld . hud . hudElement
& uvWorld . hud . hudElement
%~ dodisplayregexinput diInvFilter diInvFilter (-1)
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_ | disel ^? _Just . _1 == Just 2 ->
u & uvWorld . hud . hudElement
_
| disel ^? _Just . _1 == Just 2 ->
u
& uvWorld . hud . hudElement
%~ dodisplayregexinput diCloseFilter diCloseFilter 2
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
@@ -78,12 +83,14 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
& ciFilter .~ filts'
updateMouseInGame :: Configuration -> World -> World
updateMouseInGame cfig w = case w ^? input . mouseButtons . ix ButtonLeft of
Just 0 -> updateMouseClickInGame cfig w
Just _ -> updateMouseHeldInGame cfig w
Nothing -> case w ^? input . mouseButtonsReleased . ix ButtonLeft of
Just 0 -> updateMouseReleaseInGame w
_ -> w
updateMouseInGame cfig w
| Just 0 <- lbpress = updateMouseClickInGame cfig w
| Just _ <- lbpress = updateMouseHeldInGame cfig w
| Just 0 <- lbrelease = updateMouseReleaseInGame w
| otherwise = w
where
lbpress = w ^? input . mouseButtons . ix ButtonLeft
lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft
updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
@@ -95,34 +102,35 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w
_ -> w
doDrag :: Int
-> Int
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> Maybe (Int, Int)
-> World
-> World
doDrag ::
Int ->
Int ->
Maybe (Int, Int) ->
Maybe (Int, Int) ->
Maybe (Int, Int) ->
World ->
World
doDrag 0 _ _ _ _ w = w
doDrag n k mmouseover ab bn w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
return $ if concurrentIS is
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
return $
if concurrentIS is
then shiftInvItems n k x ab bn is ss w
else collectInvItems k is w
tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World
tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do
guard $ maybe True (\(i,_) -> i == 3) mpos
guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, _, xs) <- w ^? hud . hudElement . diSelection . _Just
return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
tryPickupSelected :: Int -> Maybe (Int,Int) -> World -> Maybe World
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
tryPickupSelected k mpos w = do
guard $ k == 3
guard $ maybe True (\(i,_) -> i == 0 || i == 1) mpos
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
let nfreeslots = crNumFreeSlots cr
xs <- w ^? hud . hudElement . diSelection . _Just . _3
@@ -130,11 +138,16 @@ tryPickupSelected k mpos w = do
let slotsneeded = alaf Sum foldMap (itInvHeight . _flIt) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0,j) -> foldr (pickUpItemAt j 0) w itmstopickup
& hud . hudElement . diSelection ?~ (0,j
, IS.fromDistinctAscList [j..j+IS.size xs-1])
_ -> foldl' (flip $ pickUpItem 0) w itmstopickup
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
Just (0, j) ->
foldr (pickUpItemAt j 0) w itmstopickup
& hud . hudElement . diSelection
?~ ( 0
, j
, IS.fromDistinctAscList [j .. j + IS.size xs -1]
)
_ ->
foldl' (flip $ pickUpItem 0) w itmstopickup
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
where
g i = do
NInt j <- w ^? hud . closeItems . ix i
@@ -142,26 +155,32 @@ tryPickupSelected k mpos w = do
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag k mpos _ _ ->
OverInvDrag k mpos _ _ ->
input . mouseContext .~ MouseInGame $
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect ssel mesel | ScancodeLShift `M.member` (w ^. input . pressedKeys)
-> w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ getuniques
(maybe mempty (h ssel)
(guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1)
>> mesel ^? _Just))
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
OverInvDragSelect ssel mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3
%~ getuniques
( maybe
mempty
(h ssel)
( guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1)
>> mesel ^? _Just
)
)
OverInvDragSelect _ Nothing ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
OverInvDragSelect ssel (Just esel) ->
w & input . mouseContext .~ MouseInGame
& augInvDirectSelect (f (fst ssel,esel) (h ssel esel))
& augInvDirectSelect (f (fst ssel, esel) (h ssel esel))
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x,y) z = (x,y,z)
h (k,i) j = fold $ do
f (x, y) z = (x, y, z)
h (k, i) j = fold $ do
sss <- w ^? hud . hudElement . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
(yss, _) = IM.split (max i j + 1) xss
@@ -182,14 +201,18 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
return $
w & input . mouseContext
.~ OverInvDragSelect ysel Nothing
OverInvSelect (-1,_) | selsec == Just (-1) -> w
& hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
OverInvSelect (2,_) | selsec == Just 2 -> w
& hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing
OverInvSelect x | ScancodeLShift `M.member` (w ^. input . pressedKeys )
-> fromMaybe w $ do
OverInvSelect (-1, _)
| selsec == Just (-1) ->
w
& hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
OverInvSelect (2, _)
| selsec == Just 2 ->
w
& hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing
OverInvSelect x | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
fromMaybe w $ do
guard (isGroupSelectableSection $ fst x)
return $ w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
OverInvSelect x -> startDrag x cfig w
@@ -229,34 +252,38 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
_ -> w
where
mpos = w ^. input . mousePos
f (x,y) = (x,y,mempty)
f (x, y) = (x, y, mempty)
selsec = w ^? hud . hudElement . diSelection . _Just . _1
endRegex :: Int -> World
-> Maybe (Int,Int,IS.IntSet)
-> Maybe (Int,Int,IS.IntSet)
endRegex ::
Int ->
World ->
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
endRegex i w = fromMaybe id $ do
sss <- w ^? hud . hudElement . diSections
let j = fromMaybe 0 $ do
itms <- sss ^? ix i . ssItems
(k,_) <- IM.lookupMin itms
(k, _) <- IM.lookupMin itms
return k
return $ ssSetCursor (ssLookupDown i j) sss
endCombineRegex ::World
-> Maybe (Int,Int,IS.IntSet)
-> Maybe (Int,Int,IS.IntSet)
endCombineRegex ::
World ->
Maybe (Int, Int, IS.IntSet) ->
Maybe (Int, Int, IS.IntSet)
endCombineRegex w = fromMaybe id $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
let j = fromMaybe 0 $ do
itms <- sss ^? ix 0 . ssItems
(k,_) <- IM.lookupMin itms
return (k-1)
(k, _) <- IM.lookupMin itms
return (k -1)
return $ ssSetCursor (ssLookupDown 0 j) sss
startDrag :: (Int, Int) -> Configuration -> World -> World
startDrag (a, b) cfig w = setcontext
. fromMaybe (augInvDirectSelect (a, b, IS.singleton b) w) $ do
startDrag (a, b) cfig w = setcontext
. fromMaybe (augInvDirectSelect (a, b, IS.singleton b) w)
$ do
(i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
guard $ i == a && b `IS.member` xs
return w
@@ -291,9 +318,9 @@ collectInvItems secid is w = fromMaybe w $ do
shiftInvItems ::
Int -> -- recurse limit
Int -> -- section where drag started
(Int,Int) -> -- selection item mouse is over
Maybe (Int,Int) -> -- selection item "above" mouse position (can be same as over)
Maybe (Int,Int) -> -- selection item "below" mouse position (can be same as over)
(Int, Int) -> -- selection item mouse is over
Maybe (Int, Int) -> -- selection item "above" mouse position (can be same as over)
Maybe (Int, Int) -> -- selection item "below" mouse position (can be same as over)
IS.IntSet ->
IM.IntMap (SelectionItem a) ->
World ->
@@ -301,23 +328,23 @@ shiftInvItems ::
shiftInvItems n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do
let xk = fst x
guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi,_) <- IS.maxView xs
(mini,_) <- IS.minView xs
(maxi, _) <- IS.maxView xs
(mini, _) <- IS.minView xs
case True of
_ | x < (k,mini) -> do
_ | x < (k, mini) -> do
guard $ not . null . fst $ IM.split mini ss
guard $ Just (k,mini-1) /= ab
return . doDrag (n-1) k (Just x) ab bn $ shiftInvItemsUp k xs w
_ | x > (k,maxi) -> do
guard $ Just (k, mini -1) /= ab
return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsUp k xs w
_ | x > (k, maxi) -> do
guard $ not . null . snd $ IM.split maxi ss
guard $ Just (k,maxi+1) /= bn
return . doDrag (n-1) k (Just x) ab bn $ shiftInvItemsDown k xs w
guard $ Just (k, maxi + 1) /= bn
return . doDrag (n -1) k (Just x) ab bn $ shiftInvItemsDown k xs w
_ -> Nothing
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
(i,_,xs) <- w ^? hud . hudElement . diSelection . _Just
(k,j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
(i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
guard $ i == k && j `IS.member` xs
return $ w & hud . hudElement . diSelection . _Just . _2 .~ j
@@ -484,23 +511,23 @@ updateBackspaceRegex w = case di ^? subInventory of
return $ case str of
(_ : _) ->
he & filtset . _Just %~ init
& selset ?~ (x, 0,mempty)
& selset ?~ (x, 0, mempty)
[] -> he & filtset .~ Nothing
di = w ^. hud . hudElement
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{}
| secfocus [-1,0,1] ->
w & hud . hudElement . diSelection ?~ (-1, 0,mempty)
| secfocus [-1, 0, 1] ->
w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
& hud . hudElement . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2,3] ->
w & hud . hudElement . diSelection ?~ (2, 0,mempty)
| secfocus [2, 3] ->
w & hud . hudElement . diSelection ?~ (2, 0, mempty)
& hud . hudElement . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciFilter %~ enterregex
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0,mempty)
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0, mempty)
_ -> w
where
di = w ^. hud . hudElement
@@ -518,11 +545,14 @@ spaceAction w = case w ^. hud . hudElement of
DisplayInventory{_subInventory = NoSubInventory{}} -> fromMaybe w $ do
cobj <- selCloseObj w
return $ case cobj of
(Left flit) -> pickUpItem 0 flit w
& worldEventFlags . at InventoryChange ?~ ()
(Right but) -> doButtonEvent (_btEvent but) but w
& worldEventFlags . at InventoryChange ?~ ()
DisplayInventory{_subInventory = DisplayTerminal{}} -> w
(Left flit) ->
pickUpItem 0 flit w
& worldEventFlags . at InventoryChange ?~ ()
(Right but) ->
doButtonEvent (_btEvent but) but w
& worldEventFlags . at InventoryChange ?~ ()
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w
& hud . hudElement . subInventory .~ NoSubInventory
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
@@ -536,7 +566,7 @@ selCloseObj :: World -> Maybe (Either FloorItem Button)
selCloseObj w = selobj <|> firstcitem <|> firstcbut
where
selobj = do
(i,j,_) <- w ^? hud . hudElement . diSelection . _Just
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
case i of
3 -> do
NInt k <- w ^? hud . closeItems . ix j
@@ -575,17 +605,13 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
where
thepointer = hud . hudElement . subInventory
tryCombine ::
(Int, Int) ->
World ->
World
tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
-- & cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
& soundStart InventorySound p wrench1S Nothing
& hud . hudElement . diSelection . _Just . _3 .~ mempty
@@ -594,4 +620,3 @@ maybeExitCombine w
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
| otherwise =
w & hud . hudElement . subInventory .~ NoSubInventory
tags
+288 -290
View File
File diff suppressed because it is too large Load Diff