Work on selecting

src/Dodge/Data/SelectionList.hs

@@ -31,7 +31,7 @@ data SectionCursor = SectionCursor
 
 data SelSection a = SelSection
     { _ssItems :: IntMap (SelectionItem a)
-    , _ssOffset :: Int
+    , _ssYOffset :: Int
     , _ssShownItems :: [Picture]
     , _ssShownLength :: Int
     , _ssIndent :: Int

src/Dodge/DisplayInventory.hs

@@ -248,7 +248,7 @@ updateSectionsPositioning ::
 updateSectionsPositioning h mselpos allavailablelines lsss sss =
     IM.intersectionWithKey (\k -> updateSection (h k) (m k)) lsss ssizes `g` offsets
   where
-    offsets = fmap (\ss -> (_ssOffset ss, ss ^. ssSet)) sss
+    offsets = fmap (\ss -> (ss^.ssYOffset, ss^.ssSet)) sss
     m k = do
         Sel k' i <- mselpos
         guard $ k == k'
@@ -262,7 +262,7 @@ updateSection :: Int -> Maybe Int -> IMSI a -> Int -> (Int,IS.IntSet) -> SelSect
 updateSection indent mcsel sis availablelines (oldoffset,sset) =
     SelSection
         { _ssItems = sis
-        , _ssOffset = offset
+        , _ssYOffset = offset
         , _ssShownItems = shownitems
         , _ssShownLength = min aslength availablelines
         , _ssIndent = indent

src/Dodge/Render/HUD.hs

@@ -52,10 +52,9 @@ import SDL (MouseButton (..))
 
 drawHUD :: Config -> World -> Picture
 drawHUD cfig w =
-    drawInventory sections w cfig subinv
+    drawInventory (w ^. hud . diSections) w cfig subinv
         <> drawSubInventory subinv cfig w
   where
-    sections = w ^. hud . diSections
     subinv = w ^. hud . subInventory
 
 drawInventory :: IMSS () -> World -> Config -> SubInventory -> Picture
@@ -94,14 +93,7 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
             if null (w ^? rbState . opSel)
                 then BoundCurs [minBound ..]
                 else BoundCurs [North, South, West]
-    return $
-        drawSSMultiCursor
-            sss
-            (0, x)
-            (y - x)
-            ldp
-            curs
-            cfig
+    return $ drawSSMultiCursor sss (0, x) (y - x) ldp curs cfig
 
 getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
 getRootItemBounds i inv = do
@@ -126,10 +118,7 @@ drawMouseOver cfig w =
         return
             . translateScreenPos cfig (invDP ^. ldpPos)
             . color (0.3 *^ white)
-            --            . color white
---            $ selSecDrawCursor invDP curs sss (Sel j i mempty)
             $ selSecDrawCursor invDP curs sss (Sel j i)
-    --    curs = BoundaryCursor [West]
     curs = BackdropCurs
     combinvsel = do
         (j, i) <-
@@ -145,8 +134,8 @@ drawMouseOver cfig w =
 drawDragSelected :: Config -> World -> Maybe Picture
 drawDragSelected cfig w = do
     ys0 <- w ^? hud . diSections . ix 0 . ssSet
-    ys2 <- w ^? hud . diSections . ix 3 . ssSet
-    ys4 <- w ^? hud . diSections . ix 5 . ssSet
+    ys3 <- w ^? hud . diSections . ix 3 . ssSet
+    ys5 <- w ^? hud . diSections . ix 5 . ssSet
     guard $ case w ^? hud . subInventory of
                     Just NoSubInventory -> True
                     _ -> False
@@ -156,23 +145,8 @@ drawDragSelected cfig w = do
         . translateScreenPos cfig (invDP ^. ldpPos)
         . color (0.2 *^ white)
         $ IS.foldr (f 0) mempty ys0
-        <> IS.foldr (f 3) mempty ys2
-        <> IS.foldr (f 5) mempty ys4
---    ys <- w ^? hud . diSelection . _Just . slSet
---    guard $
---        not (IS.null ys)
---            && ( case w ^? hud . subInventory of
---                    Just NoSubInventory -> True
---                    _ -> False
---               )
---    Sel i _ _ <- w ^? hud . diSelection . _Just
---    sss <- w ^? hud . diSections
---    let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
---    return
---        . translateScreenPos cfig (invDP ^. ldpPos)
---        . color (0.2 *^ white)
---        . IS.foldr f mempty
---        $ ys
+        <> IS.foldr (f 3) mempty ys3
+        <> IS.foldr (f 5) mempty ys5
 
 drawDragSelecting :: Config -> World -> Maybe Picture
 drawDragSelecting cfig w = do
@@ -188,23 +162,6 @@ drawDragSelecting cfig w = do
         . color (0.2 *^ white)
         . IM.foldMapWithKey f
         $ sssSelectionSlice sss x y
---    OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
---    sss <- w ^? hud . diSections
---    let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x)
---    return
---        . translateScreenPos cfig (invDP ^. ldpPos)
---        . color (0.2 *^ white)
---        . foldMap f
---        $ [min j b .. max j b]
-
-
---
---    return $ IM.foldMapWithKey f s
---  where
---    f i ss = IM.foldMapWithKey (g i) (ss ^. ssItems)
---    g i j si 
---        | si ^. siIsSelectable = [(i,j)]
---        | otherwise = mempty
 
 drawSubInventory :: SubInventory -> Config -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
@@ -262,7 +219,7 @@ drawExamineInventory cfig w =
             }
 
 closeObjectInfo :: Int -> Either Item Button -> String
