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