519 lines
19 KiB
Haskell
519 lines
19 KiB
Haskell
module Dodge.Update.Input.InGame (
|
|
updateUseInputInGame,
|
|
updateMouseInGame,
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Foldable
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.IntSet as IS
|
|
import Data.List (sort)
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
--import Dodge.Base.You
|
|
import Dodge.Button.Event
|
|
import Dodge.Camera
|
|
import Dodge.Creature.Action
|
|
import Dodge.Data.Combine
|
|
import Dodge.Data.Universe
|
|
import Dodge.DisplayInventory
|
|
import Dodge.Event.Test
|
|
import Dodge.InputFocus
|
|
import Dodge.Inventory
|
|
import Dodge.Inventory.Add
|
|
import Dodge.ListDisplayParams
|
|
import Dodge.Menu
|
|
import Dodge.Save
|
|
import Dodge.SelectionSections
|
|
import Dodge.SoundLogic
|
|
import Dodge.Terminal
|
|
import Dodge.Update.Input.Text
|
|
import Dodge.WorldPos
|
|
import Geometry
|
|
import LensHelp
|
|
import SDL
|
|
|
|
updateUseInputInGame :: Universe -> Universe
|
|
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
|
|
DisplayCarte -> over uvWorld updatePressedButtonsCarte u
|
|
DisplayInventory{_subInventory = si} -> case si of
|
|
DisplayTerminal tmid -> updateKeysInTerminal tmid u
|
|
CombineInventory{_ciSections = sss, _ciSelection = msel}
|
|
| inSubInvRegex (u ^. uvWorld) ->
|
|
u
|
|
& uvWorld . hud . hudElement . subInventory
|
|
%~ docombineregexinput sss msel
|
|
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
|
_
|
|
| inInvRegex (u ^. uvWorld) ->
|
|
u & uvWorld . hud . hudElement %~ dodisplayregexinput (-1)
|
|
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
|
& uvWorld %~ setInvPosFromSS
|
|
_
|
|
| inCloseRegex (u ^. uvWorld) ->
|
|
u & uvWorld . hud . hudElement %~ dodisplayregexinput' 2
|
|
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
|
& uvWorld %~ setInvPosFromSS
|
|
_ -> M.foldlWithKey' updateKeyInGame u pkeys
|
|
where
|
|
pkeys = u ^. uvWorld . input . pressedKeys
|
|
dodisplayregexinput x di = fromMaybe di $ do
|
|
sss <- di ^? diSections
|
|
msel <- di ^? diSelection
|
|
filts <- di ^? diInvFilter
|
|
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
|
|
return $
|
|
di & diSections .~ sss'
|
|
& diSelection .~ msel'
|
|
& diInvFilter .~ filts'
|
|
dodisplayregexinput' x di = fromMaybe di $ do
|
|
sss <- di ^? diSections
|
|
msel <- di ^? diSelection
|
|
filts <- di ^? diCloseFilter
|
|
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
|
|
return $
|
|
di & diSections .~ sss'
|
|
& diSelection .~ msel'
|
|
& diCloseFilter .~ filts'
|
|
docombineregexinput sss msel ci = fromMaybe ci $ do
|
|
filts <- ci ^? ciFilter
|
|
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
|
|
return $
|
|
ci & ciSections .~ sss'
|
|
& ciSelection .~ msel'
|
|
& 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
|
|
|
|
updateMouseHeldInGame :: Configuration -> World -> World
|
|
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
|
OverInvDragSelect sstart _ -> fromMaybe w $ do
|
|
sss <- w ^? hud . hudElement . diSections
|
|
let msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
|
|
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
|
|
return $ w & input . mouseContext . mcoSelEnd .~ msel
|
|
OverInvDrag k mmouseover -> fromMaybe w $ do
|
|
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
|
|
x <- mmouseover
|
|
is <- w ^? hud . hudElement . diSelectionExtra
|
|
return $ if concurrentIS is
|
|
then shiftInvItems k x is ss w
|
|
else collectInvItems is w
|
|
-- let mpos = w ^. input . mousePos
|
|
-- return $ w & dragInvItems k xs cfig mpos ldp sss
|
|
_ -> w
|
|
where
|
|
ldp = invDisplayParams w
|
|
|
|
tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World
|
|
tryDropSelected mpos w = do
|
|
guard $ maybe True (\(i,_) -> i == 3) mpos
|
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
(0, _) <- w ^? hud . hudElement . diSelection . _Just
|
|
xs <- w ^? hud . hudElement . diSelectionExtra
|
|
return $ IS.foldr (dropItem cr) w xs
|
|
|
|
tryPickupSelected :: Maybe (Int,Int) -> World -> Maybe World
|
|
tryPickupSelected mpos w = do
|
|
guard $ maybe True (\(i,_) -> i == 0) mpos
|
|
-- cr <- w ^? cWorld . lWorld . creatures . ix 0
|
|
-- let nfreeslots = crNumFreeSlots cr
|
|
(3, _) <- w ^? hud . hudElement . diSelection . _Just
|
|
-- xs <- w ^? hud . hudElement . diSelectionExtra
|
|
-- OverInvDrag 3 x <- w ^? input . mouseContext
|
|
return w
|
|
-- return $ IS.foldr (dropItem cr) w xs
|
|
|
|
updateMouseReleaseInGame :: World -> World
|
|
updateMouseReleaseInGame w = case w ^. input . mouseContext of
|
|
--OverInvDrag i mpos ->
|
|
OverInvDrag _ mpos ->
|
|
input . mouseContext .~ MouseInGame $
|
|
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w
|
|
-- OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
|
|
-- j <- mpos
|
|
-- guard $ fst j == i
|
|
-- return $ w & input . mouseContext .~ OverInvSelect j
|
|
OverInvDragSelect _ Nothing ->
|
|
w & input . mouseContext .~ MouseInGame
|
|
& hud . hudElement . diSelectionExtra .~ mempty
|
|
OverInvDragSelect ssel (Just esel) ->
|
|
w & input . mouseContext .~ MouseInGame
|
|
& hud . hudElement . diSelectionExtra
|
|
.~ h ssel (snd esel) -- IM.keysSet [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
|
|
& augInvDirectSelect (min ssel esel)
|
|
_ -> w
|
|
where
|
|
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
|
|
return . IM.keysSet $ yss
|
|
|
|
updateMouseClickInGame :: Configuration -> World -> World
|
|
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
|
MouseInGame -> fromMaybe w $ do
|
|
sss <- w ^? hud . hudElement . diSections
|
|
ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
|
|
return $
|
|
w & input . mouseContext
|
|
.~ OverInvDragSelect ysel Nothing
|
|
OverInvSelect x -> startDrag x w
|
|
OverTerminalReturn tmid -> terminalReturnEffect tmid w
|
|
OverTerminalEscape ->
|
|
w
|
|
& hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
|
|
OverCombSelect x ->
|
|
w & hud . hudElement . subInventory . ciSelection ?~ x
|
|
& worldEventFlags . at CombineInventoryChange ?~ ()
|
|
OverCombFilter ->
|
|
w & hud . hudElement . subInventory . ciFilter .~ Nothing
|
|
& worldEventFlags . at CombineInventoryChange ?~ ()
|
|
OverCombCombine x ->
|
|
w
|
|
& tryCombine x
|
|
& worldEventFlags . at CombineInventoryChange ?~ ()
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& maybeExitCombine
|
|
OverCombEscape ->
|
|
w
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
|
|
OverInvFilt (i, j) -> fromMaybe w $ do
|
|
guard $ i == 0
|
|
str <-
|
|
fmap (take 5) $
|
|
w
|
|
^? hud . hudElement . diSections . ix i . ssItems . ix j . siPictures . ix 0
|
|
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
|
|
case w ^? hud . hudElement . subInventory . ciFilter . _Just of
|
|
Just (_ : xs)
|
|
| str == xs ->
|
|
w
|
|
& hud . hudElement . subInventory . ciFilter .~ Nothing
|
|
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
|
|
_ -> w
|
|
where
|
|
ldp = invDisplayParams w
|
|
mpos = w ^. input . mousePos
|
|
|
|
startDrag :: (Int, Int) -> World -> World
|
|
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
|
|
--(i, j) <- w ^? hud . hudElement . diSelection . _Just
|
|
(i, _) <- w ^? hud . hudElement . diSelection . _Just
|
|
xs <- w ^? hud . hudElement . diSelectionExtra
|
|
guard $ i == a && b `IS.member` xs
|
|
return $ setmichosen xs w
|
|
where
|
|
setmichosen x =
|
|
(input . mouseContext .~ OverInvDrag a (Just (a, b)))
|
|
. (hud . hudElement . diSelectionExtra .~ x)
|
|
|
|
concurrentIS :: IS.IntSet -> Bool
|
|
concurrentIS = go . IS.minView
|
|
where
|
|
go Nothing = True
|
|
go (Just (i, is)) = fromMaybe True $ do
|
|
(j, js) <- IS.minView is
|
|
return $ i + 1 == j && go (Just (j, js))
|
|
|
|
collectInvItems :: IS.IntSet -> World -> World
|
|
collectInvItems is w = fromMaybe w $ do
|
|
(j, js) <- IS.minView is
|
|
return $ h j js w
|
|
where
|
|
h j js w' = fromMaybe w' $ do
|
|
(k, ks) <- IS.minView js
|
|
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
|
|
|
|
shiftInvItems ::
|
|
Int ->
|
|
(Int,Int) ->
|
|
IS.IntSet ->
|
|
IM.IntMap (SelectionItem a) ->
|
|
World ->
|
|
World
|
|
shiftInvItems k x xs ss w = fromMaybe w $ do
|
|
(maxi,_) <- IS.maxView xs
|
|
(mini,_) <- IS.minView xs
|
|
if x < (k,mini)
|
|
then do
|
|
minss <- IM.lookupMin ss
|
|
guard (mini > fst minss)
|
|
return $ shiftInvItemsUp k xs w
|
|
else do
|
|
guard $ x > (k,maxi)
|
|
maxss <- IM.lookupMax ss
|
|
guard (maxi < fst maxss)
|
|
return $ shiftInvItemsDown k xs w
|
|
|
|
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
|
|
shiftInvItemsUp j is w = IS.foldl' f w is
|
|
where
|
|
f w' i' = swapItemWith g (j, i') w'
|
|
g i' m = fst <$> IM.lookupLT i' m
|
|
|
|
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
|
|
shiftInvItemsDown j is w = fromMaybe w $ do
|
|
let i = IS.findMax is
|
|
guard . isJust $
|
|
w ^? hud . hudElement . diSections . ix j . ssItems . ix i
|
|
return $ IS.foldr f w is
|
|
where
|
|
f i' w' = swapItemWith g (j, i') w'
|
|
g i' m = fst <$> IM.lookupGT i' m
|
|
|
|
updateFunctionKeys :: Universe -> Universe
|
|
updateFunctionKeys u =
|
|
M.foldlWithKey'
|
|
updateFunctionKey
|
|
u
|
|
(u ^. uvWorld . input . pressedKeys)
|
|
|
|
updateFunctionKey :: Universe -> Scancode -> PressType -> Universe
|
|
updateFunctionKey uv sc InitialPress = case sc of
|
|
ScancodeF1 -> useNormalCamera uv
|
|
ScancodeF2 -> pauseAndFloatCam uv
|
|
ScancodeF5 -> doQuicksave uv
|
|
ScancodeF9 -> doQuickload uv
|
|
ScancodeEscape -> pauseGame uv
|
|
_ -> uv
|
|
updateFunctionKey uv _ _ = uv
|
|
|
|
updatePressedButtonsCarte :: World -> World
|
|
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
|
|
|
|
updatePressedButtonsCarte' :: M.Map MouseButton Int -> World -> World
|
|
updatePressedButtonsCarte' pkeys w
|
|
| isDown ButtonRight =
|
|
w & hud . carteCenter %~ (-.- trans)
|
|
| isDown ButtonLeft =
|
|
w
|
|
& hud . carteRot -~ rot
|
|
& hud . carteZoom *~ czoom
|
|
| otherwise = w
|
|
where
|
|
isDown but = but `M.member` pkeys
|
|
mbutpos but = theinput ^. heldPos . at but
|
|
rot = maybe 0 (angleBetween (_mousePos (_input w))) $ mbutpos SDL.ButtonLeft
|
|
czoom = fromMaybe 1 $ do
|
|
p <- mbutpos SDL.ButtonLeft
|
|
return $ magV (_mousePos theinput) / magV p
|
|
theinput = w ^. input
|
|
trans = fromMaybe 0 $ do
|
|
p <- mbutpos SDL.ButtonRight
|
|
return . rotateV (w ^. hud . carteRot) $
|
|
1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- p)
|
|
|
|
updateKeysInTerminal :: Int -> Universe -> Universe
|
|
updateKeysInTerminal tmid u =
|
|
u
|
|
& doTextInputOverUniverse
|
|
(uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText)
|
|
& checkEndStatus
|
|
where
|
|
checkEndStatus
|
|
| u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just InitialPress =
|
|
uvWorld %~ terminalReturnEffect tmid
|
|
| otherwise = id
|
|
|
|
updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
|
|
updateKeyInGame uv sc pt = case pt of
|
|
InitialPress -> updateInitialPressInGame uv sc
|
|
LongPress -> updateLongPressInGame uv sc
|
|
_ -> uv
|
|
|
|
updateInitialPressInGame :: Universe -> Scancode -> Universe
|
|
updateInitialPressInGame uv sc = case sc of
|
|
ScancodeSpace -> over uvWorld spaceAction uv
|
|
ScancodeP -> pauseGame uv
|
|
ScancodeF -> over uvWorld youDropItem uv
|
|
ScancodeM -> toggleMap uv
|
|
-- ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv
|
|
ScancodeT -> over uvWorld testEvent uv
|
|
ScancodeX -> uv & uvWorld %~ toggleTweakInv
|
|
ScancodeC -> toggleCombineInv uv
|
|
-- the following should be put in a more sensible place
|
|
ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
|
|
ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
|
|
_ -> uv
|
|
|
|
updateLongPressInGame :: Universe -> Scancode -> Universe
|
|
updateLongPressInGame uv sc = case sc of
|
|
ScancodeF -> over uvWorld youDropItem uv
|
|
ScancodeSpace -> over uvWorld spaceAction uv
|
|
_ -> uv
|
|
|
|
doRegexInput ::
|
|
Input ->
|
|
Int ->
|
|
IM.IntMap (SelectionSection a) ->
|
|
Maybe (Int, Int) ->
|
|
Maybe String ->
|
|
(IM.IntMap (SelectionSection a), Maybe (Int, Int), Maybe String)
|
|
doRegexInput inp i sss msel filts
|
|
| backspacetonothing || escapekey = endregex i 0
|
|
| endkeys = endregex (i + 1) (j -1)
|
|
| otherwise =
|
|
( sss
|
|
, msel
|
|
, filts & doTextInputOver inp _Just
|
|
)
|
|
where
|
|
endregex a b =
|
|
( sss & ix i . ssItems .~ mempty
|
|
, msel & ssSetCursor (ssLookupDown a b) sss
|
|
, Nothing
|
|
)
|
|
j = fromMaybe 0 $ do
|
|
itms <- sss ^? ix (i + 1) . ssItems
|
|
fst <$> IM.lookupMin itms
|
|
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
|
|
endkeys =
|
|
any
|
|
((== Just InitialPress) . (`M.lookup` pkeys))
|
|
[ScancodeReturn, ScancodeSlash]
|
|
backspacetonothing =
|
|
filts == Just ""
|
|
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
|
|
pkeys = inp ^. pressedKeys
|
|
|
|
updateBackspaceRegex :: World -> World
|
|
updateBackspaceRegex w = case di ^? subInventory of
|
|
Just NoSubInventory{}
|
|
| secfocus (-1) 0 ->
|
|
w & hud . hudElement %~ trybackspace (-1)
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
Just NoSubInventory{}
|
|
| secfocus 2 3 ->
|
|
w & hud . hudElement %~ trybackspace'' 2
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
Just CombineInventory{} ->
|
|
w & hud . hudElement . subInventory %~ trybackspace' (-1)
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
_ -> w
|
|
where
|
|
secfocus a b = fromMaybe False $ do
|
|
i <- di ^? diSelection . _Just . _1
|
|
return $ i == a || i == b
|
|
trybackspace x he = fromMaybe he $ do
|
|
str <- he ^? diInvFilter . _Just
|
|
return $ case str of
|
|
(_ : _) ->
|
|
he & diInvFilter . _Just %~ init
|
|
& diSelection ?~ (x, 0)
|
|
[] -> he & diInvFilter .~ Nothing
|
|
trybackspace'' x he = fromMaybe he $ do
|
|
str <- he ^? diCloseFilter . _Just
|
|
return $ case str of
|
|
(_ : _) ->
|
|
he & diCloseFilter . _Just %~ init
|
|
& diSelection ?~ (x, 0)
|
|
[] -> he & diCloseFilter .~ Nothing
|
|
trybackspace' x ci = fromMaybe ci $ do
|
|
str <- ci ^? ciFilter . _Just
|
|
return $ case str of
|
|
(_ : _) ->
|
|
ci & ciFilter . _Just %~ init
|
|
& ciSelection ?~ (x, 0)
|
|
[] -> ci & ciFilter .~ Nothing
|
|
di = w ^. hud . hudElement
|
|
|
|
updateEnterRegex :: World -> World
|
|
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
|
Just NoSubInventory{}
|
|
| secfocus (-1) 0 ->
|
|
w & hud . hudElement . diSelection ?~ (-1, 0)
|
|
& hud . hudElement . diInvFilter %~ enterregex
|
|
Just NoSubInventory{}
|
|
| secfocus 2 3 ->
|
|
w & hud . hudElement . diSelection ?~ (2, 0)
|
|
& hud . hudElement . diCloseFilter %~ enterregex
|
|
Just CombineInventory{} ->
|
|
w & hud . hudElement . subInventory . ciFilter %~ enterregex
|
|
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0)
|
|
_ -> w
|
|
where
|
|
di = w ^. hud . hudElement
|
|
secfocus a b = fromMaybe False $ do
|
|
i <- di ^? diSelection . _Just . _1
|
|
return $ i == a || i == b
|
|
enterregex = (<|> Just "")
|
|
|
|
pauseGame :: Universe -> Universe
|
|
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
|
|
|
|
spaceAction :: World -> World
|
|
spaceAction w = case w ^. hud . hudElement of
|
|
DisplayCarte -> w & hud . carteCenter .~ theLoc
|
|
DisplayInventory{_subInventory = NoSubInventory{}} -> case Left <$> selectedCloseItem w of
|
|
Just (Left flit) ->
|
|
pickUpItem 0 flit w
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
Just (Right but) ->
|
|
doButtonEvent (_btEvent but) but w
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
_ -> w
|
|
DisplayInventory{_subInventory = DisplayTerminal{}} ->
|
|
w & hud . hudElement . subInventory
|
|
.~ NoSubInventory --MouseInvNothing
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
_ ->
|
|
w & hud . hudElement . subInventory
|
|
.~ NoSubInventory --MouseInvNothing
|
|
where
|
|
theLoc =
|
|
doWorldPos
|
|
(w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1)
|
|
w
|
|
|
|
toggleMap :: Universe -> Universe
|
|
toggleMap u = case u ^. uvWorld . hud . hudElement of
|
|
DisplayCarte ->
|
|
u & uvWorld . hud . hudElement
|
|
.~ DisplayInventory
|
|
{ _subInventory = NoSubInventory
|
|
, _diSections = mempty
|
|
, _diSelection = Nothing
|
|
, _diSelectionExtra = mempty
|
|
, _diInvFilter = mempty
|
|
, _diCloseFilter = mempty
|
|
}
|
|
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
|
|
|
|
toggleTweakInv :: World -> World
|
|
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
|
|
Just ExamineInventory{} ->
|
|
w
|
|
& thepointer .~ NoSubInventory --MouseInvNothing
|
|
_ -> w & thepointer .~ ExamineInventory -- mi
|
|
where
|
|
thepointer = hud . hudElement . subInventory
|
|
|
|
tryCombine ::
|
|
-- IM.IntMap (SelectionSection CombinableItem) ->
|
|
(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
|
|
|
|
maybeExitCombine :: World -> World
|
|
maybeExitCombine w
|
|
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
|
|
| otherwise =
|
|
w & hud . hudElement . subInventory .~ NoSubInventory
|