Move combine list over to SelectionSections -- more todo

src/Dodge/Combine.hs

@@ -5,11 +5,17 @@ module Dodge.Combine (
     combineList,
 ) where
 
-import SelectionIntMap
+import Dodge.Data.Universe
+import Regex
+import Dodge.DisplayInventory
+import Dodge.Render.HUD
+import Dodge.SelectionList
+--import Dodge.Data.Config
+--import SelectionIntMap
 import Dodge.Data.Combine
 import Dodge.Item.Display
 import Color
-import Dodge.Data.SelectionList
+--import Dodge.Data.SelectionList
 import qualified Data.IntSet as IS
 import Control.Lens
 import Control.Monad
@@ -20,7 +26,7 @@ import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.You
 import Dodge.Combine.Trie
-import Dodge.Data.World
+--import Dodge.Data.World
 import Dodge.Item.Amount
 import Dodge.Module
 import qualified IntMapHelp as IM
@@ -103,17 +109,57 @@ combineTwoModuleMaps =
 fullModuleName :: ItemModuleType -> String
 fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
 
-toggleCombineInv :: World -> World
+toggleCombineInv :: Universe -> Universe
-toggleCombineInv w = case w ^? hud . hudElement . subInventory of
+toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
-    Just CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
+    Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
-    _ -> w & enterCombineInv
+    _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
 
-enterCombineInv :: World -> World
+updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem 
-enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory sm
+    -> SelectionSections CombinableItem
+updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [filt,combs]
   where
-    sm = initialSelPos $ SelectionIntMap
+    availablelines = getAvailableListLines secondColumnParams cfig
-        { _smItems = combineList w
+    filt = (-1, (filtsec,filtitems))
-        , _smSelPos = Nothing
+    filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1)
-        , _smRegex = Nothing
+    filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
-        , _smShownItems = IM.fromAscList $ zip [0..] (combineList w)
+        Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0)
+        Nothing -> mempty
+    numfiltitems = "  " ++ show numfiltitems' ++ " FILTERED"
+    numfiltitems' = length combitems' - length combitems
+    combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem)))
+    combs = (0, (combsec,combitems))
+    combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0
+    combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations
+    combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
+        Just str -> IM.filter (regexList str . _siPictures) combitems'
+        Nothing -> combitems'
+    ij = fromMaybe (0,0) $ do
+        i <- sss ^? sssSelPos . _Just
+        j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
+        return (i,j)
+
+enterCombineInv :: Configuration -> World -> World
+enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory 
+    cm
+    Nothing 
+    sss
+    --(updateCombineSelections w cfig sss)
+  where
+    cm = IM.fromAscList $ zip [0..] $ combineList w
+    sss = SelectionSections  
+        { _sssSections = IM.singleton 0 combsection
+        , _sssSelPos = Just 0
+        }
+    availablelines = getAvailableListLines secondColumnParams cfig
+    combsection = updateSection (Just 0) cm availablelines combinationssection'
+    combinationssection' = SelectionSection
+        { _ssItems = cm
+        , _ssCursor = do
+            (i,si) <- IM.lookupMin cm
+            return $ SectionCursor i 0 (length (_siPictures si)) (_siColor si)
+        , _ssMinSize = 5
+        , _ssOffset = 0
+        , _ssShownItems = mempty
+        , _ssIndent = 0
+        , _ssDescriptor = "COMBINATIONS"
         }

src/Dodge/Data/HUD.hs

@@ -25,7 +25,8 @@ data SubInventory
     = NoSubInventory
     | ExamineInventory {_subInvMSel :: Maybe Int}
 --    | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem}
-    | CombineInventory {_ciCombinations :: IntMap CombinableItem
+    | CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem)
+        , _ciRegex :: Maybe String
         , _ciSections :: SelectionSections CombinableItem
         }
     | LockedInventory

src/Dodge/DisplayInventory.hs

