diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 817d37241..16c640a8f 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -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 diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 2bf78c4ca..a442ea270 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -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" diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index b3b2d0dbb..1e4667d45 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 3b82dbc74..e7cee6670 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 45d16e2d8..6feff3738 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -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] diff --git a/src/SelectionIntMap.hs b/src/SelectionIntMap.hs index 466e86c54..251c33532 100644 --- a/src/SelectionIntMap.hs +++ b/src/SelectionIntMap.hs @@ -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