diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 6f3328c95..a9fa3cd1d 100644 --- a/src/Dodge/Event.hs +++ b/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 diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 3f2fd9941..6fc9983cb 100644 --- a/src/Dodge/Inventory.hs +++ b/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.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) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 5a3347d46..7460f5d00 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 diff --git a/src/ListHelp.hs b/src/ListHelp.hs index 7669c8bc1..4016bf471 100644 --- a/src/ListHelp.hs +++ b/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