-closeObjectInfo n x = case x of
+closeObjectInfo n = \case
     Left itm -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm
     Right _ -> "Some sort of switch or button."
 
@@ -316,16 +273,7 @@ drawRBOptions cfig w = fold $ do
             <> translate
                 (120 - xt)
                 0
-                ( listCursor
-                    0
-                    1
-                    (BoundCurs [North, South])
-                    curpos
-                    0
-                    white
-                    25
-                    1
-                )
+                ( listCursor 0 1 (BoundCurs [North, South]) curpos 0 white 25 1)
             <> translate
                 (380 - xt)
                 0
@@ -366,10 +314,9 @@ drawItemConnections sss cfig =
         . fmap (\(_, a, b) -> a <> b)
 
 drawItemChildrenConnect :: IMSS () -> Config -> Int -> [Int] -> Picture
-drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
+drawItemChildrenConnect sss cfig i is = fold $ do
     p <- snum i
-    let ps = mapMaybe snum is
-    return $ color white $ lConnectMulti ps p
+    return $ color white $ lConnectMulti (mapMaybe snum is) p
   where
     snum = selNumPos cfig invDP sss 0
 

src/Dodge/SelectionSections.hs

@@ -189,7 +189,7 @@ selSecYint i j sss = do
     ss <- sss ^? ix i
     return
         . (secpos +)
-        . subtract (ss ^. ssOffset)
+        . subtract (ss ^. ssYOffset)
         . sum
         . fmap _siHeight
         . fst
@@ -207,7 +207,7 @@ inverseSelSecYint yint sss
             then return $ inverseSelSecYint (yint - l) othersss
             else do
                 let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
-                (j, _) <- L.fold (L.find (\(_, x) -> x - _ssOffset ss > yint)) $ IM.toList ls
+                (j, _) <- L.fold (L.find (\(_, x) -> x - _ssYOffset ss > yint)) $ IM.toList ls
                 return $ NonInf (i, j)
 
 inverseSelSecYintXPosCheck ::

src/Dodge/Update/Input/InGame.hs

@@ -211,70 +211,7 @@ updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of
                 & hud . diSections . ix 0 . ssSet .~ mempty
                 & hud . diSections . ix 3 . ssSet .~ mempty
                 & doDragSelect cfig ssel
