diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 947b7b1bf..d03bdcacb 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -116,7 +116,7 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem -updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [filt,combs] +updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt] where availablelines = getAvailableListLines secondColumnParams cfig filt = (-1, (filtsec,filtitems)) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 3e0a367a7..741ace977 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,5 +1,6 @@ module Dodge.Default.World where +import Control.Lens import Dodge.Data.SelectionList import Data.Graph.Inductive.Graph hiding ((&)) import qualified Data.Map as M @@ -151,7 +152,7 @@ defaultDisplaySections = SelectionSections defaultHUD :: HUD defaultHUD = HUD - { _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultDisplaySections} + { _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultInvSections} , _carteCenter = V2 0 0 , _carteZoom = 0.5 , _carteRot = 0 @@ -170,3 +171,48 @@ defaultHUD = -- } -- where -- f (V2 x y) = V3 x y 100 + +defaultInvSections :: SelectionSections () +defaultInvSections = SelectionSections + { _sssSections = IM.fromDistinctAscList $ zip [-1..] + [ defaultFiltSection + , defaultInvSection + , defaultYouSection + , defaultFiltSection + , defaultCOSection + ] + , _sssSelPos = Nothing + } +defaultSS :: SelectionSection a +defaultSS = SelectionSection + { _ssItems = mempty + , _ssCursor = Nothing + , _ssMinSize = 10 + , _ssOffset = 0 + , _ssShownItems = [] + , _ssIndent = 0 + , _ssDescriptor = "" + } + + +defaultCOSection :: SelectionSection () +defaultCOSection = defaultSS + & ssIndent .~ 2 + & ssDescriptor .~ "CLOSE OBJECTS" + +defaultFiltSection :: SelectionSection a +defaultFiltSection = defaultSS + & ssIndent .~ 0 + & ssDescriptor .~ "INV" + & ssMinSize .~ 0 + +defaultInvSection :: SelectionSection () +defaultInvSection = defaultSS + & ssDescriptor .~ "INVENTORY ITEMS" + +defaultYouSection :: SelectionSection () +defaultYouSection = defaultSS +-- & ssRegex .~ UnavailableRegex + & ssIndent .~ 2 + & ssMinSize .~ 1 + & ssDescriptor .~ "YOUR STATUS" diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index f59d374a5..fb428f0cb 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -26,34 +26,29 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of - Just (InInventory SortInventory) -> sss - { _sssSections = updateSections availablelines (-1,0) [filtinv,filtclose,invx ,youx, closex] - , _sssSelPos = Just (-1) - } - Just (InInventory (SelItem i _)) -> sss - { _sssSections = updateSections availablelines (0,i) [filtinv,filtclose,invx ,youx, closex] - , _sssSelPos = Just 0 - } - Just SelNothing -> sss - { _sssSections = updateSections availablelines (1,0) [filtinv,filtclose,invx ,youx, closex] - , _sssSelPos = Just 1 - } - Just (InNearby SortNearby) -> sss - { _sssSections = updateSections availablelines (2,0) [filtinv,filtclose,closex, invx ,youx] - , _sssSelPos = Just 2 - } - Just (InNearby (SelCloseObject i)) -> sss - { _sssSections = updateSections availablelines (3,i) [filtinv,filtclose,closex, invx ,youx] - , _sssSelPos = Just 3 - } +-- Just mo -> sss +-- { _sssSections = updateSections availablelines (manObjIndex mo) $ addorder mo +-- , _sssSelPos = Just (fst $ manObjIndex mo) +-- } + Just mo -> updateSectionsPositioning sss + { _sssSelPos = Just (fst $ manObjIndex mo) + } availablelines (manObjIndex mo) $ addorder mo _ -> error "error when getting cr inv sel" where - filtinv = (-1,(filtinvsec,filtinvitems)) + addorder mo = case mo of + InInventory SortInventory -> reverse [filtinv,filtclose,invx ,youx, closex] + InInventory SelItem{} -> reverse [filtinv,filtclose,invx ,youx, closex] + SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex] + InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx] + InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx] +-- filtinv = (-1,(filtinvsec,filtinvitems)) + filtinv = (-1,filtinvitems) filtinvsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1) filtinvitems = case cr ^? crManipulation . invRegex . _Just of Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0) Nothing -> mempty - filtclose = (2,(filtclosesec,filtcloseitems)) + --filtclose = (2,(filtclosesec,filtcloseitems)) + filtclose = (2,filtcloseitems) filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2) $ sss ^? sssSections . ix 2 filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of @@ -63,13 +58,16 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of numfiltitems' = length invitems' - length invitems numfiltclose = " " ++ show numfiltclose' ++ " FILTERED" numfiltclose' = length coitems' - length coitems - invx = (0,(invsec, invitems)) - youx = (1,(yousec, youitems)) - closex = (3,(cosec, coitems)) + invx = (0, invitems) + --invx = (0,(invsec, invitems)) + youx = (1, youitems) + --youx = (1,(yousec, youitems)) + --closex = (3,(cosec, coitems)) + closex = (3, coitems) youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots nfreeslots availablelines = getAvailableListLines (invDisplayParams w) cfig - cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2 + cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 3 invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0 coitems' = IM.fromDistinctAscList . zip [0..] $ map closeObjectToSelectionItem (w ^. hud . closeObjects) @@ -90,42 +88,41 @@ displayFreeSlots x = case x of 1 -> "1 FREE SLOT" _ -> show x ++ " FREE SLOTS" + +updateSectionsPositioning + :: SelectionSections a + -> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))] + -> SelectionSections a +updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty +updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs) + = previoussections & sssSections %~ IM.insert k ss + where + ss | i == k = updateSection (Just j) y linesleft x + | otherwise = updateSection Nothing y linesleft x + x = sss ^?! sssSections . ix k + availablelines = allavailablelines - _ssMinSize x + linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ _sssSections previoussections) + previoussections = updateSectionsPositioning sss availablelines (i,j) xs + updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))] -> IM.IntMap (SelectionSection a) updateSections _ _ [] = mempty -updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss - $ updateSections (allavailablelines - length (_ssShownItems ss)) (i,j) xs +updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections where - ss | i == k = updateSection (Just j) y availablelines x - | otherwise = updateSection Nothing y availablelines x - availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs) - -defaultSS :: SelectionSection a -defaultSS = SelectionSection - { _ssItems = mempty - , _ssCursor = Nothing - , _ssMinSize = 5 - , _ssOffset = 0 - , _ssShownItems = [] - , _ssIndent = 0 - , _ssDescriptor = "" - } + ss | i == k = updateSection (Just j) y linesleft x + | otherwise = updateSection Nothing y linesleft x + availablelines = allavailablelines - _ssMinSize x + linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections) + previoussections = updateSections availablelines (i,j) xs -defaultCOSection :: SelectionSection () -defaultCOSection = defaultSS - & ssIndent .~ 2 - & ssDescriptor .~ "CLOSE OBJECTS" - -defaultFiltSection :: SelectionSection a -defaultFiltSection = defaultSS - & ssIndent .~ 0 - & ssDescriptor .~ "INV" - & ssMinSize .~ 0 - -defaultInvSection :: SelectionSection () -defaultInvSection = defaultSS - & ssDescriptor .~ "INVENTORY ITEMS" +manObjIndex :: ManipulatedObject -> (Int,Int) +manObjIndex mo = case mo of + InInventory SortInventory -> (-1, 0) + InInventory (SelItem i _) -> (0, i) + SelNothing -> (1,0) + InNearby SortNearby -> (2,0) + InNearby (SelCloseObject i) -> (3,i) updateSection :: Maybe Int @@ -133,60 +130,54 @@ updateSection -> Int -> SelectionSection a -> SelectionSection a -updateSection mspos sis' availablelines ss = ss +updateSection mcsel sis availablelines ss = ss { _ssItems = sis , _ssCursor = scurs , _ssOffset = offset , _ssShownItems = shownitems } where - sis = sis' oldoffset = ss ^. ssOffset scurs = do - csel <- mspos + csel <- mcsel si <- sis ^? ix csel let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis) csize = length $ _siPictures si ccolor = _siColor si return $ SectionCursor csel (cpos - offset) csize ccolor - mcpos = do - csel <- mspos - return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis - xselsize = fromMaybe 1 selsize - offset = maybe 0 offset' mcpos - offset' jselpos - | jselpos == 0 || not mustrestrict = 0 - | jselpos - 1 < oldoffset = jselpos - 1 - | islastitm = jselpos - availablelines + xselsize - | jselpos + 1 + xselsize - availablelines > oldoffset = jselpos - availablelines + 1 + xselsize - | length allstrings - oldoffset < availablelines = length allstrings - availablelines - | otherwise = oldoffset + offset = fromMaybe oldoffset $ do + csel <- mcsel + maxcsel <- fst <$> IM.lookupMax sis + si <- sis ^? ix csel + let xselsize = length $ _siPictures si + return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of + pos | pos == 0 || length allstrings <= availablelines + -> 0 + pos | pos - 1 < oldoffset + -> pos - 1 + pos | maxcsel == csel + -> pos - availablelines + xselsize + pos | pos + 1 + xselsize - availablelines > oldoffset + -> pos - availablelines + 1 + xselsize + _ | length allstrings - oldoffset < availablelines + -> length allstrings - availablelines + _ -> oldoffset tweakfirst (x:xs) - | offset > 0 = hup : map h xs + | offset > 0 = xtra "<<<" : map h xs | otherwise = map h (x:xs) tweakfirst [] = [] shownitems | length shownstrings > availablelines = tweakfirst (take (availablelines - 1) shownstrings) - ++ [hdown] + ++ [xtra ">>>"] | otherwise = tweakfirst shownstrings allstrings :: [(Color,String)] allstrings = foldMap g sis - mustrestrict = length allstrings > availablelines shownstrings = drop offset allstrings h (col,str) = color col . text $ theindent ++ str theindent = replicate (_ssIndent ss) ' ' - hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss - hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss + xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss g si = map (_siColor si ,) $ _siPictures si - islastitm = fromMaybe False $ do - i <- mspos - k <- fst <$> IM.lookupMax sis - return $ k == i - selsize = do - i <- mspos - si <- sis ^? ix i - return . length $ _siPictures si yousec :: SelectionSection () yousec = defaultSS @@ -195,3 +186,4 @@ yousec = defaultSS & ssIndent .~ 2 & ssMinSize .~ 1 & ssDescriptor .~ "YOUR STATUS" + diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs new file mode 100644 index 000000000..fccf94e3f --- /dev/null +++ b/src/Dodge/SelectionSections.hs @@ -0,0 +1,104 @@ +module Dodge.SelectionSections where + +import Data.Maybe +import Control.Lens +import qualified Data.IntMap.Strict as IM +import Dodge.Data.SelectionList + +scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a +scrollSelectionSections yi sss + | yi == 0 = sss + | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections + | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections + +firstPosSelectionSections :: SelectionSections a -> SelectionSections a +firstPosSelectionSections sss = fromMaybe sss $ do + (i,j,si) <- ssLookupMin sss + return $ sss + & sssSelPos ?~ i + & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) + + +scrollUpSelectionSections :: SelectionSections a -> SelectionSections a +scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do + i <- sss ^? sssSelPos . _Just + j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel + (i',j',si) <- ssLookupUp i j sss + return $ sss & sssSelPos ?~ i' + & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) + +scrollDownSelectionSections :: SelectionSections a -> SelectionSections a +scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do + i <- sss ^? sssSelPos . _Just + j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel + (i',j',si) <- ssLookupDown i j sss + return $ sss & sssSelPos ?~ i' + & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) + +ssSetCursor :: (SelectionSections a -> Maybe (Int,Int,SelectionItem a)) + -> SelectionSections a -> SelectionSections a +ssSetCursor f sss = fromMaybe sss $ do + (i,j,si) <- f sss + return $ sss + & sssSelPos ?~ i + & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) + +ssLookupMax :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupMax sss = do + (i,_) <- IM.lookupMax (sss ^. sssSections) + ssLookupLE' i sss + +ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupUp i j sss = case ssLookupLT i j sss of + Nothing -> ssLookupMax sss + x -> x + +ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupDown i j sss = case ssLookupGT i j sss of + Nothing -> ssLookupMin sss + x -> x + +ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do + ss <- sss ^? sssSections . ix i + (j',si) <- IM.lookupLT j (ss ^. ssItems) + return $ Just (i,j',si) + +ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupLT' i sss = do + (i',ss) <- IM.lookupLT i (sss ^. sssSections) + case IM.lookupMax (ss ^. ssItems) of + Just (j',si) -> return (i',j',si) + Nothing -> ssLookupLT' i' sss + +ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupLE' i sss = do + (i',ss) <- IM.lookupLE i (sss ^. sssSections) + case IM.lookupMax (ss ^. ssItems) of + Just (j',si) -> return (i',j',si) + Nothing -> ssLookupLT' i' sss + +ssLookupMin :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupMin sss = do + (i,_) <- IM.lookupMin (sss ^. sssSections) + ssLookupGE' i sss + +ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do + ss <- sss ^? sssSections . ix i + (j',si) <- IM.lookupGT j (ss ^. ssItems) + return $ Just (i,j',si) + +ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupGT' i sss = do + (i',ss) <- IM.lookupGT i (sss ^. sssSections) + case IM.lookupMin (ss ^. ssItems) of + Just (j',si) -> return (i',j',si) + Nothing -> ssLookupGT' i' sss + +ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a) +ssLookupGE' i sss = do + (i',ss) <- IM.lookupGE i (sss ^. sssSections) + case IM.lookupMin (ss ^. ssItems) of + Just (j',si) -> return (i',j',si) + Nothing -> ssLookupGT' i' sss diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 1f9c15776..b20559976 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -6,6 +6,7 @@ module Dodge.Update.Input ( doRegexInput, ) where +import Dodge.Default.World import Data.Char import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M @@ -256,7 +257,7 @@ spaceAction w = case w ^?! hud . hudElement of toggleMap :: Universe -> Universe toggleMap u = case u ^?! uvWorld . hud . hudElement of DisplayCarte -> u & uvWorld . hud . hudElement - .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultDisplaySections} + .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections} _ -> u & uvWorld . hud . hudElement .~ DisplayCarte toggleTweakInv :: World -> World