justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Move combine list over to SelectionSections -- more todo

Browse Source
This commit is contained in:
justin
2023-02-18 10:59:59 +00:00
parent 36b9b5445c
commit 6eca3bab38
10 changed files with 119 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+60 -14
View File
@@ -5,11 +5,17 @@ module Dodge.Combine (
combineList,
) where
import SelectionIntMap
import Dodge.Data.Universe
import Regex
import Dodge.DisplayInventory
import Dodge.Render.HUD
import Dodge.SelectionList
--import Dodge.Data.Config
--import SelectionIntMap
import Dodge.Data.Combine
import Dodge.Item.Display
import Color
import Dodge.Data.SelectionList
--import Dodge.Data.SelectionList
import qualified Data.IntSet as IS
import Control.Lens
import Control.Monad
@@ -20,7 +26,7 @@ import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.You
import Dodge.Combine.Trie
import Dodge.Data.World
--import Dodge.Data.World
import Dodge.Item.Amount
import Dodge.Module
import qualified IntMapHelp as IM
@@ -103,17 +109,57 @@ combineTwoModuleMaps =
fullModuleName :: ItemModuleType -> String
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
toggleCombineInv :: World -> World
toggleCombineInv w = case w ^? hud . hudElement . subInventory of
Just CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & enterCombineInv
toggleCombineInv :: Universe -> Universe
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
enterCombineInv :: World -> World
enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory sm
updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem
-> SelectionSections CombinableItem
updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [filt,combs]
where
sm = initialSelPos $ SelectionIntMap
{ _smItems = combineList w
, _smSelPos = Nothing
, _smRegex = Nothing
, _smShownItems = IM.fromAscList $ zip [0..] (combineList w)
availablelines = getAvailableListLines secondColumnParams cfig
filt = (-1, (filtsec,filtitems))
filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1)
filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0)
Nothing -> mempty
numfiltitems = " " ++ show numfiltitems' ++ " FILTERED"
numfiltitems' = length combitems' - length combitems
combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem)))
combs = (0, (combsec,combitems))
combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0
combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations
combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
Just str -> IM.filter (regexList str . _siPictures) combitems'
Nothing -> combitems'
ij = fromMaybe (0,0) $ do
i <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
return (i,j)
enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
cm
Nothing
sss
--(updateCombineSelections w cfig sss)
where
cm = IM.fromAscList $ zip [0..] $ combineList w
sss = SelectionSections
{ _sssSections = IM.singleton 0 combsection
, _sssSelPos = Just 0
}
availablelines = getAvailableListLines secondColumnParams cfig
combsection = updateSection (Just 0) cm availablelines combinationssection'
combinationssection' = SelectionSection
{ _ssItems = cm
, _ssCursor = do
(i,si) <- IM.lookupMin cm
return $ SectionCursor i 0 (length (_siPictures si)) (_siColor si)
, _ssMinSize = 5
, _ssOffset = 0
, _ssShownItems = mempty
, _ssIndent = 0
, _ssDescriptor = "COMBINATIONS"
}
src/Dodge/Data/HUD.hs
+2 -1
View File
@@ -25,7 +25,8 @@ data SubInventory
= NoSubInventory
| ExamineInventory {_subInvMSel :: Maybe Int}
-- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem}
| CombineInventory {_ciCombinations :: IntMap CombinableItem
| CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem)
, _ciRegex :: Maybe String
, _ciSections :: SelectionSections CombinableItem
}
| LockedInventory
src/Dodge/DisplayInventory.hs
+6 -2
View File
@@ -1,7 +1,11 @@
{-# LANGUAGE TupleSections #-}
module Dodge.DisplayInventory
( updateDisplayInventory
, defaultSS
, defaultFiltSection
, defaultDisplaySections
, updateSections
, updateSection
) where
import Regex
@@ -96,7 +100,7 @@ updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss
| otherwise = updateSection Nothing y availablelines x
availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
defaultSS :: SelectionSection ()
defaultSS :: SelectionSection a
defaultSS = SelectionSection
{ _ssItems = mempty
, _ssCursor = Nothing
@@ -113,7 +117,7 @@ defaultCOSection = defaultSS
& ssIndent .~ 2
& ssDescriptor .~ "CLOSE OBJECTS"
defaultFiltSection :: SelectionSection ()
defaultFiltSection :: SelectionSection a
defaultFiltSection = defaultSS
& ssIndent .~ 0
& ssDescriptor .~ "INV"
src/Dodge/InputFocus.hs
+3 -6
View File
@@ -32,12 +32,9 @@ inCloseRegex w = fromMaybe False $ do
inSubInvRegex :: World -> Bool
inSubInvRegex w = fromMaybe False $ do
sm <- w ^? hud . hudElement . subInventory . subInvMap
i <- sm ^? smSelPos . _Just
si <- sm ^? smShownItems . ix i
case si of
SelectionRegex {} -> return True
_ -> return False
sss <- w ^? hud . hudElement . subInventory . ciSections
i <- sss ^? sssSelPos . _Just
return $ i == (-1)
inputFocus :: World -> Bool
inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w
src/Dodge/Inventory.hs
+1 -97
View File
@@ -26,6 +26,7 @@ module Dodge.Inventory (
setInvPosFromSS,
) where
import Dodge.SelectionSections
import Control.Applicative
import Dodge.Data.SelectionList
import Color
@@ -382,103 +383,6 @@ setInvPosFromSS w = w
3 -> Just $ InNearby $ SelCloseObject j
_ -> error "selection out of bounds"
-- this should be in a separate module
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)
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
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
selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do
src/Dodge/Render/HUD.hs
+7 -6
View File
@@ -2,6 +2,7 @@
module Dodge.Render.HUD (
drawHUD,
invDisplayParams,
secondColumnParams,
) where
import Dodge.Inventory
@@ -68,7 +69,7 @@ invDisplayParams w =
Just ExamineInventory{} -> True
_ -> False
drawSelectionSections :: SelectionSections () -> ListDisplayParams -> Configuration -> Picture
drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
@@ -94,18 +95,18 @@ drawSubInventory subinv cfig w = case subinv of
NoSubInventory -> drawNoSubInventory cfig w
ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory _ sss -> titledSub' cfig "COMBINE" sss
CombineInventory _ _ sss -> titledSub' cfig "COMBINE" sss
<> combineInventoryExtra sss cfig w
titledSub :: Configuration -> String -> SelectionSections a -> Picture
titledSub cfig subtitle sss =
titledSub :: Configuration -> String -> SelectionList a -> Picture
titledSub cfig subtitle subitems =
invHead cfig subtitle
<> drawSelectionList sss secondColumnParams cfig
<> drawSelectionList secondColumnParams cfig subitems
titledSub' :: Configuration -> String -> SelectionSections a -> Picture
titledSub' cfig subtitle subitems =
invHead cfig subtitle
<> drawSelectionSections secondColumnParams cfig subitems
<> drawSelectionSections subitems secondColumnParams cfig
drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
drawExamineInventory cfig mtweaki w =
src/Dodge/Update.hs
+2 -2
View File
@@ -144,8 +144,8 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
optionScreenUpdate screen mop flag ldps sellist u
_ -> case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
Just (CombineInventory sm)
| inregex sm -> doSubInvRegexInput u
Just (CombineInventory _ _ _)
| inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u
-- _ | inInvRegex (u ^. uvWorld) -> doInvRegexInput u
_ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u
_ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
src/Dodge/Update/Input.hs
+21 -21
View File
@@ -52,14 +52,14 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
doSubInvRegexInput :: Universe -> Universe
doSubInvRegexInput u
| backspacetonothing =
u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing
& uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
| endkeys || endmouse =
u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
u & uvWorld . hud . hudElement . subInventory . ciRegex .~ Nothing
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
| endkeys || endmouse = u
-- u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
| otherwise =
u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
u & doTextInputOver (uvWorld . hud . hudElement . subInventory . ciRegex . _Just)
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
where
endkeys =
any
@@ -67,7 +67,7 @@ doSubInvRegexInput u
[ScancodeReturn, ScancodeEscape, ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing =
u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just ""
u ^? uvWorld . hud . hudElement . subInventory . ciRegex . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
@@ -158,7 +158,7 @@ updateInitialPressInGame uv sc = case sc of
ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeC -> toggleCombineInv uv
-- the following should be put in a more sensible place
ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex
@@ -174,12 +174,12 @@ updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory | secfocus (-1) 0 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
Just NoSubInventory | secfocus 2 3 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
Just CombineInventory{} ->
w & hud . hudElement . subInventory . subInvMap
%~ ( (smRegex %~ enternonzeroregex)
. (smSelPos ?~ 0)
. setShownIntMap
)
-- Just CombineInventory{} ->
-- w & hud . hudElement . subInventory . subInvMap
-- %~ ( (smRegex %~ enternonzeroregex)
-- . (smSelPos ?~ 0)
-- . setShownIntMap
-- )
_ -> w
where
secfocus a b = fromMaybe False $ do
@@ -215,12 +215,12 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
%~ ( (closeRegex %~ enterregex)
. (manObject .~ InNearby SortNearby)
)
Just CombineInventory{} ->
w & hud . hudElement . subInventory . subInvMap
%~ ( setShownIntMap
. (smSelPos ?~ 0)
. (smRegex %~ enterregex)
)
Just CombineInventory{} -> w
-- w & hud . hudElement . subInventory . subInvMap
-- %~ ( setShownIntMap
-- . (smSelPos ?~ 0)
-- . (smRegex %~ enterregex)
-- )
_ -> w
where
di = w ^. hud . hudElement
src/Dodge/Update/Scroll.hs
+3 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Update.Scroll (
updateWheelEvent,
) where
import Dodge.SelectionSections
import SelectionIntMap
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -49,7 +50,8 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
moveCombineSel :: Int -> World -> World
moveCombineSel yi = hud . hudElement . subInventory . subInvMap %~ moveSelectionMapSelection yi
moveCombineSel yi = hud . hudElement . subInventory . ciSections
%~ scrollSelectionSections yi
moveSubSel :: Int -> Int -> World -> World
moveSubSel yi maxyi =
src/Dodge/Update/UsingInput.hs
+14 -10
View File
@@ -30,8 +30,8 @@ updateUsingInput w = case w ^. hud . hudElement of
pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World
pressedMBEffects subinv pkeys w = case subinv of
NoSubInventory -> pressedMBEffectsNoInventory pkeys w
CombineInventory SelectionIntMap{_smSelPos = mi}
| lbinitialpress -> maybeexitcombine (maybe id doCombine mi w)
CombineInventory _ _ sss
| lbinitialpress -> tryCombine sss w -- maybeexitcombine (maybe id doCombine mi w)
DisplayTerminal tmid
| lbinitialpress && inTermFocus w ->
doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w
@@ -40,11 +40,14 @@ pressedMBEffects subinv pkeys w = case subinv of
_ -> w
where
lbinitialpress = pkeys ^? ix ButtonLeft == Just False
maybeexitcombine w'
| ButtonRight `M.member` _mouseButtons (_input w) =
(hud . hudElement . subInventory . subInvMap %~ setShownIntMap) $
(hud . hudElement . subInventory . subInvMap . smItems .~ combineList w') w'
| otherwise = w' & hud . hudElement . subInventory .~ NoSubInventory
-- maybeexitcombine w'
-- | ButtonRight `M.member` _mouseButtons (_input w) =
-- (hud . hudElement . subInventory . subInvMap %~ setShownIntMap) $
-- (hud . hudElement . subInventory . subInvMap . smItems .~ combineList w') w'
-- | otherwise = w' & hud . hudElement . subInventory .~ NoSubInventory
tryCombine :: SelectionSections CombinableItem -> World -> World
tryCombine sss w = w
pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World
pressedMBEffectsNoInventory pkeys w
@@ -64,9 +67,10 @@ 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 w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of
Nothing -> w
Just (CombinableItem is it _) -> createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
doCombine i w = undefined
-- case w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of
-- Nothing -> w
-- Just (CombinableItem is it _) -> createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World
updatePressedButtonsCarte pkeys w