diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index a2cf8a5bc..abd756061 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -42,11 +42,18 @@ data SSRestriction = NoSSRestriction , _ssrOffset :: Int } +data SectionCursor = SectionCursor + { _scurPos :: Int + , _scurSize :: Int + , _scurColor :: Color + } + data SelectionSection a = SelectionSection - { _ssItems :: [SelectionItem a] - , _ssSelPos :: Maybe Int - , _ssSelSize :: Maybe Int - , _ssSelColor :: Maybe Color + { _ssItems :: IntMap (SelectionItem a) + , _ssCursor :: Maybe SectionCursor +-- , _ssSelPos :: Maybe Int +-- , _ssSelSize :: Maybe Int +-- , _ssSelColor :: Maybe Color , _ssMinSize :: Int , _ssPriority :: Int , _ssOffset :: Int @@ -97,6 +104,7 @@ makeLenses ''SelectionItem makeLenses ''SelectionIntMap makeLenses ''SelectionSection makeLenses ''SelectionSections +makeLenses ''SectionCursor makeLenses ''SSRestriction --deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/Default/SelectionList.hs b/src/Dodge/Default/SelectionList.hs index f2ea1b6dd..bec050d3d 100644 --- a/src/Dodge/Default/SelectionList.hs +++ b/src/Dodge/Default/SelectionList.hs @@ -4,7 +4,7 @@ import Dodge.Data.SelectionList defaultSelectionList :: SelectionList a defaultSelectionList = SelectionList - {_slItems = [] + {_slItems = mempty , _slSelPos = Nothing -- , _slLength = 0 , _slRegex = "" diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index c50ab7933..352525172 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -2,7 +2,7 @@ module Dodge.DisplayInventory where import Data.Maybe -import Picture.Text +--import Picture.Text import Dodge.Inventory.ItemSpace import Picture.Base import Dodge.Render.HUD @@ -20,7 +20,7 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = sss - { _sssSections = restrictsections + { _sssSections = restrictsections , _sssSelPos = mspos , _sssMaxSize = availablelines } @@ -34,12 +34,31 @@ updateDisplayInventory w cfig sss = sss SelCloseObject {} -> Just 2 availablelines = getAvailableListLines (invDisplayParams w) cfig iavailablelines = availablelines - 6 + invsection = makeInventorySection iavailablelines oldoffset w + invsectionlines = length $ _ssShownItems invsection oldoffset = sss ^? sssSections . ix 0 . ssOffset restrictsections = IM.fromList - [ (0, makeInventorySection iavailablelines oldoffset w ) + [ (0, invsection ) , (1, makeYouSection w) - , (2, makeCloseObjectsSection w) + --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w) + , (2, updateSection copos coitems (availablelines - invsectionlines - 1) w cosec) ] + cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2 + coitems = IM.fromDistinctAscList . zip [0..] + $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) + nfreeslots = fromMaybe 0 $ do + cr <- w ^? cWorld . lWorld . creatures . ix 0 + return $ crNumFreeSlots cr + copos = do + cr <- w ^? cWorld . lWorld . creatures . ix 0 + mo <- cr ^? crInvSel . isel + case mo of + SelItem {} -> Nothing + SelNothing -> Nothing + SelCloseObject i -> Just i + +defaultCOSection :: SelectionSection () +defaultCOSection = SelectionSection mempty Nothing 5 1 0 NoSSRestriction [] 2 makeDisplayInventory :: World -> Configuration -> SelectionSections () makeDisplayInventory w cfig = defaultDisplaySections @@ -57,18 +76,21 @@ makeDisplayInventory w cfig = defaultDisplaySections SelCloseObject {} -> Just 2 availablelines = getAvailableListLines (invDisplayParams w) cfig iavailablelines = availablelines - 6 + invsection = makeInventorySection iavailablelines (Just 0) w + --invsectionlines = length $ _ssShownItems invsection restrictsections = IM.fromList - [ (0, makeInventorySection iavailablelines (Just 0) w ) + [ (0, invsection ) , (1, makeYouSection w) - , (2, makeCloseObjectsSection w) + --, (2, makeCloseObjectsSection (availablelines - invsectionlines - 1) w) + , (2, defaultCOSection) ] -makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection () -makeInventorySection iavailablelines moldoffset w = SelectionSection - { _ssItems = map (invSelectionItem cr ) (IM.toList inv) - , _ssSelPos = fmap (subtract offset) selpos - , _ssSelSize = selsize - , _ssSelColor = selcolor +updateSection :: Maybe Int -> IM.IntMap (SelectionItem ()) -> Int -> World + -> SelectionSection () + -> SelectionSection () +updateSection mspos sis availablelines w ss = ss + { _ssItems = sis + , _ssCursor = scurs , _ssRestriction = NoSSRestriction , _ssPriority = 0 , _ssOffset = offset @@ -80,6 +102,77 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection , _ssShownItems = shownitems } where + moldoffset = ss ^? ssOffset + scurs = do + csel <- mspos + let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis) + csize <- selsize + ccolor <- selcolor + return $ SectionCursor cpos csize ccolor + oldoffset = fromMaybe 0 moldoffset + xselsize = fromMaybe 1 selsize + offset = maybe 0 offset' mspos + 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 + tweakfirst (x:xs) + | offset > 0 = hup : map h xs + | otherwise = map h (x:xs) + tweakfirst [] = [] + shownitems + | length shownstrings > availablelines + = tweakfirst (take (availablelines - 1) shownstrings) + ++ [hdown] + | otherwise = tweakfirst shownstrings + allstrings :: [(Color,String)] + allstrings = foldMap g sis + mustrestrict = length allstrings > availablelines + shownstrings :: [(Color,String)] + shownstrings = drop offset allstrings + cr = you w + h (col,str) = color col . text $ str + --hdown (col,str) = textGrad col (withAlpha 0 col) str + --hup (col,str) = textGrad (withAlpha 0 col) col str + hdown = color white $ text ">>> MORE INV ITEMS" + hup = color white $ text "<<< MORE INV ITEMS" + g si = map (_siColor si ,) $ _siPictures si + islastitm = fromMaybe False $ do + i <- cr ^? crInvSel . isel . ispItem + k <- fmap fst $ IM.lookupMax (_crInv cr) + return $ k == i + selsize = do + i <- mspos + si <- sis ^? ix i + return . length $ _siPictures si + selcolor = do + i <- mspos + si <- sis ^? ix i + return $ _siColor si + +makeInventorySection :: Int -> Maybe Int -> World -> SelectionSection () +makeInventorySection iavailablelines moldoffset w = SelectionSection + { _ssItems = IM.mapWithKey (invSelectionItem' cr) inv + , _ssCursor = scurs + , _ssRestriction = NoSSRestriction + , _ssPriority = 0 + , _ssOffset = offset + , _ssIndent = 0 +-- , _ssRegex = "" +-- , _ssRegexInput = False + , _ssMinSize = 5 +-- , _ssOffset = 0 + , _ssShownItems = shownitems + } + where + scurs = do + cpos <- fmap (subtract offset) selpos + csize <- selsize + ccolor <- selcolor + return $ SectionCursor cpos csize ccolor jselpos = fromMaybe 0 selpos oldoffset = fromMaybe 0 moldoffset xselsize = fromMaybe 1 selsize @@ -91,13 +184,13 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection | length allstrings - oldoffset < iavailablelines = length allstrings - iavailablelines | otherwise = oldoffset tweakfirst (x:xs) - | offset > 0 = hup x : map h xs + | offset > 0 = hup : map h xs | otherwise = map h (x:xs) tweakfirst [] = [] shownitems | length shownstrings > iavailablelines = tweakfirst (take (iavailablelines - 1) shownstrings) - ++ [hdown $ shownstrings !! (iavailablelines -1)] + ++ [hdown] | otherwise = tweakfirst shownstrings allstrings :: [(Color,String)] allstrings = foldMap (g . invSelectionItem cr ) (IM.toList inv) @@ -109,9 +202,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection h (col,str) = color col . text $ str --hdown (col,str) = textGrad col (withAlpha 0 col) str --hup (col,str) = textGrad (withAlpha 0 col) col str - hdown (col,str) = color white $ text ">>> MORE INV ITEMS" - hup (col,str) = color white $ text "<<< MORE INV ITEMS" - f si = map (color (_siColor si) . text) $ _siPictures si + hdown = color white $ text ">>> MORE INV ITEMS" + hup = color white $ text "<<< MORE INV ITEMS" g si = map (_siColor si ,) $ _siPictures si islastitm = fromMaybe False $ do i <- cr ^? crInvSel . isel . ispItem @@ -132,10 +224,8 @@ makeInventorySection iavailablelines moldoffset w = SelectionSection makeYouSection :: World -> SelectionSection () makeYouSection w = SelectionSection - { _ssItems = [SelectionItem [thetext] 1 True (length thetext) invDimColor 2 ()] - , _ssSelPos = Just 0 - , _ssSelSize = Just 1 - , _ssSelColor = Just invDimColor + { _ssItems = IM.singleton 0 $ SelectionItem [thetext] 1 True (length thetext) invDimColor 2 () + , _ssCursor = Just $ SectionCursor 0 1 invDimColor , _ssOffset = 0 , _ssPriority = 1 , _ssRestriction = NoSSRestriction @@ -154,39 +244,43 @@ makeYouSection w = SelectionSection 1 -> " +1 FREE SLOT" x -> " +" ++ show x ++ " FREE SLOTS" -makeCloseObjectsSection :: World -> SelectionSection () -makeCloseObjectsSection w = SelectionSection - { _ssItems = map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) - , _ssSelPos = selpos - , _ssSelSize = selsize - , _ssSelColor = selcolor - , _ssPriority = 1 - , _ssOffset = 0 - , _ssIndent = 2 - , _ssRestriction = NoSSRestriction --- , _ssRegex = "" --- , _ssRegexInput = False - , _ssMinSize = 5 +--makeCloseObjectsSection :: Int -> World -> SelectionSection () +--makeCloseObjectsSection cavailablelines w = SelectionSection +-- { _ssItems = IM.fromDistinctAscList . zip [0..] +-- $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) +-- , _ssCursor = scurs +-- , _ssPriority = 1 -- , _ssOffset = 0 - , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) - } - where - f si = map (color (_siColor si) . text) $ _siPictures si - cr = you w - nfreeslots = crNumFreeSlots cr - selpos = do - i <- cr ^? crInvSel . isel . ispCloseObject - return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects - selsize = do - i <- cr ^? crInvSel . isel . ispCloseObject - obj <- w ^? hud . closeObjects . ix i - return $ closeobjectsize obj - closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt) - selcolor = do - i <- cr ^? crInvSel . isel . ispCloseObject - obj <- w ^? hud . closeObjects . ix i - Just $ case obj of - Left flit -> _itInvColor $ _flIt flit - Right bt -> _btColor bt +-- , _ssIndent = 2 +-- , _ssRestriction = NoSSRestriction +---- , _ssRegex = "" +---- , _ssRegexInput = False +-- , _ssMinSize = 5 +---- , _ssOffset = 0 +-- , _ssShownItems = foldMap (f . closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) +-- } +-- where +-- scurs = do +-- cpos <- selpos +-- csize <- selsize +-- ccolor <- selcolor +-- return $ SectionCursor cpos csize ccolor +-- f si = map (color (_siColor si) . text) $ _siPictures si +-- cr = you w +-- nfreeslots = crNumFreeSlots cr +-- selpos = do +-- i <- cr ^? crInvSel . isel . ispCloseObject +-- return . sum . map closeobjectsize . take i $ w ^. hud . closeObjects +-- selsize = do +-- i <- cr ^? crInvSel . isel . ispCloseObject +-- obj <- w ^? hud . closeObjects . ix i +-- return $ closeobjectsize obj +-- closeobjectsize co = maybe 1 itSlotsTaken (co ^? _Left . flIt) +-- selcolor = do +-- i <- cr ^? crInvSel . isel . ispCloseObject +-- obj <- w ^? hud . closeObjects . ix i +-- Just $ case obj of +-- Left flit -> _itInvColor $ _flIt flit +-- Right bt -> _btColor bt diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 284d34e27..3fc6120e7 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -1,5 +1,6 @@ module Dodge.Inventory.SelectionList ( invSelectionItem + , invSelectionItem' , closeObjectToSelectionItem ) where @@ -24,6 +25,22 @@ import LensHelp -- Just CombineInventory{} -> Nothing -- _ -> Just $ yourInvSel w -- +invSelectionItem' :: Creature -> Int -> Item -> SelectionItem () +invSelectionItem' cr i it = SelectionItem + { _siPictures = pics + , _siHeight = length pics + , _siIsSelectable = True + , _siWidth = 15 + , _siColor = col + , _siOffX = 0 + , _siPayload = () + } + where + col = _itInvColor it + pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of + UndroppableIdentified -> itemDisplay it + _ | cr ^? crInvSel . isel . ispItem == Just i -> selectedItemDisplay cr it + _ -> itemDisplay it invSelectionItem :: Creature -> (Int,Item) -> SelectionItem () invSelectionItem cr (i,it) = SelectionItem { _siPictures = pics diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 1027315da..8be76a5f0 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -84,7 +84,7 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff where thecolor = fromMaybe white $ do spos <- _sssSelPos sss - sss ^? sssSections . ix spos . ssSelColor . _Just + sss ^? sssSections . ix spos . ssCursor . _Just . scurColor thecursor = fromMaybe mempty $ do sectype <- you w ^? crInvSel . isel let secnum = case sectype of @@ -94,8 +94,8 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff xint <- sss ^? sssSections . ix secnum . ssIndent spos <- _sssSelPos sss let y = sum . fmap (length . _ssShownItems) . fst . IM.split spos $ _sssSections sss - yint <- sss ^? sssSections . ix spos . ssSelPos . _Just - csize <- sss ^? sssSections . ix spos . ssSelSize . _Just + yint <- sss ^? sssSections . ix spos . ssCursor . _Just . scurPos + csize <- sss ^? sssSections . ix spos . ssCursor . _Just . scurSize return $ listCursorDisplayParams ldps [North,South,West] cfig (yint + y) xint white 15 csize ldps = invDisplayParams w pics = foldMap (_ssShownItems) (_sssSections sss) diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index 683331d44..66769ed71 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -5,6 +5,7 @@ import Regex import Dodge.Data.Universe import LensHelp import Data.Maybe +--import Data.IntMap.Strict (IntMap) getAvailableListLines :: ListDisplayParams -> Configuration -> Int getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight) @@ -17,7 +18,7 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight) getShownItems :: SelectionList a -> [SelectionItem a] getShownItems sl = case sl ^. slRegexList of [] -> sl ^. slItems - xs -> map fst xs + xs -> fmap fst xs makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)] makeRegexList sl = case sl ^. slRegex of