Fix cursor selection when dropping filtered items

src/Dodge/DisplayInventory.hs

@@ -1,11 +1,12 @@
 {-# LANGUAGE TupleSections #-}
 
 module Dodge.DisplayInventory (
-    enterCombineInv,
     toggleCombineInv,
     updatePositionHUD,
+    updateInventorySectionItems,
 ) where
 
+import Dodge.ListDisplayParams
 import ListHelp
 import Dodge.Data.Combine
 import Control.Monad
@@ -19,7 +20,6 @@ import Dodge.Data.Universe
 import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.Color
 import Dodge.Inventory.SelectionList
-import Dodge.Render.HUD
 import Dodge.SelectionList
 import LensHelp
 import Picture.Base
@@ -28,8 +28,7 @@ import Regex
 -- this should ONLY change the shownitems
 updatePositionHUD :: Universe -> Universe
 updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of
-    Just NoSubInventory -> u & uvWorld . hud . hudElement . diSections
+    Just NoSubInventory -> u & updateDisplayInventory
-        %~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
     Just CombineInventory {} -> u & uvWorld . hud . hudElement . subInventory . ciSections
         %~ updateCombineInventory (_uvWorld u) (_uvConfig u)
     _ -> u
@@ -84,8 +83,12 @@ orRegex f x str = case words str of
     [] -> True
     xs -> any (f x) xs
 
-updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
+updateDisplayInventory :: Universe -> Universe
-updateDisplayInventory w cfig sss =
+updateDisplayInventory u = u & uvWorld . hud . hudElement . diSections
+        %~ updateDisplaySections (_uvWorld u) (_uvConfig u)
+
+updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections ()
+updateDisplaySections w cfig sss =
     sss & sssSections
         %~ updateSectionsPositioning
             mselpos
@@ -129,6 +132,17 @@ updateDisplayInventory w cfig sss =
             return $ IM.filter (plainRegex str) itms
         numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 
+-- it is annoying that this is necessary
+updateInventorySectionItems :: World -> World
+updateInventorySectionItems w = w 
+    & hud . hudElement . diSections . sssSections . ix 0 . ssItems %~ f
+  where
+    f olditems = fromMaybe olditems $ do
+        cr <- w ^? cWorld . lWorld . creatures . ix 0
+        invitms <- cr ^? crInv
+        str <- w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just
+        return $ IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms
+
 plainRegex :: String -> SelectionItem a -> Bool
 plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si))
 

src/Dodge/Inventory.hs

@@ -22,6 +22,7 @@ module Dodge.Inventory (
     setInvPosFromSS,
 ) where
 
+import Dodge.DisplayInventory
 import Dodge.SelectionSections
 import Control.Applicative
 import Dodge.Data.SelectionList
@@ -43,6 +44,7 @@ import LensHelp
 import ListHelp
 import Padding
 
+-- TODO check what happens to selection index when dropping non-selected items
 -- | after this the item at the inventory position will no longer exist
 rmInvItem ::
     -- | Creature id
@@ -55,8 +57,8 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
     _ ->
         w
-            & pointcid . crInv %~ f
             & pointcid %~ crCancelReloading
+            & pointcid . crInv %~ f
             & pointcid . crLeftInvSel . lisMPos %~ g'
             & removeAnySlotEquipment
             & dounequipfunction
@@ -71,7 +73,7 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
 
     updateselection
         | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid
-            = scrollAugInvSel (-1) . scrollAugInvSel 1
+            = scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
         | otherwise
             = pointcid . crManipulation . manObject . inInventory . ispItem %~ g
 
@@ -83,9 +85,12 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     doanyitemeffect = fromMaybe id $ do
         rmf <- itm ^? itEffect . ieOnDrop
         return $ doInvEffect rmf itm cr
-    removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
+    --removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
-        Just epos -> pointcid . crEquipment . at epos .~ Nothing
+    --    Just epos -> pointcid . crEquipment . at epos .~ Nothing
-        Nothing -> id
+    --    Nothing -> id
+    removeAnySlotEquipment = fromMaybe id $ do
+        epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid
+        return $ pointcid . crEquipment . at epos .~ Nothing
     maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split invid inv

