From bb72ec9baa01cfdeba13d5158e110078c9819b79 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 16 Jan 2023 00:16:12 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Combine.hs | 55 +++++----------------------------- src/Dodge/Render/HUD.hs | 16 +++++----- src/Dodge/Render/List.hs | 15 ++++++++++ src/Dodge/Update/Scroll.hs | 1 - src/Dodge/Update/UsingInput.hs | 6 ++-- src/SelectionIntMap.hs | 12 ++++++-- 6 files changed, 45 insertions(+), 60 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 0368bcb18..48ce821e2 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -1,9 +1,5 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Combine ( - combinePoss, - combineSizes, - combineItemListYou, - combineListInfo, toggleCombineInv, enterCombineInv, combineListSelection, @@ -18,14 +14,13 @@ import qualified Data.IntSet as IS import Control.Lens import Control.Monad import Data.Bifunctor -import Data.List (scanl', sortOn) +import Data.List (sortOn) import Data.Map.Merge.Strict import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base.You import Dodge.Combine.Trie import Dodge.Data.World -import Dodge.Inventory.ItemSpace import Dodge.Item.Amount import Dodge.Module import qualified IntMapHelp as IM @@ -51,7 +46,12 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv g (amount, i) = replicate (_getItAmount amount) i combineList :: World -> [SelectionItem CombinableItem] -combineList = map f . combineListInfo +combineList w = case combineList' w of + [] -> [SelectionInfo ["No possible combinations"] 1 False 0 white 0] + xs -> xs + +combineList' :: World -> [SelectionItem CombinableItem] +combineList' = map f . combineListInfo where f (is,(strs,itm)) = SelectionItem { _siPictures = itemDisplay itm @@ -69,9 +69,6 @@ combineListInfo w = filter f . map (cmm inv) $ combineItemListYouX w inv = yourInv w f (is,(_,itm)) = _itType itm `notElem` fmap _itType (IM.restrictKeys inv (IS.fromList is)) -combineItemListYou :: World -> [([Int], Item)] -combineItemListYou = map (second snd) . combineListInfo - cmm :: IM.IntMap Item -> ([Int], Item) -> ([Int], ([String], Item)) cmm inv (is, itm) = (is, itm & itType . iyModules %%~ flip combineModuleMaps mms) where @@ -114,13 +111,7 @@ enterCombineInv :: World -> World enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory (combineListSelection w mi "" False) where - mi = 0 <$ listToMaybe (combineItemListYou w) - -combineSizes :: World -> [Int] -combineSizes = map (itSlotsTaken . snd) . combineItemListYou - -combinePoss :: World -> [Int] -combinePoss = scanl' (+) 0 . combineSizes + mi = 0 <$ listToMaybe (combineList w) combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionIntMap CombinableItem combineListSelection w mi regex x = SelectionIntMap @@ -132,28 +123,6 @@ combineListSelection w mi regex x = SelectionIntMap , _smShownItems = IM.fromAscList $ zip [0..] (combineList w) } -combineListSelectionItems :: World -> [SelectionItem ()] -combineListSelectionItems w = case combineListSelectionItems' w of - [] -> [SelectionItem [thetext] 1 False (length thetext) white 0 ()] - xs -> xs - where - thetext = "NO POSSIBLE COMBINATIONS" - -combineListSelectionItems' :: World -> [SelectionItem ()] -combineListSelectionItems' = map (picsToSelectable 15 . itemText . snd) . combineItemListYou - -combineToSelectionItem :: Int -> [String] -> SelectionItem () -combineToSelectionItem wdth pics = - SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - , _siWidth = wdth - , _siColor = white - , _siOffX = 0 - , _siPayload = () - } - picsToSelectable :: Int -> [String] -> SelectionItem () picsToSelectable wdth pics = SelectionItem @@ -165,11 +134,3 @@ picsToSelectable wdth pics = , _siOffX = 0 , _siPayload = () } - -itemText :: Item -> [String] -{-# INLINE itemText #-} -itemText it = f $ case _itCurseStatus it of - UndroppableIdentified -> itemDisplay it - _ -> itemDisplay it - where - f = take (itSlotsTaken it) . (++ replicate 10 "*") diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index fba59d664..a09eb0078 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,6 +3,8 @@ module Dodge.Render.HUD ( drawHUD, ) where +import SelectionIntMap +import Dodge.Data.Combine import Dodge.Default.SelectionList import Dodge.Combine import Dodge.Creature.Info @@ -90,7 +92,7 @@ drawSubInventory subinv cfig w = case subinv of cfig ("COMBINE") sl - <> combineInventoryExtra mi cfig w + <> combineInventoryExtra sl mi cfig w titledSub :: Configuration -> String -> SelectionList a -> Picture titledSub cfig subtitle subitems = @@ -180,20 +182,20 @@ examineInventoryExtra mtweaki mitm cfig = -- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) ] -combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture -combineInventoryExtra mi cfig w = +combineInventoryExtra :: SelectionIntMap CombinableItem -> Maybe Int -> Configuration -> World -> Picture +combineInventoryExtra sm mi cfig w = pictures [ fromMaybe mempty $ do i <- mi - cpos <- combinePoss w !? i - col <- (combineItemListYou w !? i) <&> _itInvColor . snd + let cpos = getIthPos i (sm ^. smShownItems) + col <- sm ^? smShownItems . ix i . siColor return $ pictures [ fromMaybe mempty $ do - strs <- fmap (fst . snd) (combineListInfo w !? i) + strs <- sm ^? smShownItems . ix i . siPayload . ciInfo return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs , fromMaybe mempty $ do - lnks <- map fst (combineItemListYou w) !? i + lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs return $ lnkMidPosInvSelsCol cfig w cpos col lnks <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index bcd608727..2cb21ffbc 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,5 +1,6 @@ module Dodge.Render.List where +import SelectionIntMap import qualified Data.IntMap.Strict as IM --import Data.Foldable import Dodge.SelectionList @@ -63,6 +64,20 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do FixedSelectionWidth x -> x _ -> 1 +drawCursorAt' :: ListDisplayParams -> Configuration -> Int -> IM.IntMap (SelectionItem a) -> Picture +drawCursorAt' ldps cfig i lis = fromMaybe mempty $ do + selit <- lis IM.!? i + f <- case _ldpCursorType ldps of + BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps + NoCursor -> Nothing + let j = getIthPos i lis + col = _siColor selit + return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit) + where + wdth = case _ldpWidth ldps of + FixedSelectionWidth x -> x + _ -> 1 + drawSelectionMapCursor :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture drawSelectionMapCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. smSelPos) (IM.elems $ _smShownItems sl) diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index feb5561da..555e1f597 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -3,7 +3,6 @@ module Dodge.Update.Scroll ( ) where import SelectionIntMap -import Dodge.SelectionList import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 07511048d..69fb7a923 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -3,11 +3,11 @@ module Dodge.Update.UsingInput ( updateUsingInput, ) where +import Dodge.Data.Combine import Dodge.Data.SelectionList import Control.Lens import qualified Data.Map.Strict as M import Dodge.Base.You -import Dodge.Combine import Dodge.Creature.Impulse.UseItem import Dodge.Data.World import Dodge.InputFocus @@ -78,9 +78,9 @@ pressedMBEffectsNoInventory pkeys w -- note "sort" on the inventory indices; otherwise -- lower items may be shifted up and items below these removed instead doCombine :: Int -> World -> World -doCombine i w = case combineItemListYou w ^? ix i of +doCombine i w = case w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of Nothing -> w - Just (is, it) -> + Just (CombinableItem is it _) -> -- set (hud . hudElement) (DisplayInventory NoSubInventory) selectinv --enterCombineInv . createPutItem it diff --git a/src/SelectionIntMap.hs b/src/SelectionIntMap.hs index 99ac6bd93..874e97181 100644 --- a/src/SelectionIntMap.hs +++ b/src/SelectionIntMap.hs @@ -30,7 +30,7 @@ moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a moveSelectionMapStep x sm = fromMaybe sm $ do i <- _smSelPos sm (n,_) <- IM.lookupMax (sm ^. smShownItems) - let j = (i + x) `mod` (n + 1) + let j = (i - x) `mod` (n + 1) case sm ^? smShownItems . ix j . siIsSelectable of Just True -> Just $ sm & smSelPos ?~ j _ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j) @@ -38,6 +38,14 @@ moveSelectionMapStep x sm = fromMaybe sm $ do moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a moveSelectionMapSelection i sm = foldl' (&) - sm + sm (replicate (abs i) (moveSelectionMapStep (signum i))) +getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int +getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm + +getIthYOffset :: Float -> Float -> SelectionIntMap a -> Int -> Float +getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1) + where + yint = getIthPos i (sm ^. smShownItems) +