Tweak combine inventory regex

src/Dodge/Combine.hs

@@ -114,7 +114,6 @@ enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory sm
     sm = initialSelPos $ SelectionIntMap
         { _smItems = combineList w
         , _smSelPos = Nothing
-        , _smRegex = ""
+        , _smRegex = NoSMRegex
-        , _smRegexInput = False
         , _smShownItems = IM.fromAscList $ zip [0..] (combineList w)
         }

src/Dodge/Data/SelectionList.hs

@@ -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
+    , _smRegex  :: SMRegex
-    , _smRegexInput :: Bool
     , _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

@@ -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

@@ -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

@@ -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

@@ -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 -> 
+    CombineInventory sl -> titledSub' cfig "COMBINE" sl
-        let mi = _smSelPos sl
+            <> combineInventoryExtra sl (_smSelPos sl) cfig w
-        in titledSub'
-            cfig
-            "COMBINE"
-            sl
-            <> combineInventoryExtra sl mi 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
+-- note the use of ^?! 
--- this
+-- 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,20 +185,15 @@ 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 =
+examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
-    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))
-        ]
 
 combineInventoryExtra :: SelectionIntMap CombinableItem -> Maybe Int -> Configuration -> World -> Picture
-combineInventoryExtra sm mi cfig w =
+combineInventoryExtra sm mi cfig w = fromMaybe mempty $ do
-    pictures
-        [ fromMaybe mempty $ do
     i <- mi
     let cpos = getIthPos i (sm ^. smShownItems)
     col <- sm ^? smShownItems . ix i . siColor
@@ -222,7 +209,6 @@ combineInventoryExtra sm mi cfig w =
                         <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
                         <> combineCounts cfig w lnks
             ]
-        ]
 
 secondColumnParams :: ListDisplayParams
 secondColumnParams =

src/Dodge/TestString.hs

@@ -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

@@ -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

@@ -46,17 +46,21 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
 
 doSubInvRegexInput :: Universe -> Universe
 doSubInvRegexInput u
-    | endkeys || backspacetonothing || endmouse
+    | backspacetonothing
-            = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
+            = 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

@@ -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}} 
+    DisplayInventory {_subInventory = CombineInventory sm} 
-        -> w & moveCombineSel yi
+        | 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

@@ -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}
+    CombineInventory SelectionIntMap{_smSelPos = mi, _smRegex = smr}
-        | lbinitialpress -> maybeexitcombine (maybe id doCombine mi w)
+        | lbinitialpress && regexnotinput smr -> maybeexitcombine (maybe id doCombine mi w)
-    CombineInventory SelectionIntMap{_smRegexInput = True}
+    CombineInventory SelectionIntMap{}
-        | lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
+        | 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

@@ -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)
+    NoSMRegex -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
-    str -> sm & smShownItems 
+    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