-
---    OverInvDragSelect (Just ssel) mesel
---        | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
---            w
---                & input
---                . mouseContext
---                .~ MouseInGame
---                & ( fromMaybe id $ do
---                        j <- w ^? hud . diSelection . _Just . slSec
---                        return $
---                            hud
---                                . diSections
---                                . ix j
---                                . ssSet
---                                %~ getuniques
---                                    ( maybe
---                                        mempty
---                                        mempty
---                                        -- (h ssel)
---                                        (guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
---                                    )
---                  )
---                & hud
---                . diSections
---                . ix (fst ssel)
---                . ssSet
---                %~ getuniques
---                    ( maybe
---                        mempty
---                        (h ssel)
---                        (guard (ssel ^? _1 == w ^? hud . diSelection . _Just . slSec) >> mesel ^? _Just)
---                    )
---    OverInvDragSelect (Just ssel) (Just esel) ->
---        w
---            & input
---            . mouseContext
---            .~ MouseInGame
---            -- & invSetSelection (f (fst ssel, esel) (h ssel esel))
---            & hud
---            . diSections
---            . ix (fst ssel)
---            . ssSet
---            .~ h ssel esel
---            & invSetSelection (f (fst ssel, esel))
---    OverInvDragSelect{} ->
---        w
---            & input
---            . mouseContext
---            .~ MouseInGame
---            --            & hud . diSelection . _Just . slSet %~ const mempty
---            & hud
---            . diSections
---            . each
---            . ssSet
---            %~ const mempty
     _ -> w
-  where
-    f (x, y) = Sel x y
-    -- need to set this in OverInvDragSelect (twice)?
-    h (k, i) j = fold $ do
-        sss <- w ^? hud . 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
 
 doDragSelect :: Config -> XInfinity (Int,Int) -> World -> World
 doDragSelect cfig x w = fromMaybe w $ do
@@ -291,45 +228,20 @@ doDragSelect cfig x w = fromMaybe w $ do
 symmetricDifference :: IS.IntSet -> IS.IntSet -> IS.IntSet
 symmetricDifference x y = (x `IS.union` y) IS.\\ (x `IS.intersection` y)
 
-isGroupSelectableSection :: Int -> Bool
-isGroupSelectableSection = \case
-    0 -> True
-    3 -> True
-    _ -> False
-
 updateMouseClickInGame :: Config -> World -> World
 updateMouseClickInGame cfig w = case w ^. input . mouseContext of
     MouseInGame -> w & input . mouseContext .~ OverInvDragSelect
         (inverseSelSecYint 
                 (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
                 (w ^. hud . diSections))
---  fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
---        let sss = w ^. hud . diSections
---        ysel <-
---            inverseSelSecYint
---                (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
---                sss
---                ^? nonInf
---        guard (isGroupSelectableSection $ fst ysel)
---        return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
     OverInvSelect (-1, _)
-        | selsec == Just (-1) ->
-            w
-                & hud
-                . diSelection
-                %~ endRegex (-1) w
-                & hud
-                . diInvFilter
-                .~ Nothing
+        | selsec == Just (-1) -> w
+                & hud . diSelection %~ endRegex (-1) w
+                & hud . diInvFilter .~ Nothing
     OverInvSelect (2, _)
-        | selsec == Just 2 ->
-            w
-                & hud
-                . diSelection
-                %~ endRegex 2 w
-                & hud
-                . diCloseFilter
-                .~ Nothing
+        | selsec == Just 2 -> w
+                & hud . diSelection %~ endRegex 2 w
+                & hud . diCloseFilter .~ Nothing
     OverInvSelect (5, j) -> fromMaybe w $ do
         k <- w ^? hud . closeButtons . ix j
         but <- w ^? cWorld . lWorld . buttons . ix k
@@ -337,52 +249,25 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
     OverInvSelect x
         | ScancodeLShift `M.member` (w ^. input . pressedKeys)
             -> w & input . mouseContext .~ OverInvDragSelect (NonInf x)
---            && isGroupSelectableSection (fst x) ->
---            w & input . mouseContext .~ OverInvDragSelect (Just x) (Just $ snd x)
     OverInvSelect x -> startDrag x w
     OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
     OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
     OutsideTerminal -> w & hud . subInventory .~ NoSubInventory
-    OverCombSelect x ->
-        w
-            & hud
-            . subInventory
-            . ciSelection
-            ?~ f x
-            & worldEventFlags
-            . at CombineInventoryChange
-            ?~ ()
-    OverCombFilter ->
-        w
-            & hud
-            . subInventory
-            . ciFilter
-            .~ Nothing
-            & worldEventFlags
-            . at CombineInventoryChange
-            ?~ ()
-            & hud
-            . subInventory
-            . ciSelection
-            %~ endCombineRegex w
-    OverCombCombine x ->
-        w
+    OverCombSelect x -> w
+            & hud . subInventory . ciSelection ?~ f x
+            & worldEventFlags . at CombineInventoryChange ?~ ()
+    OverCombFilter -> w
+            & hud . subInventory . ciFilter .~ Nothing
+            & worldEventFlags . at CombineInventoryChange ?~ ()
+            & hud . subInventory . ciSelection %~ endCombineRegex w
+    OverCombCombine x -> w
             & tryCombine x
-            & worldEventFlags
-            . at CombineInventoryChange
-            ?~ ()
-            & worldEventFlags
-            . at InventoryChange
-            ?~ ()
+            & worldEventFlags . at CombineInventoryChange ?~ ()
+            & worldEventFlags . at InventoryChange ?~ ()
             & maybeExitCombine
-    OverCombEscape ->
-        w
-            & worldEventFlags
-            . at InventoryChange
-            ?~ ()
-            & hud
-            . subInventory
-            .~ NoSubInventory
+    OverCombEscape -> w
+            & worldEventFlags . at InventoryChange ?~ ()
+            & hud . subInventory .~ NoSubInventory
     OverCombFiltInv (0, j) -> fromMaybe w $ do
         str <-
             fmap (take 5) $