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

Move towards selection section inventory management

Browse Source
This commit is contained in:
justin
2023-02-14 23:25:09 +00:00
parent 9dd4c53316
commit ff5fa6321a
6 changed files with 252 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
+7 -13
View File
@@ -30,19 +30,14 @@ data SelectionList a = SelectionList
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Regex = NoRegex
| Regex
{ _regString :: String
, _regInput :: Bool
}
data SelectionSections a = SelectionSections
{ _sssSections :: IntMap (SelectionSection a)
, _sssSelPos :: Maybe Int
}
data SectionCursor = SectionCursor
{ _scurPos :: Int
{ _scurSel :: Int
, _scurPos :: Int
, _scurSize :: Int
, _scurColor :: Color
}
@@ -50,6 +45,7 @@ data SectionCursor = SectionCursor
data SelectionSection a = SelectionSection
{ _ssItems :: IntMap (SelectionItem a)
, _ssCursor :: Maybe SectionCursor
, _ssRegex :: Regex
-- , _ssSelPos :: Maybe Int
-- , _ssSelSize :: Maybe Int
-- , _ssSelColor :: Maybe Color
@@ -61,11 +57,10 @@ data SelectionSection a = SelectionSection
, _ssDescriptor :: String
}
data SMRegex = NoSMRegex
| SMRegex
{ _smrString :: String
, _smrInput :: Bool
}
data Regex = UnavailableRegex
| EmptyRegex
| Regex {_regexString :: String}
deriving (Show)
data SelectionIntMap a = SelectionIntMap
@@ -115,6 +110,5 @@ makeLenses ''SelectionSection
makeLenses ''SelectionSections
makeLenses ''SectionCursor
makeLenses ''Regex
makeLenses ''SMRegex
--deriveJSON defaultOptions ''SelectionItem
--deriveJSON defaultOptions ''SelectionList
src/Dodge/DisplayInventory.hs
+37 -18
View File
@@ -4,6 +4,7 @@ module Dodge.DisplayInventory
, defaultDisplaySections
) where
import Regex
import Data.Maybe
import Picture.Base
import Dodge.Render.HUD
@@ -66,11 +67,27 @@ 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
{ _ssItems = mempty
, _ssCursor = Nothing
, _ssRegex = EmptyRegex
, _ssMinSize = 5
, _ssOffset = 0
, _ssShownItems = []
, _ssIndent = 0
, _ssDescriptor = ""
}
defaultCOSection :: SelectionSection ()
defaultCOSection = SelectionSection mempty Nothing 5 0 [] 2 "CLOSE OBJECTS"
defaultCOSection = defaultSS
& ssIndent .~ 2
& ssDescriptor .~ "CLOSE OBJECTS"
defaultInvSection :: SelectionSection ()
defaultInvSection = SelectionSection mempty Nothing 5 0 [] 0 "INVENTORY ITEMS"
defaultInvSection = defaultSS
& ssDescriptor .~ "INVENTORY ITEMS"
updateSection
:: Maybe Int
@@ -78,16 +95,24 @@ updateSection
-> Int
-> SelectionSection a
-> SelectionSection a
updateSection mspos sis availablelines ss = ss
updateSection mspos sis' availablelines ss = ss
{ _ssItems = sis
, _ssCursor = scurs
, _ssOffset = offset
-- , _ssRegex = ""
-- , _ssRegexInput = False
, _ssMinSize = 5
, _ssShownItems = shownitems
}
where
sis = case _ssRegex ss of
Regex str -> IM.insert (-1) (f str) $ IM.filter (regexList str . _siPictures) sis'
_ -> sis'
f str = SelectionRegex
{ _siPictures = ["FILTER: " ++ str]
, _siHeight = 1
, _siIsSelectable = True
, _siColor = white
, _siOffX = 0
}
oldoffset = ss ^. ssOffset
scurs = do
csel <- mspos
@@ -95,7 +120,7 @@ updateSection mspos sis availablelines ss = ss
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
csize = length $ _siPictures si
ccolor = _siColor si
return $ SectionCursor (cpos - offset) csize ccolor
return $ SectionCursor csel (cpos - offset) csize ccolor
mcpos = do
csel <- mspos
return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
@@ -136,15 +161,9 @@ updateSection mspos sis availablelines ss = ss
return . length $ _siPictures si
yousec :: SelectionSection ()
yousec = SelectionSection
{ _ssItems = mempty
, _ssCursor = Just $ SectionCursor 0 1 invDimColor
, _ssOffset = 0
, _ssIndent = 2
-- , _ssRegex = ""
-- , _ssRegexInput = False
, _ssMinSize = 1
-- , _ssOffset = 0
, _ssShownItems = mempty
, _ssDescriptor = "YOUR STATUS"
}
yousec = defaultSS
& ssCursor ?~ SectionCursor 0 0 1 invDimColor
& ssRegex .~ UnavailableRegex
& ssIndent .~ 2
& ssMinSize .~ 1
& ssDescriptor .~ "YOUR STATUS"
src/Dodge/Inventory.hs
+128 -18
View File
@@ -25,6 +25,7 @@ module Dodge.Inventory (
trimapAugmentInv,
) where
import Dodge.Data.SelectionList
import Color
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -353,27 +354,136 @@ changeAugInvSel :: Int -> World -> World
changeAugInvSel yi w
| yi == 0 = w
| otherwise =
w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
where
f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
ninv = length (yourInv w)
nclose = length (w ^. hud . closeObjects)
w & hud . hudElement . diSections %~ scrollSelectionSections yi
& setInvPosFromSS
toAugSelPos :: World -> ManipulatedObject -> Int
toAugSelPos w mo = case mo of
SelItem i _ -> i
SelNothing -> ninv
SelCloseObject i -> ninv + i + 1
setInvPosFromSS :: World -> World
setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crInvSel . isel .~ thesel
where
ninv = length (yourInv w)
thesel = fromMaybe SelNothing $ do
sss <- w ^? hud . hudElement . diSections
i <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
case i of
0 -> Just $ SelItem j NoInvSelAction
2 -> Just $ SelCloseObject j
_ -> Just SelNothing
--changeAugInvSel :: Int -> World -> World
--changeAugInvSel yi w
-- | yi == 0 = w
-- | otherwise =
-- w & cWorld . lWorld . creatures . ix 0 . crInvSel . isel %~ f
-- where
-- f = fromAugSelPos w . (`mod` (ninv + nclose + 1)) . subtract yi . toAugSelPos w
-- ninv = length (yourInv w)
-- nclose = length (w ^. hud . closeObjects)
fromAugSelPos :: World -> Int -> ManipulatedObject
fromAugSelPos w i
| i > ninv = SelCloseObject (i - ninv - 1)
| i == ninv = SelNothing
| otherwise = SelItem i NoInvSelAction
where
ninv = length (yourInv w)
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)
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
--toAugSelPos :: World -> ManipulatedObject -> Int
--toAugSelPos w mo = case mo of
-- SelItem i _ -> i
-- SelNothing -> ninv
-- SelCloseObject i -> ninv + i + 1
-- where
-- ninv = length (yourInv w)
--
--fromAugSelPos :: World -> Int -> ManipulatedObject
--fromAugSelPos w i
-- | i > ninv = SelCloseObject (i - ninv - 1)
-- | i == ninv = SelNothing
-- | otherwise = SelItem i NoInvSelAction
-- where
-- ninv = length (yourInv w)
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
src/Dodge/Update.hs
+2
View File
@@ -145,8 +145,10 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
Just (CombineInventory sm)
| inregex sm -> doSubInvRegexInput u
_ | ininvregex -> doInvRegexInput u
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
ininvregex = False
inregex sm = fromMaybe False $ do
i <- sm ^? smSelPos . _Just
si <- sm ^? smShownItems . ix i
src/Dodge/Update/Input.hs
+72 -14
View File
@@ -3,8 +3,11 @@ module Dodge.Update.Input (
updateKeysInTerminal,
doInputScreenInput,
doSubInvRegexInput,
doInvRegexInput,
) where
import Color
import Data.Maybe
import Dodge.DisplayInventory
import SelectionIntMap
import qualified Data.Map.Strict as M
@@ -25,6 +28,15 @@ import Dodge.WorldPos
import LensHelp
import SDL
doTextInputOver' :: Universe -> ASetter' a String -> a -> a
doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
& checkBackspace
where
thetext = u ^. uvWorld . input . textInput
checkBackspace
| backspaceInputted u = p %~ doBackspace
| otherwise = id
doTextInputOver :: ASetter' Universe String -> Universe -> Universe
doTextInputOver p u = u & p %~ (++ map toUpper thetext)
& checkBackspace
@@ -63,6 +75,28 @@ doSubInvRegexInput u
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
doInvRegexInput :: Universe -> Universe
doInvRegexInput u
| backspacetonothing
= u & uvWorld . hud . hudElement . diSections %~ overSection
( ssRegex .~ EmptyRegex )
-- . initialSelPos )
-- & uvWorld . hud . hudElement . diSections %~ setShownIntMap
| endkeys || endmouse = u
-- = u & uvWorld . hud . hudElement . diSections %~ initialSelPos
| otherwise = u & uvWorld . hud . hudElement . diSections %~
overSection (doTextInputOver' u (ssRegex . regexString))
-- | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
where
endkeys = any
( (== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn,ScancodeEscape,ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
doInputScreenInput :: String -> Universe -> Universe
doInputScreenInput s u =
u & doTextInputOver (uvScreenLayers . _head . scInput)
@@ -101,29 +135,53 @@ updateKeyInGame uv sc InitialPress = case sc of
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
-- the following should be put in a more sensible place
--ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
ScancodeSlash -> uv
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enterregex
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
ScancodeBackspace -> uv
& uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enternonzeroregex
& uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0
& uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
ScancodeSlash -> uv & uvWorld . hud . hudElement %~ updateEnterRegex
ScancodeBackspace -> uv & uvWorld . hud . hudElement %~ updateBackspaceRegex
-- in fact the whole logic should probably be rethought, oh well
_ -> uv
where
enterregex Nothing = Just ""
enterregex (Just str) = Just str
enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
enternonzeroregex smr = smr
updateKeyInGame uv sc LongPress = case sc of
ScancodeF -> over uvWorld youDropItem uv
ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv
updateKeyInGame uv _ _ = uv
updateBackspaceRegex :: HUDElement -> HUDElement
updateBackspaceRegex di = case di ^? subInventory of
Just NoSubInventory -> di & diSections %~ overSection
( (ssRegex %~ backssregex)
. (ssCursor .~ Just (SectionCursor (-1) 0 1 white))
)
Just CombineInventory {} -> di
& subInventory . subInvMap . smRegex %~ enternonzeroregex
& subInventory . subInvMap . smSelPos ?~ 0
& subInventory . subInvMap %~ setShownIntMap
_ -> di
where
enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
enternonzeroregex smr = smr
backssregex (Regex (x:xs)) = Regex (init (x:xs))
backssregex x = x
updateEnterRegex :: HUDElement -> HUDElement
updateEnterRegex di = case di ^? subInventory of
Just NoSubInventory -> di & diSections %~ overSection (ssRegex %~ enterssregex)
Just CombineInventory {} -> di
& subInventory . subInvMap . smRegex %~ enterregex
& subInventory . subInvMap . smSelPos ?~ 0
& subInventory . subInvMap %~ setShownIntMap
_ -> di
where
enterssregex EmptyRegex = Regex ""
enterssregex x = x
enterregex Nothing = Just ""
enterregex (Just str) = Just str
overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
overSection f sss = fromMaybe sss $ do
i <- sss ^? sssSelPos . _Just
return $ sss & sssSections . ix i %~ f
pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
src/SelectionIntMap.hs
+6 -3
View File
@@ -26,9 +26,12 @@ setShownIntMap sm = case sm ^. smRegex of
initialSelPos :: SelectionIntMap a -> SelectionIntMap a
initialSelPos sm = sm & smSelPos .~ mi
where
mi = fst <$> ifind t (sm ^. smShownItems)
t _ SelectionRegex{} = False
t _ si = _siIsSelectable si
mi = case sm ^? smShownItems . ix 0 of
Nothing -> Nothing
Just SelectionRegex {} -> case sm ^? smShownItems . ix 1 of
Nothing -> Just 0
Just _ -> Just 1
_ -> Just 0
-- assumes that at least one item is selectable!
-- also assumes that the integer is 1 or -1