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

Tweak combine inventory regex

Browse Source
This commit is contained in:
justin
2023-02-13 21:18:11 +00:00
parent b5db7a3420
commit 8b39a99194
12 changed files with 78 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+1 -2
View File
@@ -114,7 +114,6 @@ enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory sm
sm = initialSelPos $ SelectionIntMap
{ _smItems = combineList w
, _smSelPos = Nothing
, _smRegex = ""
, _smRegexInput = False
, _smRegex = NoSMRegex
, _smShownItems = IM.fromAscList $ zip [0..] (combineList w)
}
src/Dodge/Data/SelectionList.hs
+15 -2
View File
@@ -30,6 +30,12 @@ data SelectionList a = SelectionList
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Regex = NoRegex
| Regex
{ _regString :: String
, _regInput :: Bool
}
data SelectionSections a = SelectionSections
{ _sssSections :: IntMap (SelectionSection a)
, _sssSelPos :: Maybe Int
@@ -55,12 +61,17 @@ data SelectionSection a = SelectionSection
, _ssDescriptor :: String
}
data SMRegex = NoSMRegex
| SMRegex
{ _smrString :: String
, _smrInput :: Bool
}
deriving (Show)
data SelectionIntMap a = SelectionIntMap
{ _smItems :: [SelectionItem a]
, _smSelPos :: Maybe Int
, _smRegex :: String
, _smRegexInput :: Bool
, _smRegex :: SMRegex
, _smShownItems :: IntMap (SelectionItem a)
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -98,5 +109,7 @@ makeLenses ''SelectionIntMap
makeLenses ''SelectionSection
makeLenses ''SelectionSections
makeLenses ''SectionCursor
makeLenses ''Regex
makeLenses ''SMRegex
--deriveJSON defaultOptions ''SelectionItem
--deriveJSON defaultOptions ''SelectionList
src/Dodge/Data/Universe.hs
-7
View File
@@ -68,13 +68,6 @@ data ScreenLayer
{ _scInput :: String
, _scFooter :: String
}
-- | WaitScreen
-- { _scWaitMessage :: Universe -> String
-- , _scWaitTime :: Int
-- }
-- | DisplayScreen
-- { _scDisplay :: Universe -> Picture
-- }
data MenuOptionDisplay
= MODString {_modString :: String}
src/Dodge/InputFocus.hs
+5 -2
View File
@@ -1,4 +1,7 @@
module Dodge.InputFocus where
module Dodge.InputFocus
( inTermFocus
, inputFocus
) where
import Dodge.Data.SelectionList
import Data.Maybe
@@ -14,4 +17,4 @@ inTermFocus w = fromMaybe False $ do
inputFocus :: World -> Bool
inputFocus w = inTermFocus w
|| (w ^? hud . hudElement . subInventory . subInvMap . smRegexInput) == Just True
|| (w ^? hud . hudElement . subInventory . subInvMap . smRegex . smrInput) == Just True
src/Dodge/Inventory.hs
-14
View File
@@ -16,7 +16,6 @@ module Dodge.Inventory (
updateTerminal,
closeObjScrollDir,
closeObjectCol,
changeInvSel,
changeSwapInvSel,
changeAugInvSel,
crNumFreeSlots,
@@ -322,19 +321,6 @@ closeObjScrollDir x
| x < 0 = over (hud . closeObjects) rotD
| otherwise = id
changeInvSel :: Int -> World -> World
changeInvSel i w
| i == 0 || n == 0 = w
| otherwise = w
& pointcrInvSel . isel . ispItem %~ (`mod` n) . subtract i
& pointcrInvSel . isel . iselAction .~ NoInvSelAction
& pointcrInvSel . isel . ispCloseObject %~ (`mod` numCO) . subtract i
where
-- arguably this should jump the invpos into the inventory proper
pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel
n = length $ w ^?! cWorld . lWorld . creatures . ix 0 . crInv
numCO = length $ w ^. hud . closeObjects
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w = case you w ^? crInvSel . isel of
Just (SelItem i _) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
src/Dodge/Render/HUD.hs
+27 -41
View File
@@ -60,7 +60,6 @@ defaultListDisplayParams =
invDisplayParams :: World -> ListDisplayParams
invDisplayParams w =
defaultListDisplayParams
-- & ldpWidth .~ FixedSelectionWidth topInvW
& ldpCursorType .~ BorderCursor selcursortype
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
where
@@ -106,13 +105,8 @@ drawSubInventory subinv cfig w = case subinv of
NoSubInventory -> drawNoSubInventory cfig w
ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory sl ->
let mi = _smSelPos sl
in titledSub'
cfig
"COMBINE"
sl
<> combineInventoryExtra sl mi cfig w
CombineInventory sl -> titledSub' cfig "COMBINE" sl
<> combineInventoryExtra sl (_smSelPos sl) cfig w
titledSub :: Configuration -> String -> SelectionList a -> Picture
titledSub cfig subtitle subitems =
@@ -155,15 +149,13 @@ floorItemPickupInfo n itm
| n >= ceiling (_itInvSize itm) = ", but you have space to pick it up."
| otherwise = ", and you don't have space to pick it up."
-- this should not produce Nothing, and the logic should be changed to reflect
-- this
-- note the use of ^?!
-- it is probably desirable for this to crash hard for now
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crInvSel . isel of
Just (SelItem i _) -> f $ yourInv w ^?! ix i
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix (i - n - 1)
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
where
n = length $ yourInv w
drawNoSubInventory :: Configuration -> World -> Picture
drawNoSubInventory cfig w =
@@ -193,36 +185,30 @@ drawNoSubInventory cfig w =
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
examineInventoryExtra mtweaki mitm cfig =
pictures
[ fromMaybe mempty $ do
tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
]
examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
combineInventoryExtra :: SelectionIntMap CombinableItem -> Maybe Int -> Configuration -> World -> Picture
combineInventoryExtra sm mi cfig w =
pictures
[ fromMaybe mempty $ do
i <- mi
let cpos = getIthPos i (sm ^. smShownItems)
col <- sm ^? smShownItems . ix i . siColor
return $
pictures
[ fromMaybe mempty $ do
strs <- sm ^? smShownItems . ix i . siPayload . ciInfo
return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
, fromMaybe mempty $ do
lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
return $
lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
<> combineCounts cfig w lnks
]
]
combineInventoryExtra sm mi cfig w = fromMaybe mempty $ do
i <- mi
let cpos = getIthPos i (sm ^. smShownItems)
col <- sm ^? smShownItems . ix i . siColor
return $
pictures
[ fromMaybe mempty $ do
strs <- sm ^? smShownItems . ix i . siPayload . ciInfo
return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
, fromMaybe mempty $ do
lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
return $
lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
<> combineCounts cfig w lnks
]
secondColumnParams :: ListDisplayParams
secondColumnParams =
src/Dodge/TestString.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Dodge.Data.Universe
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u =
[ show $ u ^. uvWorld . input . scrollTestValue
[ show $ u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex
]
showTimeFlow :: TimeFlowStatus -> String
src/Dodge/Update.hs
+2 -1
View File
@@ -143,7 +143,8 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
optionScreenUpdate screen mop flag ldps sellist u
_ -> case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
Just (CombineInventory SelectionIntMap {_smRegexInput=True}) -> doSubInvRegexInput u
Just (CombineInventory SelectionIntMap {_smRegex=smr})
| smr ^? smrInput == Just True -> doSubInvRegexInput u
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
pkeys = u ^. uvWorld . input . pressedKeys
src/Dodge/Update/Input.hs
+15 -6
View File
@@ -46,17 +46,21 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
doSubInvRegexInput :: Universe -> Universe
doSubInvRegexInput u
| endkeys || backspacetonothing || endmouse
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
| backspacetonothing
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ const NoSMRegex
& uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
| otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex)
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
| endkeys || endmouse
= u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . smrInput %~ const False
& uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
| otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex. smrString)
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
where
endkeys = any
( (== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn,ScancodeEscape,ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just ""
backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . smrString == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
@@ -100,14 +104,19 @@ updateKeyInGame uv sc InitialPress = case sc of
-- the following should be put in a more sensible place
--ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
ScancodeSlash -> uv
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enterregex
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
ScancodeBackspace -> uv
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enternonzeroregex
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
-- in fact the whole logic should probably be rethought, oh well
_ -> uv
where
enterregex NoSMRegex = SMRegex "" True
enterregex (SMRegex str _) = SMRegex str True
enternonzeroregex (SMRegex (x:xs) _) = SMRegex (init (x:xs)) True
enternonzeroregex smr = smr
updateKeyInGame uv sc LongPress = case sc of
ScancodeF -> over uvWorld youDropItem uv
ScancodeSpace -> over uvWorld spaceAction uv
src/Dodge/Update/Scroll.hs
+4 -3
View File
@@ -35,14 +35,15 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory {_subInventory = ExamineInventory mi}
| invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
| rbDown -> w & changeTweakParam mi yi
| otherwise -> w & moveTweakSel yi
DisplayInventory {_subInventory = CombineInventory SelectionIntMap {_smRegexInput = False}}
-> w & moveCombineSel yi
DisplayInventory {_subInventory = CombineInventory sm}
| regexnotinput $ _smRegex sm -> w & moveCombineSel yi
DisplayInventory {_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
_ -> w
where
regexnotinput smr = not $ smr ^? smrInput == Just True
y = fromIntegral yi
numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
rbDown = ButtonRight `M.member` _mouseButtons (_input w)
src/Dodge/Update/UsingInput.hs
+6 -4
View File
@@ -30,10 +30,11 @@ updateUsingInput w = case w ^. hud . hudElement of
pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World
pressedMBEffects subinv pkeys w = case subinv of
NoSubInventory -> pressedMBEffectsNoInventory pkeys w
CombineInventory SelectionIntMap{_smSelPos = mi, _smRegexInput = False}
| lbinitialpress -> maybeexitcombine (maybe id doCombine mi w)
CombineInventory SelectionIntMap{_smRegexInput = True}
| lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
CombineInventory SelectionIntMap{_smSelPos = mi, _smRegex = smr}
| lbinitialpress && regexnotinput smr -> maybeexitcombine (maybe id doCombine mi w)
CombineInventory SelectionIntMap{}
| lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegex. smrInput
%~ const False
DisplayTerminal tmid
| lbinitialpress && inTermFocus w ->
doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w
@@ -41,6 +42,7 @@ pressedMBEffects subinv pkeys w = case subinv of
w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
_ -> w
where
regexnotinput smr = not $ smr ^? smrInput == Just True
lbinitialpress = pkeys ^? ix ButtonLeft == Just False
maybeexitcombine w'
| ButtonRight `M.member` _mouseButtons (_input w) =
src/SelectionIntMap.hs
+2 -5
View File
@@ -10,8 +10,8 @@ import LensHelp
setShownIntMap :: SelectionIntMap a -> SelectionIntMap a
setShownIntMap sm = case sm ^. smRegex of
"" | not (sm ^. smRegexInput) -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
str -> sm & smShownItems
NoSMRegex -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
SMRegex str _ -> sm & smShownItems
.~ IM.fromAscList (zip [0..] (f str : filter (regexList str . _siPictures) allitms))
where
allitms = sm ^. smItems
@@ -55,6 +55,3 @@ getIthYOffset :: Float -> Float -> SelectionIntMap a -> Int -> Float
getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1)
where
yint = getIthPos i (sm ^. smShownItems)
--selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a
--selectionSectionsToIntMap ss = undefined