src/Dodge/Inventory/Add.hs

@@ -1,5 +1,10 @@
-module Dodge.Inventory.Add where
+module Dodge.Inventory.Add 
+    ( tryPutItemInInv
+    , createPutItem
+    , createAndSelectItem
+    )where
 
+import Dodge.Data.SelectionList
 import Control.Lens
 import Data.Maybe
 import Dodge.Base.You
@@ -38,6 +43,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
 createAndSelectItem :: Item -> World -> World
 createAndSelectItem itm w = case createPutItem itm w of
     (Just i, w') -> w' 
+        & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0,i)
         & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
             .~ InInventory (SelItem i NoInvSelAction)
     (Nothing, w') -> w'

src/Dodge/Inventory/CheckSlots.hs

@@ -1,4 +1,8 @@
-module Dodge.Inventory.CheckSlots where
+module Dodge.Inventory.CheckSlots (
+    checkInvSlotsYou,
+    crNumFreeSlots,
+    crInvSize,
+) where
 
 import Control.Lens
 import Data.Maybe
@@ -13,11 +17,10 @@ import qualified IntMapHelp as IM
 checkInvSlotsYou :: Item -> World -> Maybe Int
 checkInvSlotsYou it w
     | crNumFreeSlots ycr >= ceiling (_itInvSize it) =
-        Just $ findItemSlot it inv
+        Just $ findItemSlot it (_crInv ycr)
     | otherwise = Nothing
   where
     ycr = you w
-    inv = _crInv ycr
 
 -- Assumes that the item is singular.
 -- Do not want to stack floor items for now

src/Dodge/Render/HUD.hs

@@ -1,8 +1,6 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Render.HUD (
     drawHUD,
-    invDisplayParams,
-    secondColumnParams,
 ) where
 
 import Dodge.ListDisplayParams

src/Dodge/Update/Input.hs

@@ -2,376 +2,12 @@ module Dodge.Update.Input (
     updateUseInput,
 ) where
 
---import Control.Monad
-
---import Control.Monad
-
---import Control.Monad
-import Dodge.DisplayInventory
-import Data.List (sort)
-import Dodge.Inventory.Add
-import Dodge.Data.Combine
-import Geometry
-import Dodge.SelectionList
-import Dodge.Base.Window
-import Dodge.Menu.Option
-import Dodge.InputFocus
-import Dodge.SelectionSections
-import Dodge.Default.World
-import Data.Char
-import qualified Data.IntMap.Strict as IM
-import qualified Data.Map.Strict as M
-import Data.Maybe
---import Data.Monoid (First)
-import Dodge.Base.You
-import Dodge.Button.Event
-import Dodge.Creature.Action
 import Dodge.Data.Universe
-import Dodge.Debug.Terminal
+import Dodge.Update.Input.InGame
---import Dodge.DisplayInventory
+import Dodge.Update.Input.ScreenLayer
-import Dodge.Event.Test
+import Control.Lens
-import Dodge.Inventory
-import Dodge.Menu
-import Dodge.Reloading
-import Dodge.Save
-import Dodge.Terminal.LeftButton
-import Dodge.WorldPos
-import LensHelp
-import SDL
 
 updateUseInput :: Universe -> Universe
 updateUseInput u = case u ^? uvScreenLayers . _head of
     Just sl -> updateUseInputOnScreen sl u
     Nothing -> updateUseInputInGame (u ^. uvWorld . hud . hudElement) u
-
-updateUseInputOnScreen :: ScreenLayer -> Universe -> Universe
-updateUseInputOnScreen sl = case sl of
-    InputScreen thetext _-> doInputScreenInput thetext
-    screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} ->
-        optionScreenUpdate screen mop flag ldps sellist
-
-updateUseInputInGame :: HUDElement -> Universe -> Universe
-updateUseInputInGame h u = case h of
-    DisplayCarte -> over uvWorld updatePressedButtonsCarte u
-    DisplayInventory {_subInventory = si} -> case si of
-        DisplayTerminal tmid 
-            | lbinitialpress && inTermFocus w ->
-                over uvWorld (doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)) u
-            | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
-            | 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)
-            | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u
---        _ -> case regexFocus w of
---            Nothing -> M.foldlWithKey' updateKeyInGame u pkeys
---            Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput
-        _ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1) 
-        _ | inCloseRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2
-        _ -> M.foldlWithKey' updateKeyInGame u pkeys
-  where
-    w = u ^. uvWorld
-    pkeys = u ^. uvWorld . input . pressedKeys
-    pmb = u ^. uvWorld . input . mouseButtons
-    lbinitialpress = pmb ^? ix ButtonLeft == Just False
-
-tryCombine :: SelectionSections CombinableItem -> World -> World
-tryCombine sss w = fromMaybe w $ do
-    (i,j) <- sss ^? sssExtra . sssSelPos . _Just
-    CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
-    return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
-
-maybeExitCombine :: Universe -> Universe
-maybeExitCombine u
-    | ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons)
-        = u & uvWorld %~ enterCombineInv (u ^. uvConfig)
-    | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
-
-doTextInputOver :: ASetter' Universe String -> Universe -> Universe
-doTextInputOver p u = doTextInputOver' u p u
-
-doTextInputOver' :: Universe -> ASetter' a String -> a -> a
-doTextInputOver' u p x =
-    x & p %~ (++ map toUpper str)
-        & checkBackspace
-  where
-    str = u ^. uvWorld . input . textInput
-    checkBackspace
-        | backspaceInputted u = p %~ doBackspace
-        | otherwise = id
-
-doBackspace :: String -> String
-doBackspace [] = []
-doBackspace s = init s
-
-backspaceInputted :: Universe -> Bool
-backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of
-    Just InitialPress -> True
-    Just LongPress -> True
-    _ -> False
-
-doRegexInput :: Universe -> Int -> SelectionSections a -> SelectionSections a
-doRegexInput u i sss
-    | backspacetonothing || escapekey = endregex i 0
-    | endkeys || endmouse = endregex (i + 1) (j -1)
-    | otherwise = sss & doTextInputOver' u (sssExtra . sssFilters . ix i . _Just)
-  where
-    endregex a b =
-        sss
-            & sssExtra . sssFilters . ix i .~ Nothing
-            & sssSections . ix i . ssItems .~ mempty
-            &  ssSetCursor (ssLookupDown a b)
-    j = fromMaybe 0 $ do
-        itms <- sss ^? sssSections . ix (i + 1) . ssItems
-        fst <$> IM.lookupMin itms
-    escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
-    endkeys =
-        any
-            ((== Just InitialPress) . (`M.lookup` pkeys))
-            [ScancodeReturn, ScancodeSlash]
-    endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
-    backspacetonothing =
-        sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
-            && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
-    pkeys = u ^. uvWorld . input . pressedKeys
-
-doInputScreenInput :: String -> Universe -> Universe
-doInputScreenInput s u =
-    u & doTextInputOver (uvScreenLayers . _head . scInput)
-        & checkEndStatus
-  where
-    pkeys = u ^. uvWorld . input . pressedKeys
-    checkEndStatus
-        | ScancodeReturn `M.member` pkeys =
-            (uvScreenLayers %~ tail)
-                . applyTerminalString (words s)
-        | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail
-        | otherwise = id
-
-updateKeysInTerminal :: Int -> Universe -> Universe
-updateKeysInTerminal tmid u =
-    u & doTextInputOver tmpoint
-        & checkEndStatus
-  where
-    tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText
-    pkeys = u ^. uvWorld . input . pressedKeys
-    checkEndStatus
-        | pkeys ^. at ScancodeReturn == Just InitialPress =
-            over uvWorld (\w -> terminalReturnEffect (w ^?! cWorld . lWorld . terminals . ix tmid) w)
-        | otherwise = id
-
-updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
-updateKeyInGame uv sc pt = case pt of
-    InitialPress -> updateInitialPressInGame uv sc
-    LongPress -> updateLongPressInGame uv sc
-    _ -> uv
-
-updateInitialPressInGame :: Universe -> Scancode -> Universe
-updateInitialPressInGame uv sc = case sc of
-    ScancodeF5 -> doQuicksave uv
-    ScancodeF9 -> loadSaveSlot QuicksaveSlot uv
-    ScancodeEscape -> pauseGame uv
-    ScancodeSpace -> over uvWorld spaceAction uv
-    ScancodeP -> pauseGame uv
-    ScancodeF -> over uvWorld youDropItem uv
-    ScancodeM -> toggleMap uv
-    ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv
-    ScancodeT -> over uvWorld testEvent uv
-    ScancodeX -> uv & uvWorld %~ toggleTweakInv
-    ScancodeC -> toggleCombineInv uv
-    -- the following should be put in a more sensible place
-    ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
-    ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
-    _ -> uv
-
-updateLongPressInGame :: Universe -> Scancode -> Universe
-updateLongPressInGame uv sc = case sc of
-    ScancodeF -> over uvWorld youDropItem uv
-    ScancodeSpace -> over uvWorld spaceAction uv
-    _ -> uv
-
-updateBackspaceRegex :: World -> World
-updateBackspaceRegex w = case di ^? subInventory of
-    Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1)
-    Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2
-    Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1)
-    _ -> w
-  where
-    secfocus a b = fromMaybe False $ do
-        i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1
-        return $ i == a || i == b
-    trybackspace x sss = fromMaybe sss $ do
---        i <- fss ^? fssSections . sssSelPos . _Just . _1
---        guard (i == x || i == x+1)
-        str <- sss ^? sssExtra . sssFilters . ix x . _Just
-        return $ case str of
-            (_ : _) -> sss & sssExtra . sssFilters . ix x . _Just %~ init
-                & sssExtra . sssSelPos ?~ (x,0)
-            [] -> sss & sssExtra . sssFilters . ix x .~ Nothing
-    di = w ^. hud . hudElement
-
-updateEnterRegex :: World -> World
-updateEnterRegex w = case w ^? hud . hudElement . subInventory of
-    Just NoSubInventory
-        | secfocus (-1) 0 ->
-            w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject 
-                    .~ InInventory SortInventory
-                & hud . hudElement . diSections %~ enterregex (-1)
-    Just NoSubInventory
-        | secfocus 2 3 ->
-            w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
-                & hud . hudElement .  diSections %~ enterregex 2
-    Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1)
-            & hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos ?~ (-1,0)
-    _ -> w
-  where
-    di = w ^. hud . hudElement
-    secfocus a b = fromMaybe False $ do
-        i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1
-        return $ i == a || i == b
-    enterregex x sss = sss & sssExtra . sssFilters . ix x %~ f
-        & sssExtra . sssSelPos ?~ (x,0)
-    f Nothing = Just ""
-    f x = x
-
---overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
---overSection f sss = fromMaybe sss $ do
---    i <- sss ^? sssSelPos . _Just . _1
---    return $ sss & sssSections . ix i %~ f
-
-pauseGame :: Universe -> Universe
-pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
-
-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
-        Just (Right but) -> doButtonEvent (_btEvent but) but w
-        _ -> w
-    DisplayInventory{_subInventory = DisplayTerminal{}} ->
-        w & hud . hudElement . subInventory .~ NoSubInventory
-    _ -> w & hud . hudElement . subInventory .~ NoSubInventory
-  where
-    theLoc = doWorldPos 
-        (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) 
-        w
-
-toggleMap :: Universe -> Universe
-toggleMap u = case u ^?! uvWorld . hud . hudElement of
-    DisplayCarte -> u & uvWorld . hud . hudElement 
-        .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections}
-    _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
-
-toggleTweakInv :: World -> World
-toggleTweakInv w = case w ^? hud . hudElement . subInventory of
-    Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
-    _ -> w & thepointer .~ ExamineInventory mi
-  where
-    thepointer = hud . hudElement . subInventory
-    mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
-
-optionScreenUpdate ::
-    ScreenLayer ->
-    PositionedMenuOption ->
-    OptionScreenFlag ->
-    ListDisplayParams ->
-    SelectionList (Universe -> Universe) ->
-    Universe ->
-    Universe
-optionScreenUpdate screen mop _ ldps sl u =
-    refreshOptionsSelectionList
-        . optionScreenDefaultEffect mop
-        . mouseClickOptionsList screen
-        . mouseOverSelectionList ldps sl
-        . menuWheelEvents
-        . over (uvScreenLayers . _head) (setSelectionListRestriction cfig)
-        $ u
-  where
-    cfig = u ^. uvConfig
-
-optionScreenDefaultEffect :: PositionedMenuOption -> Universe -> Universe
-optionScreenDefaultEffect f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of
-    Just InitialPress -> fromMaybe id (f ^? pmoMenuOption . moEff) u
-    _ -> u
-
-mouseClickOptionsList :: ScreenLayer -> Universe -> Universe
-mouseClickOptionsList screen u = fromMaybe u $ do
-    sl <- screen ^? scSelectionList
-    Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
-        Just False -> fromMaybe u $ do
-            i <- sl ^. slSelPos
-            f <- sl ^? slItems . ix i . siPayload
-            return $ f u
-        _ -> u
-
-mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
-mouseOverSelectionList ldps sl u
-    | x > xl && x < xr
-        && ylower == yupper
-        && mmoving
-        && ylower >= 0
-        && ylower < ymax
-        && isselectable =
-        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
-    | otherwise = u
-  where
-    isselectable =
-        fromMaybe False $
-            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
-    ymax = maybe 0 length $ sl ^? slItems
-    mmoving = u ^. uvWorld . input . mouseMoving
-    ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
-    yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
-    xl = _ldpPosX ldps - hw
-    --xr = xl + _ldpScale ldps * 15 * 9
-    xr = xl + _ldpScale ldps * 26 * 9
-    V2 x y = u ^. uvWorld . input . mousePos
-    cfig = u ^. uvConfig
-    hh = halfHeight cfig
-    hw = halfWidth cfig
-
-menuWheelEvents :: Universe -> Universe
-menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y)))
-  where
-    y = u ^. uvWorld . input . scrollAmount
-
--- you probably want i to be 1 or -1
-menuWheelStep :: Int -> Universe -> Universe
-menuWheelStep i u = fromMaybe u $ do
-    sl <- u ^? uvScreenLayers . _head . scSelectionList
-    selpos <- sl ^? slSelPos . _Just
-    ymax <- fmap length (sl ^? slItems)
-    let newpos = (selpos - i) `mod` ymax
-    itm <- sl ^? slItems . ix newpos
-    let newu = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ const newpos
-    if _siIsSelectable itm
-        then Just newu
-        else Just $ menuWheelStep i newu
-
-setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer
-setSelectionListRestriction cfig screen = fromMaybe screen $ do
-    ldps <- screen ^? scListDisplayParams
-    return $ screen & scAvailableLines %~ const (getAvailableListLines ldps cfig)
-
-updatePressedButtonsCarte :: World -> World
-updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
-
-updatePressedButtonsCarte' :: M.Map MouseButton Bool -> World -> World
-updatePressedButtonsCarte' pkeys w
-    | isDown ButtonRight =
-        w
-            & input . clickMousePos .~ _mousePos (_input w)
-            & hud . carteCenter %~ (-.- trans)
-    | isDown ButtonLeft =
-        w
-            & input . clickMousePos .~ _mousePos (_input w)
-            & hud . carteRot -~ rot
-            & hud . carteZoom *~ czoom
-    | otherwise = w
-  where
-    isDown but = but `M.member` pkeys
-    rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
-    czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w))
-    trans = rotateV (w ^. hud . carteRot) 
-        $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))