This commit is contained in:
2023-01-16 00:16:12 +00:00
parent 048135c370
commit bb72ec9baa
6 changed files with 45 additions and 60 deletions
+8 -47
View File
@@ -1,9 +1,5 @@
--{-# LANGUAGE TupleSections #-} --{-# LANGUAGE TupleSections #-}
module Dodge.Combine ( module Dodge.Combine (
combinePoss,
combineSizes,
combineItemListYou,
combineListInfo,
toggleCombineInv, toggleCombineInv,
enterCombineInv, enterCombineInv,
combineListSelection, combineListSelection,
@@ -18,14 +14,13 @@ import qualified Data.IntSet as IS
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
import Data.Bifunctor import Data.Bifunctor
import Data.List (scanl', sortOn) import Data.List (sortOn)
import Data.Map.Merge.Strict import Data.Map.Merge.Strict
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Dodge.Base.You import Dodge.Base.You
import Dodge.Combine.Trie import Dodge.Combine.Trie
import Dodge.Data.World import Dodge.Data.World
import Dodge.Inventory.ItemSpace
import Dodge.Item.Amount import Dodge.Item.Amount
import Dodge.Module import Dodge.Module
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
@@ -51,7 +46,12 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
g (amount, i) = replicate (_getItAmount amount) i g (amount, i) = replicate (_getItAmount amount) i
combineList :: World -> [SelectionItem CombinableItem] 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 where
f (is,(strs,itm)) = SelectionItem f (is,(strs,itm)) = SelectionItem
{ _siPictures = itemDisplay itm { _siPictures = itemDisplay itm
@@ -69,9 +69,6 @@ combineListInfo w = filter f . map (cmm inv) $ combineItemListYouX w
inv = yourInv w inv = yourInv w
f (is,(_,itm)) = _itType itm `notElem` fmap _itType (IM.restrictKeys inv (IS.fromList is)) 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 :: IM.IntMap Item -> ([Int], Item) -> ([Int], ([String], Item))
cmm inv (is, itm) = (is, itm & itType . iyModules %%~ flip combineModuleMaps mms) cmm inv (is, itm) = (is, itm & itType . iyModules %%~ flip combineModuleMaps mms)
where where
@@ -114,13 +111,7 @@ enterCombineInv :: World -> World
enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory
(combineListSelection w mi "" False) (combineListSelection w mi "" False)
where where
mi = 0 <$ listToMaybe (combineItemListYou w) mi = 0 <$ listToMaybe (combineList w)
combineSizes :: World -> [Int]
combineSizes = map (itSlotsTaken . snd) . combineItemListYou
combinePoss :: World -> [Int]
combinePoss = scanl' (+) 0 . combineSizes
combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionIntMap CombinableItem combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionIntMap CombinableItem
combineListSelection w mi regex x = SelectionIntMap combineListSelection w mi regex x = SelectionIntMap
@@ -132,28 +123,6 @@ combineListSelection w mi regex x = SelectionIntMap
, _smShownItems = IM.fromAscList $ zip [0..] (combineList w) , _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 :: Int -> [String] -> SelectionItem ()
picsToSelectable wdth pics = picsToSelectable wdth pics =
SelectionItem SelectionItem
@@ -165,11 +134,3 @@ picsToSelectable wdth pics =
, _siOffX = 0 , _siOffX = 0
, _siPayload = () , _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 "*")
+9 -7
View File
@@ -3,6 +3,8 @@ module Dodge.Render.HUD (
drawHUD, drawHUD,
) where ) where
import SelectionIntMap
import Dodge.Data.Combine
import Dodge.Default.SelectionList import Dodge.Default.SelectionList
import Dodge.Combine import Dodge.Combine
import Dodge.Creature.Info import Dodge.Creature.Info
@@ -90,7 +92,7 @@ drawSubInventory subinv cfig w = case subinv of
cfig cfig
("COMBINE") ("COMBINE")
sl sl
<> combineInventoryExtra mi cfig w <> combineInventoryExtra sl mi cfig w
titledSub :: Configuration -> String -> SelectionList a -> Picture titledSub :: Configuration -> String -> SelectionList a -> Picture
titledSub cfig subtitle subitems = titledSub cfig subtitle subitems =
@@ -180,20 +182,20 @@ examineInventoryExtra mtweaki mitm cfig =
-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) -- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm))
] ]
combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture combineInventoryExtra :: SelectionIntMap CombinableItem -> Maybe Int -> Configuration -> World -> Picture
combineInventoryExtra mi cfig w = combineInventoryExtra sm mi cfig w =
pictures pictures
[ fromMaybe mempty $ do [ fromMaybe mempty $ do
i <- mi i <- mi
cpos <- combinePoss w !? i let cpos = getIthPos i (sm ^. smShownItems)
col <- (combineItemListYou w !? i) <&> _itInvColor . snd col <- sm ^? smShownItems . ix i . siColor
return $ return $
pictures pictures
[ fromMaybe mempty $ do [ 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 return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
, fromMaybe mempty $ do , fromMaybe mempty $ do
lnks <- map fst (combineItemListYou w) !? i lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
return $ return $
lnkMidPosInvSelsCol cfig w cpos col lnks lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
+15
View File
@@ -1,5 +1,6 @@
module Dodge.Render.List where module Dodge.Render.List where
import SelectionIntMap
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
--import Data.Foldable --import Data.Foldable
import Dodge.SelectionList import Dodge.SelectionList
@@ -63,6 +64,20 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
FixedSelectionWidth x -> x FixedSelectionWidth x -> x
_ -> 1 _ -> 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 :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture
drawSelectionMapCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. smSelPos) (IM.elems $ _smShownItems sl) drawSelectionMapCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. smSelPos) (IM.elems $ _smShownItems sl)
-1
View File
@@ -3,7 +3,6 @@ module Dodge.Update.Scroll (
) where ) where
import SelectionIntMap import SelectionIntMap
import Dodge.SelectionList
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Dodge.Base import Dodge.Base
+3 -3
View File
@@ -3,11 +3,11 @@ module Dodge.Update.UsingInput (
updateUsingInput, updateUsingInput,
) where ) where
import Dodge.Data.Combine
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
import Control.Lens import Control.Lens
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Dodge.Base.You import Dodge.Base.You
import Dodge.Combine
import Dodge.Creature.Impulse.UseItem import Dodge.Creature.Impulse.UseItem
import Dodge.Data.World import Dodge.Data.World
import Dodge.InputFocus import Dodge.InputFocus
@@ -78,9 +78,9 @@ pressedMBEffectsNoInventory pkeys w
-- note "sort" on the inventory indices; otherwise -- note "sort" on the inventory indices; otherwise
-- lower items may be shifted up and items below these removed instead -- lower items may be shifted up and items below these removed instead
doCombine :: Int -> World -> World 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 Nothing -> w
Just (is, it) -> Just (CombinableItem is it _) ->
-- set (hud . hudElement) (DisplayInventory NoSubInventory) -- set (hud . hudElement) (DisplayInventory NoSubInventory)
selectinv --enterCombineInv selectinv --enterCombineInv
. createPutItem it . createPutItem it
+9 -1
View File
@@ -30,7 +30,7 @@ moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a
moveSelectionMapStep x sm = fromMaybe sm $ do moveSelectionMapStep x sm = fromMaybe sm $ do
i <- _smSelPos sm i <- _smSelPos sm
(n,_) <- IM.lookupMax (sm ^. smShownItems) (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 case sm ^? smShownItems . ix j . siIsSelectable of
Just True -> Just $ sm & smSelPos ?~ j Just True -> Just $ sm & smSelPos ?~ j
_ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j) _ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j)
@@ -41,3 +41,11 @@ moveSelectionMapSelection i sm = foldl'
sm sm
(replicate (abs i) (moveSelectionMapStep (signum i))) (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)