82 lines
2.9 KiB
Haskell
82 lines
2.9 KiB
Haskell
module Dodge.Inventory.Swap (
|
|
swapInvItems,
|
|
swapAnyExtraSelection
|
|
) where
|
|
|
|
import NewInt
|
|
import Dodge.SoundLogic
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Base.You
|
|
import Dodge.Inventory.Location
|
|
import Dodge.Data.DoubleTree
|
|
import Sound.Data
|
|
import qualified Data.IntSet as IS
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
import Dodge.Data.SelectionList
|
|
import qualified IntMapHelp as IM
|
|
import Dodge.Data.World
|
|
import Control.Monad
|
|
|
|
swapInvItems ::
|
|
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
|
|
Int ->
|
|
World ->
|
|
World
|
|
swapInvItems f i w = fromMaybe w $ do
|
|
ss <- w ^? hud . diSections . ix 0 . ssItems
|
|
k <- f i ss
|
|
let updateselection = case w ^? hud . diSelection . _Just of
|
|
Just (Sel 0 j _) | j == k -> hud . diSelection . _Just . slInt .~ i
|
|
Just (Sel 0 j _) | j == i -> hud . diSelection . _Just . slInt .~ k
|
|
_ -> id
|
|
return $
|
|
w
|
|
& swapAnyExtraSelection i k
|
|
& checkConnection InventorySound disconnectItemS i k
|
|
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
|
|
& updateselection
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& cWorld . lWorld %~ crUpdateItemLocations 0
|
|
& setInvPosFromSS
|
|
& cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
|
|
-- a rethink is maybe in order
|
|
& checkConnection InventoryConnectSound connectItemS i k
|
|
where
|
|
updatecreature k =
|
|
(crInv . unNIntMap %~ IM.safeSwapKeys i k)
|
|
. (crManipulation . manObject . imSelectedItem .~ NInt k)
|
|
. swapSite i k
|
|
. swapSite k i
|
|
cr = you w
|
|
swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
|
|
Just epos -> crEquipment . ix epos .~ NInt b
|
|
Nothing -> id
|
|
|
|
swapAnyExtraSelection :: Int -> Int -> World -> World
|
|
swapAnyExtraSelection i k w = fromMaybe w $ do
|
|
is <- w ^? hud . diSelection . _Just . slSet
|
|
let f = if i `IS.member` is then IS.insert k else id
|
|
g = if k `IS.member` is then IS.insert i else id
|
|
return $
|
|
w & hud . diSelection . _Just . slSet
|
|
%~ (f . g . IS.delete i . IS.delete k)
|
|
|
|
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
|
|
checkConnection so s i j w = fromMaybe w $ do
|
|
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
|
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
|
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
|
let locs = invIndents inv -- why indents?
|
|
iit <- locs ^? ix i . _2
|
|
jit <- locs ^? ix j . _2
|
|
guard $ isConnected iit || isConnected jit
|
|
return $ soundStart so cpos s Nothing w
|
|
|
|
isConnected :: LocationDT a -> Bool
|
|
isConnected x = case x ^. locDtContext of
|
|
TopDT ->
|
|
not (null $ x ^. locDT . dtRight)
|
|
|| not (null $ x ^. locDT . dtLeft)
|
|
_ -> True
|