Partially working scrolling below list to floor items

src/Dodge/Event.hs

@@ -110,7 +110,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
             Nothing -> closeObjScrollDir y w
             Just f  -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
         | lbDown -> w & cameraZoom +~ y
-        | invKeyDown -> swapInvDir yi $ stopSoundFrom (CrReloadSound 0) $ changeInvPos yi w
+        | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvPos yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeInvCloseObjectsPos yi w
     (_, TweakInventory)
         | invKeyDown && rbDown -> w & moveTweakSel yi

src/Dodge/Inventory.hs

@@ -1,14 +1,20 @@
 module Dodge.Inventory
     ( checkInvSlotsYou
     , rmSelectedInvItem
+    , invSelPos
+    , invSelSize
+    , selNumPos
+    , augmentedInvSizes
     , rmInvItem
     , updateCloseObjects
     , closeObjScrollDir
     , swapInvDir
     , changeInvPos
+    , changeSwapInvPos
     , changeInvCloseObjectsPos
     , crNumFreeSlots
     , crInvSize
+    , selectedCloseObject
     )
     where
 import Dodge.Data
@@ -18,9 +24,10 @@ import Geometry
 --import FoldableHelp
 import Padding
 import qualified IntMapHelp as IM
+import ListHelp
 
---import Data.Maybe
+import Data.Maybe
-import Data.List
+--import Data.List
 --import System.Random
 import Control.Lens
 
@@ -66,9 +73,40 @@ rmSelectedInvItem
     -> World
 rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
 
+augmentedInvSizes :: World -> IM.IntMap Int
+augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w)
+    (IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w)
+
+invSelSize :: Int -> World -> Int
+invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
+
+closeObjectSize :: Either FloorItem Button -> Int
+closeObjectSize e = case e of
+    Left flit -> _itInvSize $ _flIt flit
+    Right _  -> 1
+
+selNumPos :: Int -> World -> Int
+selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w))
+  where
+    splitgap
+        | yourInvSel w < length (yourInv w) = 0
+        | otherwise = 1
+
+invSelPos :: World -> Int
+invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w))
+  where
+    invsel = yourInvSel w
+    splitgap
+        | yourInvSel w < length (yourInv w) = 0
+        | otherwise = 1
+
 updateCloseObjects :: World -> World
 updateCloseObjects w = w & closeObjects .~ unionBy eTest oldCloseFiltered currentClose
+    & creatures . ix 0 . crInvSel %~ updateinvsel
   where
+    updateinvsel curinvsel
+        | length (augmentedInvSizes w) <= curinvsel = length (augmentedInvSizes w) - 1
+        | otherwise = curinvsel
     filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
     ypos = _crPos $ you w
     objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
@@ -94,7 +132,8 @@ closeObjScrollDir x
 swapInvDir :: Int -> World -> World
 swapInvDir k w 
     | n == 0    = w
-    | otherwise = w & creatures . ix (_yourID w) %~ updatecreature
+    | i < n = w & creatures . ix (_yourID w) %~ updatecreature
+    | otherwise = w
   where
     updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
         . (crLeftInvSel . _Just %~ updateLeftInvSel)
@@ -103,14 +142,41 @@ swapInvDir k w
         | swapi == li = i
         | otherwise = li
     i = _crInvSel $ you w
-    n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
+    n = length $ _crInv $ _creatures w IM.! _yourID w
+    --numCO = length $ _closeObjects w
 
 changeInvPos :: Int -> World -> World
 changeInvPos i w 
     | n == 0    = w
-    | otherwise =  w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
+    | yourInvSel w < n    =  w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
+    | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (i+n))
   where 
-    n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
+    n = length $ _crInv $ _creatures w IM.! _yourID w
+    numCO = length $ _closeObjects w
+
+changeSwapInvPos :: Int -> World -> World
+changeSwapInvPos k w 
+    | n == 0    = w
+    | yourInvSel w < n    =  w 
+        & creatures . ix (_yourID w) %~ updatecreature
+        & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract k
+--    | otherwise = w & creatures . ix (_yourID w) . crInvSel %~ ((+n) . (`mod` numCO) . subtract (k+n))
+    | otherwise = w & creatures . ix (_yourID w) . crInvSel .~ ico'
+        & closeObjects %~ listSwapIndices (i - n) (ico' - n)
+  where 
+    updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi )
+        . (crLeftInvSel . _Just %~ updateLeftInvSel)
+    swapi = (i - k) `mod` n
+    updateLeftInvSel li | i == li = swapi
+        | swapi == li = i
+        | otherwise = li
+    i = _crInvSel $ you w
+    ico' = ( (i - (k+n)) `mod` numCO ) + n
+    n = length $ _crInv $ _creatures w IM.! _yourID w
+    numCO = length $ _closeObjects w
+
+listSwapIndices :: Int -> Int -> [a] -> [a]
+listSwapIndices i j xs = insertOver i (xs !! j) . insertOver j (xs !! i) $ xs
 
 changeInvCloseObjectsPos :: Int -> World -> World
 changeInvCloseObjectsPos i w 
@@ -118,3 +184,19 @@ changeInvCloseObjectsPos i w
     | otherwise =  w & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
   where 
     n = (length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w) + length (_closeObjects w)
