Partially working scrolling below list to floor items

2021-12-01 00:04:54 +00:00
parent 42d7ca3ba8
commit 0ed260c9b7
4 changed files with 99 additions and 56 deletions
@@ -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
@@ -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.List
+import Data.Maybe
+--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
-  where 
+    & 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)
@@ -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
@@ -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