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

Allow for swapping inventory items

Browse Source
This commit is contained in:
justin
2023-02-23 14:12:08 +00:00
parent 6fff71cdcc
commit 683acf8a05
9 changed files with 161 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Creature.hs
-3
View File
@@ -97,9 +97,6 @@ data Intention = Intention
--deriving (Eq, Show, Read) --Generic, Flat)
crSel :: Creature -> ManipulatedObject
crSel = _manObject . _crManipulation
makeLenses ''Creature
makeLenses ''CreatureTargeting
makeLenses ''Intention
src/Dodge/DisplayInventory.hs
-10
View File
@@ -171,14 +171,6 @@ updateSectionsPositioning mselpos allavailablelines ((k, y) : xs) sss =
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
previoussections = updateSectionsPositioning mselpos availablelines xs sss
--manObjIndex :: ManipulatedObject -> (Int,Int)
--manObjIndex mo = case mo of
-- InInventory SortInventory -> (-1, 0)
-- InInventory (SelItem i _) -> (0, i)
-- SelNothing -> (1,0)
-- InNearby SortNearby -> (2,0)
-- InNearby (SelCloseObject i) -> (3,i)
updateSection ::
IM.IntMap (SelectionItem a) ->
Maybe Int ->
@@ -247,8 +239,6 @@ enterCombineInv cfig w =
cm'
sss
where
--(updateCombineSelections w cfig sss)
cm' = IM.fromAscList $ zip [0 ..] $ combineList' w
cm
| null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
src/Dodge/Inventory.hs
+93 -40
View File
@@ -4,7 +4,6 @@ module Dodge.Inventory (
selSecSelPos,
checkInvSlotsYou,
rmSelectedInvItem,
selNumPos,
selNumTextEndPos,
selSecSelCol,
selNumEndMidHeight,
@@ -13,7 +12,7 @@ module Dodge.Inventory (
updateRBList,
updateTerminal,
closeObjScrollDir,
changeSwapInvSel,
changeSwapSel,
scrollAugInvSel,
crNumFreeSlots,
crInvSize,
@@ -55,8 +54,10 @@ rmInvItem ::
World ->
World
rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of
Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
& worldEventFlags . at InventoryChange ?~ ()
Just x
| x > 1 ->
w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
& worldEventFlags . at InventoryChange ?~ ()
_ ->
w
& pointcid %~ crCancelReloading
@@ -112,15 +113,15 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan
Just i -> rmInvItem cid i w
Nothing -> w
selNumPos :: ManipulatedObject -> World -> Maybe Int
selNumPos mo w =
w ^? hud . hudElement . diSections
>>= case mo of
InInventory SortInventory -> selSecSelPos (-1) 0
InInventory (SelItem i _) -> selSecSelPos 0 i
SelNothing -> selSecSelPos 1 0
InNearby SortNearby -> selSecSelPos 2 0
InNearby (SelCloseObject i) -> selSecSelPos 3 i
--selNumPos :: ManipulatedObject -> World -> Maybe Int
--selNumPos mo w =
-- w ^? hud . hudElement . diSections
-- >>= case mo of
-- InInventory SortInventory -> selSecSelPos (-1) 0
-- InInventory (SelItem i _) -> selSecSelPos 0 i
-- SelNothing -> selSecSelPos 1 0
-- InNearby SortNearby -> selSecSelPos 2 0
-- InNearby (SelCloseObject i) -> selSecSelPos 3 i
-- there are still more ListDisplayParams to integrate here
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
@@ -327,37 +328,89 @@ closeObjScrollDir x
| x < 0 = over (hud . closeObjects) rotD
| otherwise = id
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w = case you w ^? crManipulation . manObject of
Just (InInventory (SelItem i _)) ->
w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
& worldEventFlags . at InventoryChange ?~ ()
Just (InNearby (SelCloseObject i)) ->
w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
.~ ((i - k) `mod` numCO)
& hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
changeSwapSel :: Int -> World -> World
changeSwapSel yi w
| yi == 0 = w
| yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
| otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
where
updatecreature i =
(crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
. (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k)
. (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
. swapSite i (swapi i)
. swapSite (swapi i) i
f g i m = fst <$> g i m
changeSwapClose :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int)
-> Int -> World -> World
changeSwapClose f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems
k <- f i ss
return $ w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
.~ k
& hud . closeObjects %~ swapIndices i k
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
& worldEventFlags . at InventoryChange ?~ ()
changeSwapInv :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int)
-> Int -> World -> World
changeSwapInv f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
k <- f i ss
return $
w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
& worldEventFlags . at InventoryChange ?~ ()
where
updateLeftInvSel k li
| i == li = k
| k == li = i
| otherwise = li
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
. (crManipulation . manObject . inInventory . ispItem .~ k)
. (crInvEquipped %~ IM.safeSwapKeys i k)
. swapSite i k
. swapSite k i
cr = you w
swapSite a b = case cr ^? crInvEquipped . ix a of
Just epos -> crEquipment . ix epos .~ b
Nothing -> id
cr = you w
swapi i = (i - k) `mod` n
updateLeftInvSel i li
| i == li = swapi i
| swapi i == li = i
| otherwise = li
n = length $ _crInv cr
numCO = length $ w ^. hud . closeObjects
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
Just (0,i) -> w & changeSwapInv f i
Just (3,i) -> w & changeSwapClose f i
_ -> w
--changeSwapInvSel' :: Int -> World -> World
--changeSwapInvSel' k w = case you w ^? crManipulation . manObject of
-- Just (InInventory (SelItem i _)) ->
-- w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
-- & worldEventFlags . at InventoryChange ?~ ()
-- Just (InNearby (SelCloseObject i)) ->
-- w
-- & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
-- .~ ((i - k) `mod` numCO)
-- & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
-- & worldEventFlags . at InventoryChange ?~ ()
-- _ -> w
-- where
-- updatecreature i =
-- (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i))
-- . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i)
-- . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k)
-- . (crInvEquipped %~ IM.safeSwapKeys i (swapi i))
-- . swapSite i (swapi i)
-- . swapSite (swapi i) i
-- swapSite a b = case cr ^? crInvEquipped . ix a of
-- Just epos -> crEquipment . ix epos .~ b
-- Nothing -> id
-- cr = you w
-- swapi i = (i - k) `mod` n
-- updateLeftInvSel i li
-- | i == li = swapi i
-- | swapi i == li = i
-- | otherwise = li
-- n = length $ _crInv cr
-- numCO = length $ w ^. hud . closeObjects
scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w
src/Dodge/Reloading.hs
+3 -3
View File
@@ -16,9 +16,9 @@ crCancelReloading cr =
& updateProgress
& crManipulation . manObject . inInventory . iselAction .~ NoInvSelAction
where
updateProgress = case crSel cr of
InInventory (SelItem i _) -> crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing
_ -> id
updateProgress = fromMaybe id $ do
InInventory (SelItem i _) <- cr ^? crManipulation . manObject
return $ crInv . ix i . itUse . heldConsumption . laProgress %~ const Nothing
stepReloading :: Creature -> Creature
stepReloading cr = case cr ^? crManipulation . manObject . inInventory of
src/Dodge/SelectionSections.hs
+27 -30
View File
@@ -17,41 +17,37 @@ import Dodge.Data.SelectionList
scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a
scrollSelectionSections yi sss
| yi == 0 = sss
| yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections
| otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections
| yi > 0 = foldr ($) sss $ replicate yi (ssScrollUsing ssLookupUp)
| otherwise = foldr ($) sss $ replicate (negate yi) (ssScrollUsing ssLookupDown)
setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
setFirstPosSelectionSections sss = fromMaybe sss $ do
(i, j, _) <- ssLookupMin sss
return $ sss & sssExtra . sssSelPos ?~ (i, j)
scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
scrollUpSelectionSections sss = sss & sssExtra . sssSelPos .~
fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
ssScrollUsing ::
(Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
SelectionSections a
ssScrollUsing g sss =
sss & sssExtra . sssSelPos
.~ fmap f (ssScrollUsing' g (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where
f (i,j,_) = (i,j)
f (i, j, _) = (i, j)
ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssScrollUp sss = l <|> ssLookupMin sss
ssScrollUsing' ::
( Int ->
Int ->
SelectionSections a ->
Maybe (Int, Int, SelectionItem a)
) ->
SelectionSections a ->
Maybe (Int, Int, SelectionItem a)
ssScrollUsing' f sss = l <|> ssLookupMin sss
where
l = do
(i,j) <- sss ^? sssExtra . sssSelPos . _Just
ssLookupUp i j sss
ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssScrollDown sss = l <|> ssLookupMin sss
where
l = do
(i,j) <- sss ^? sssExtra . sssSelPos . _Just
ssLookupDown i j sss
scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
scrollDownSelectionSections sss = sss & sssExtra . sssSelPos .~
fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where
f (i,j,_) = (i,j)
-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
f i j sss
ssSetCursor ::
(SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
@@ -131,11 +127,12 @@ selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j
selSecSelPos :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelPos i j sss = do
ss <- sss ^? sssSections . ix i
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
. fmap (length . _siPictures)
. fst $ IM.split j (ss ^. ssItems)
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
. fmap (length . _siPictures)
. fst
$ IM.split j (ss ^. ssItems)
where
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections
src/Dodge/TestString.hs
+2 -2
View File
@@ -3,14 +3,14 @@ module Dodge.TestString where
import Data.Aeson (ToJSON)
import Data.ByteString.Lazy.Char8 (unpack)
import qualified Data.Aeson.Encode.Pretty as AEP
--import Control.Lens
import Control.Lens
import Dodge.Data.Universe
--import Data.Maybe
--import ShortShow
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit _ = []
testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
getPretty :: ToJSON a => a -> [String]
src/Dodge/Update/Input/InGame.hs
+25 -15
View File
@@ -1,6 +1,6 @@
module Dodge.Update.Input.InGame
( updateUseInputInGame
) where
module Dodge.Update.Input.InGame (
updateUseInputInGame,
) where
import qualified Data.IntMap.Strict as IM
import Data.List (sort)
@@ -39,10 +39,13 @@ updateUseInputInGame h u = case h of
| lbinitialpress ->
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
CombineInventory{_ciSections = sss}
| inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
| lbinitialpress -> (uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $ over uvWorld (tryCombine sss) u
| inSubInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
| lbinitialpress ->
(uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
over uvWorld (tryCombine sss) u
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
-- _ -> case regexFocus w of
-- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys
-- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput
@@ -154,11 +157,16 @@ doRegexInput u i sss
updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1)
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1)
Just NoSubInventory
| secfocus (-1) 0 ->
w & hud . hudElement . diSections %~ trybackspace (-1)
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory
| secfocus 2 3 ->
w & hud . hudElement . diSections %~ trybackspace 2
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1)
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
where
@@ -208,10 +216,12 @@ spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement of
DisplayCarte -> w & hud . carteCenter .~ theLoc
DisplayInventory{_subInventory = NoSubInventory} -> case selectedCloseObject w of
Just (Left flit) -> pickUpItem 0 flit w
& worldEventFlags . at InventoryChange ?~ ()
Just (Right but) -> doButtonEvent (_btEvent but) but w
& worldEventFlags . at InventoryChange ?~ ()
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
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -31,7 +31,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
(Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> doHeldScroll f y (you w) w
| lbDown -> w & cWorld . camPos . camZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| invKeyDown -> changeSwapSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
DisplayInventory {_subInventory = ExamineInventory mi}
| invKeyDown && rbDown -> w & moveTweakSel yi
src/IntMapHelp.hs
+10
View File
@@ -15,8 +15,12 @@ module IntMapHelp
unsafeSwapKeys,
safeSwapKeys,
findIndex,
cycleGT,
cycleLT,
) where
import Control.Applicative
import Data.Aeson
import Data.IntMap.Strict
import GHC.Generics
@@ -84,3 +88,9 @@ findIndex t = foldrWithKey f Nothing
f k x _
| t x = Just k
| otherwise = Nothing
cycleGT :: Int -> IntMap a -> Maybe (Int, a)
cycleGT i m = lookupGT i m <|> lookupMin m
cycleLT :: Int -> IntMap a -> Maybe (Int, a)
cycleLT i m = lookupLT i m <|> lookupMax m