+
+bestCloseObjectIndex :: World -> Maybe Int
+bestCloseObjectIndex w = Nothing
+
+selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
+selectedCloseObject w
+    | invsel >= length inv = Just $ selectNthCloseObject w (invsel - length inv)
+    | otherwise = fmap (selectNthCloseObject w) $ bestCloseObjectIndex w
+  where
+    invsel = _crInvSel cr
+    cr = you w
+    inv = _crInv cr
+    invsize = crInvSize (you w)
+
+selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button)
+selectNthCloseObject w n = (length (yourInv w) + n, _closeObjects w !! n)

src/Dodge/Render/HUD.hs

@@ -51,37 +51,6 @@ subInventoryDisplay cfig w = case _inventoryMode w of
     col = itCol it
     cursPos = invSelPos w
 
---crInvSelSize :: Creature -> Int
---crInvSelSize cr = fromMaybe 1 $ fmap _itInvSize $ _crInv cr IM.!? _crInvSel cr
-
---crInvSelPos :: Creature -> Int
---crInvSelPos cr = foldl' (+) 0 . fmap _itInvSize . fst $ IM.split (_crInvSel cr) (_crInv cr)
-
-invSelPos :: World -> Int
-invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSizes w))
-  where
-    invsel = yourInvSel w
-    splitgap
-        | yourInvSel w < length (yourInv w) = 0
-        | otherwise = 1
-
-augmentedInvSizes :: World -> IM.IntMap Int
-augmentedInvSizes w = IM.union (fmap _itInvSize $ yourInv w)
-    (IM.fromAscList $ zip [length (yourInv w) ..] $ map closeObjectSize $ _closeObjects w)
---augmentedInvSizesWithGap :: World -> IM.IntMap Int
---augmentedInvSizesWithGap w = IM.union (safeUpdateMax (Just . (+1)) $ fmap _itInvSize $ yourInv w)
---    (IM.fromAscList $ zip [length (yourInv w) ..] $ (map closeObjectSize $ _closeObjects w))
---
---safeUpdateMax :: (a -> Maybe a) -> IM.IntMap a -> IM.IntMap a
---safeUpdateMax f m 
---    | IM.null m = m
---    | otherwise = IM.updateMax f m
-
-closeObjectSize :: Either FloorItem Button -> Int
-closeObjectSize e = case e of
-    Left flit -> _itInvSize $ _flIt flit
-    Right bt  -> 1
-
 cursorsZ :: Configuration -> Int -> Maybe Item -> Picture
 cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of
     Nothing   -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5))
@@ -133,10 +102,14 @@ displayInv :: Int -> Configuration -> World -> Picture
 displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist
     <> equipcursor
     <> selcursor
+    <> closeobjectcursor
   where
     selcursor 
         | IM.null inv && null (_closeObjects w) = mempty
         | otherwise   = listCursorAt 0 0 cfig curpos white curx cury
+    closeobjectcursor = case selectedCloseObject w of
+        Nothing -> mempty
+        Just (i,_) -> listCursorAt 50 0 cfig (selNumPos i w) blue 15 (invSelSize i w)
     inv = _crInv cr
     invlist = (concatMap itemToTextPictures $ IM.elems inv) 
         ++ displayFreeSlots ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
@@ -147,11 +120,10 @@ displayInv n cfig w = listTextPicturesAt 0 0 cfig invlist
         x -> [color invDimColor . text $ "  +" ++ show x ++ " FREE SLOTS"]
     curpos = invSelPos w
     curx   = 10
-    --cury   = crInvSelSize $ you w
     cury   = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
     equipcursor = case _crLeftInvSel cr of
         Nothing -> mempty
-        Just invid -> openCursorAt 20 yellow 0 0 invid cfig
+        Just invid -> openCursorAt 20 yellow 0 0 (selNumPos invid w) cfig
     cr = _creatures w IM.! n
 invDimColor :: Color
 invDimColor = greyN 0.7
@@ -201,21 +173,6 @@ mapWall cfig w wl =
     (x,y) = _wlLine wl
     c = _wlColor wl
 
-bestCloseObjectIndex :: World -> Maybe Int
-bestCloseObjectIndex w = Nothing
-
-selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
-selectedCloseObject w
-    | invsel > length inv = Just $ selectNthCloseObject w (invsel - length inv)
-    | otherwise = fmap (selectNthCloseObject w) $ bestCloseObjectIndex w
-  where
-    invsel = _crInvSel cr
-    cr = you w
-    inv = _crInv cr
-    invsize = crInvSize (you w)
-
-selectNthCloseObject :: World -> Int -> (Int,Either FloorItem Button)
-selectNthCloseObject w n = undefined
 
 selectedCloseObjectLink :: Configuration -> World -> Picture
 selectedCloseObjectLink cfig w = mempty

src/ListHelp.hs

@@ -1,9 +1,13 @@
 module ListHelp 
     (module Data.List
     ,initOrNull
+    , insertOver
     )where
 import Data.List
 
 initOrNull :: [a] -> [a]
 initOrNull [] = []
 initOrNull xs = init xs
+
+insertOver :: Int -> a -> [a] -> [a]
+insertOver i x xs = take i xs ++ x : drop (i+1) xs