@@ -1,7 +1,11 @@
 {-# LANGUAGE TupleSections #-}
 module Dodge.DisplayInventory 
     ( updateDisplayInventory
+    , defaultSS
+    , defaultFiltSection
     , defaultDisplaySections
+    , updateSections
+    , updateSection
     ) where
 
 import Regex
@@ -96,7 +100,7 @@ updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss
         | otherwise = updateSection Nothing y availablelines x
     availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
 
-defaultSS :: SelectionSection ()
+defaultSS :: SelectionSection a
 defaultSS = SelectionSection 
     { _ssItems = mempty 
     , _ssCursor = Nothing 
@@ -113,7 +117,7 @@ defaultCOSection = defaultSS
     & ssIndent .~ 2 
     & ssDescriptor .~ "CLOSE OBJECTS"
 
-defaultFiltSection :: SelectionSection ()
+defaultFiltSection :: SelectionSection a
 defaultFiltSection = defaultSS 
     & ssIndent .~ 0
     & ssDescriptor .~ "INV"

src/Dodge/InputFocus.hs

@@ -32,12 +32,9 @@ inCloseRegex w = fromMaybe False $ do
 
 inSubInvRegex  :: World -> Bool
 inSubInvRegex w = fromMaybe False $ do
-        sm <- w ^? hud . hudElement . subInventory . subInvMap
+        sss <- w ^? hud . hudElement . subInventory . ciSections
-        i <- sm ^? smSelPos . _Just
+        i <- sss ^? sssSelPos . _Just
-        si <- sm ^? smShownItems . ix i
+        return $ i == (-1)
-        case si of
-            SelectionRegex {} -> return True
-            _ -> return False
 
 inputFocus :: World -> Bool
 inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w

src/Dodge/Inventory.hs

@@ -26,6 +26,7 @@ module Dodge.Inventory (
     setInvPosFromSS,
 ) where
 
+import Dodge.SelectionSections
 import Control.Applicative
 import Dodge.Data.SelectionList
 import Color
@@ -382,103 +383,6 @@ setInvPosFromSS w = w
             3 -> Just $ InNearby $ SelCloseObject j
             _ -> error "selection out of bounds"
             
--- this should be in a separate module
-firstPosSelectionSections :: SelectionSections a -> SelectionSections a
-firstPosSelectionSections sss = fromMaybe sss $ do
-    (i,j,si) <- ssLookupMin sss
-    return $ sss
-        & sssSelPos ?~ i
-        & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
-
-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
-
-scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
-scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
-    i <- sss ^? sssSelPos . _Just
-    j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
-    (i',j',si) <- ssLookupUp i j sss
-    return $ sss & sssSelPos ?~ i'
-        & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
-
-scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
-scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
-    i <- sss ^? sssSelPos . _Just
-    j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
-    (i',j',si) <- ssLookupDown i j sss
-    return $ sss & sssSelPos ?~ i'
-        & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
-
-ssSetCursor :: (SelectionSections a -> Maybe (Int,Int,SelectionItem a)) 
-    -> SelectionSections a -> SelectionSections a
-ssSetCursor f sss = fromMaybe sss $ do
-    (i,j,si) <- f sss
-    return $ sss
-        & sssSelPos ?~ i
-        & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
-
-ssLookupMax :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupMax sss = do
-    (i,_) <- IM.lookupMax (sss ^. sssSections)
-    ssLookupLE' i sss
-
-ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupUp i j sss = case ssLookupLT i j sss of
-    Nothing -> ssLookupMax sss
-    x -> x
-
-ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupDown i j sss = case ssLookupGT i j sss of
-    Nothing -> ssLookupMin sss
-    x -> x
-
-ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
-    ss <- sss ^? sssSections . ix i
-    (j',si) <- IM.lookupLT j (ss ^. ssItems)
-    return $ Just (i,j',si)
-
-ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupLT' i sss = do
-    (i',ss) <- IM.lookupLT i (sss ^. sssSections)
-    case IM.lookupMax (ss ^. ssItems) of
-        Just (j',si) -> return (i',j',si)
-        Nothing -> ssLookupLT' i' sss
-
-ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupLE' i sss = do
-    (i',ss) <- IM.lookupLE i (sss ^. sssSections)
-    case IM.lookupMax (ss ^. ssItems) of
-        Just (j',si) -> return (i',j',si)
-        Nothing -> ssLookupLT' i' sss
-
-ssLookupMin :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupMin sss = do
-    (i,_) <- IM.lookupMin (sss ^. sssSections)
-    ssLookupGE' i sss
-
-ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
-    ss <- sss ^? sssSections . ix i
-    (j',si) <- IM.lookupGT j (ss ^. ssItems)
-    return $ Just (i,j',si)
-
-ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupGT' i sss = do
-    (i',ss) <- IM.lookupGT i (sss ^. sssSections)
-    case IM.lookupMin (ss ^. ssItems) of
-        Just (j',si) -> return (i',j',si)
-        Nothing -> ssLookupGT' i' sss
-
-ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
-ssLookupGE' i sss = do
-    (i',ss) <- IM.lookupGE i (sss ^. sssSections)
-    case IM.lookupMin (ss ^. ssItems) of
-        Just (j',si) -> return (i',j',si)
-        Nothing -> ssLookupGT' i' sss
 
 selectedCloseObject :: World -> Maybe (Either FloorItem Button)
 selectedCloseObject w = do

src/Dodge/Render/HUD.hs

@@ -2,6 +2,7 @@
 module Dodge.Render.HUD (
     drawHUD,
     invDisplayParams,
+    secondColumnParams,
 ) where
 
 import Dodge.Inventory
@@ -68,7 +69,7 @@ invDisplayParams w =
         Just ExamineInventory{} -> True
         _ -> False
 
-drawSelectionSections :: SelectionSections () -> ListDisplayParams -> Configuration -> Picture
+drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
 drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
     (_ldpVerticalGap ldps)
     (_ldpScale ldps)
@@ -94,18 +95,18 @@ 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 _ sss -> titledSub' cfig "COMBINE" sss
+    CombineInventory _ _ sss -> titledSub' cfig "COMBINE" sss
             <> combineInventoryExtra sss cfig w
 
-titledSub :: Configuration -> String -> SelectionSections a -> Picture
+titledSub :: Configuration -> String -> SelectionList a -> Picture
-titledSub cfig subtitle sss =
+titledSub cfig subtitle subitems =
     invHead cfig subtitle
-        <> drawSelectionList sss secondColumnParams cfig
+        <> drawSelectionList secondColumnParams cfig subitems
 
 titledSub' :: Configuration -> String -> SelectionSections a -> Picture
 titledSub' cfig subtitle subitems =
     invHead cfig subtitle
-        <> drawSelectionSections secondColumnParams cfig subitems
+        <> drawSelectionSections subitems secondColumnParams cfig
 
 drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
 drawExamineInventory cfig mtweaki w =

src/Dodge/Update.hs

@@ -144,8 +144,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 sm)
+        Just (CombineInventory _ _ _)
-            | inregex sm -> doSubInvRegexInput u
+            | inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u
         -- _ | inInvRegex (u ^. uvWorld) -> doInvRegexInput u
         _ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u
         _ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u

src/Dodge/Update/Input.hs

@@ -52,14 +52,14 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
 doSubInvRegexInput :: Universe -> Universe
 doSubInvRegexInput u
     | backspacetonothing =
-        u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing
+        u & uvWorld . hud . hudElement . subInventory . ciRegex .~ Nothing
-            & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
+--            & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
-            & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
+--            & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
-    | endkeys || endmouse =
+    | endkeys || endmouse = u
-        u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
+--        u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
     | otherwise =
-        u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
+        u & doTextInputOver (uvWorld . hud . hudElement . subInventory . ciRegex . _Just)
-            & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
+--            & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
   where
     endkeys =
         any
@@ -67,7 +67,7 @@ doSubInvRegexInput u
             [ScancodeReturn, ScancodeEscape, ScancodeSlash]
     endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
     backspacetonothing =
-        u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just ""
+        u ^? uvWorld . hud . hudElement . subInventory . ciRegex . _Just == Just ""
             && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
     pkeys = u ^. uvWorld . input . pressedKeys
 
@@ -158,7 +158,7 @@ updateInitialPressInGame uv sc = case sc of
     ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv
     ScancodeT -> over uvWorld testEvent uv
     ScancodeX -> uv & uvWorld %~ toggleTweakInv
-    ScancodeC -> over uvWorld toggleCombineInv uv
+    ScancodeC -> toggleCombineInv uv
     -- the following should be put in a more sensible place
     ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
     ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
@@ -174,12 +174,12 @@ updateBackspaceRegex :: World -> World
 updateBackspaceRegex w = case di ^? subInventory of
     Just NoSubInventory | secfocus (-1) 0 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
     Just NoSubInventory | secfocus 2 3 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
-    Just CombineInventory{} ->
+--    Just CombineInventory{} ->
-        w & hud . hudElement . subInventory . subInvMap
+--        w & hud . hudElement . subInventory . subInvMap
-            %~ ( (smRegex %~ enternonzeroregex)
+--            %~ ( (smRegex %~ enternonzeroregex)
-                    . (smSelPos ?~ 0)
+--                    . (smSelPos ?~ 0)
-                    . setShownIntMap
+--                    . setShownIntMap
-               )
+--               )
     _ -> w
   where
     secfocus a b = fromMaybe False $ do
@@ -215,12 +215,12 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
                 %~ ( (closeRegex %~ enterregex)
                         . (manObject .~ InNearby SortNearby)
                    )
-    Just CombineInventory{} ->
+    Just CombineInventory{} -> w
-        w & hud . hudElement . subInventory . subInvMap
+--        w & hud . hudElement . subInventory . subInvMap
-            %~ ( setShownIntMap
+--            %~ ( setShownIntMap
-                    . (smSelPos ?~ 0)
+--                    . (smSelPos ?~ 0)
-                    . (smRegex %~ enterregex)
+--                    . (smRegex %~ enterregex)
-               )
+--               )
     _ -> w
   where
     di = w ^. hud . hudElement

src/Dodge/Update/Scroll.hs

@@ -2,6 +2,7 @@ module Dodge.Update.Scroll (
     updateWheelEvent,
 ) where
 
+import Dodge.SelectionSections
 import SelectionIntMap
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -49,7 +50,8 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
     invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
 
 moveCombineSel :: Int -> World -> World
-moveCombineSel yi = hud . hudElement . subInventory . subInvMap %~ moveSelectionMapSelection yi
+moveCombineSel yi = hud . hudElement . subInventory . ciSections 
+    %~ scrollSelectionSections yi
 
 moveSubSel :: Int -> Int -> World -> World
 moveSubSel yi maxyi =

src/Dodge/Update/UsingInput.hs

@@ -30,8 +30,8 @@ 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}
+    CombineInventory _ _ sss
-        | lbinitialpress -> maybeexitcombine (maybe id doCombine mi w)
+        | lbinitialpress -> tryCombine sss w -- maybeexitcombine (maybe id doCombine mi w)
     DisplayTerminal tmid
         | lbinitialpress && inTermFocus w ->
             doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w
@@ -40,11 +40,14 @@ pressedMBEffects subinv pkeys w = case subinv of
     _ -> w
   where
     lbinitialpress = pkeys ^? ix ButtonLeft == Just False
-    maybeexitcombine w'
+--    maybeexitcombine w'
-        | ButtonRight `M.member` _mouseButtons (_input w) =
+--        | ButtonRight `M.member` _mouseButtons (_input w) =
-            (hud . hudElement . subInventory . subInvMap %~ setShownIntMap) $
+--            (hud . hudElement . subInventory . subInvMap %~ setShownIntMap) $
-                (hud . hudElement . subInventory . subInvMap . smItems .~ combineList w') w'
+--                (hud . hudElement . subInventory . subInvMap . smItems .~ combineList w') w'
-        | otherwise = w' & hud . hudElement . subInventory .~ NoSubInventory
+--        | otherwise = w' & hud . hudElement . subInventory .~ NoSubInventory
+
+tryCombine :: SelectionSections CombinableItem -> World -> World
+tryCombine sss w = w
 
 pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World
 pressedMBEffectsNoInventory pkeys w
@@ -64,9 +67,10 @@ pressedMBEffectsNoInventory pkeys w
 -- note "sort" on the inventory indices; otherwise
 -- lower items may be shifted up and items below these removed instead
 doCombine :: Int -> World -> World
-doCombine i w = case w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of
+doCombine i w = undefined
-    Nothing -> w
+-- case w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of
-    Just (CombinableItem is it _) -> createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
+--    Nothing -> w
+--    Just (CombinableItem is it _) -> createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
 
 updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
 updatePressedButtonsCarte pkeys w