diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index d091bee02..ab344517f 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -45,7 +45,6 @@ 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 @@ -57,11 +56,6 @@ data SelectionSection a = SelectionSection , _ssDescriptor :: String } -data Regex = UnavailableRegex - | EmptyRegex - | Regex {_regexString :: String} - deriving (Show) - data SelectionIntMap a = SelectionIntMap { _smItems :: [SelectionItem a] , _smSelPos :: Maybe Int @@ -100,7 +94,7 @@ data SelectionItem a = SelectionItem , _siOffX :: Int } --deriving (Eq, Ord, Show, Read) --Generic, Flat) - + makeLenses ''ListDisplayParams makeLenses ''SelectionList makeLenses ''SelectionItem @@ -108,6 +102,5 @@ makeLenses ''SelectionIntMap makeLenses ''SelectionSection makeLenses ''SelectionSections makeLenses ''SectionCursor -makeLenses ''Regex --deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index ac028c921..dd0cf34ae 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -23,23 +23,30 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of Just (InInventory SortInventory) -> sss + { _sssSections = updateSections availablelines ((-1),0) [filtinv,invx ,youx, closex] + , _sssSelPos = Just (-1) + } Just (InInventory (SelItem i _)) -> sss - { _sssSections = updateSections availablelines (0,i) [invx ,youx, closex] + { _sssSections = updateSections availablelines (0,i) [filtinv,invx ,youx, closex] , _sssSelPos = Just 0 } Just SelNothing -> sss - { _sssSections = updateSections availablelines (1,0) [invx ,youx, closex] + { _sssSections = updateSections availablelines (1,0) [filtinv,invx ,youx, closex] , _sssSelPos = Just 1 } Just (SelCloseObject i) -> sss - { _sssSections = updateSections availablelines (2,i) [closex, invx ,youx] + { _sssSections = updateSections availablelines (2,i) [filtinv,closex, invx ,youx] , _sssSelPos = Just 2 } _ -> error "error when getting cr inv sel" where filtinv = (-1,(filtinvsec,filtinvitems)) - filtinvsec = undefined - filtinvitems = undefined + filtinvsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1) + filtinvitems = case cr ^? crManipulation . invRegex . _Just of + Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0) + Nothing -> mempty + numfiltitems = " " ++ show numfiltitems' ++ " FILTERED" + numfiltitems' = length invitems' - length invitems invx = (0,(invsec, invitems)) youx = (1,(yousec, youitems)) closex = (2,(cosec, coitems)) @@ -50,7 +57,10 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0 coitems = IM.fromDistinctAscList . zip [0..] $ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects) - invitems = IM.mapWithKey (invSelectionItem' cr) inv + invitems' = IM.mapWithKey (invSelectionItem' cr) inv + invitems = case cr ^? crManipulation . invRegex . _Just of + Just str -> IM.filter (regexList str . _siPictures) invitems' + Nothing -> invitems' cr = you w inv = _crInv (you w) nfreeslots = crNumFreeSlots cr @@ -75,7 +85,6 @@ defaultSS :: SelectionSection () defaultSS = SelectionSection { _ssItems = mempty , _ssCursor = Nothing - , _ssRegex = EmptyRegex , _ssMinSize = 5 , _ssOffset = 0 , _ssShownItems = [] @@ -89,6 +98,12 @@ defaultCOSection = defaultSS & ssIndent .~ 2 & ssDescriptor .~ "CLOSE OBJECTS" +defaultFiltSection :: SelectionSection () +defaultFiltSection = defaultSS + & ssIndent .~ 0 + & ssDescriptor .~ "INV" + & ssMinSize .~ 0 + defaultInvSection :: SelectionSection () defaultInvSection = defaultSS & ssDescriptor .~ "INVENTORY ITEMS" @@ -103,20 +118,20 @@ updateSection mspos sis' availablelines ss = ss { _ssItems = sis , _ssCursor = scurs , _ssOffset = offset - , _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 - } + sis = 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 @@ -167,7 +182,7 @@ updateSection mspos sis' availablelines ss = ss yousec :: SelectionSection () yousec = defaultSS & ssCursor ?~ SectionCursor 0 0 1 invDimColor - & ssRegex .~ UnavailableRegex +-- & ssRegex .~ UnavailableRegex & ssIndent .~ 2 & ssMinSize .~ 1 & ssDescriptor .~ "YOUR STATUS" diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index f830b5c25..52163889d 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -21,12 +21,7 @@ inInvRegex :: World -> Bool inInvRegex w = fromMaybe False $ do sss <- w ^? hud . hudElement . diSections i <- sss ^? sssSelPos . _Just - ss <- sss ^? sssSections . ix i - j <- ss ^? ssCursor . _Just . scurSel - si <- ss ^? ssItems . ix j - return $ case si of - SelectionRegex {} -> True - _ -> False + return $ i == (-1) inSubInvRegex :: World -> Bool inSubInvRegex w = fromMaybe False $ do diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index ba152ca9e..3ec813a16 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -1,9 +1,11 @@ {-# LANGUAGE TupleSections #-} module Dodge.Inventory ( + ssLookupGT, + ssSetCursor, + firstPosSelectionSections, checkInvSlotsYou, rmSelectedInvItem, - --invSelPos, invSelSize, selNumPos, selNumTextPos, @@ -23,6 +25,7 @@ module Dodge.Inventory ( selectedCloseObject, invDimColor, trimapAugmentInv, + setInvPosFromSS, ) where import Dodge.Data.SelectionList @@ -366,20 +369,13 @@ setInvPosFromSS w = w i <- sss ^? sssSelPos . _Just j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel case i of + (-1) -> Just $ InInventory SortInventory 0 -> Just $ InInventory (SelItem j NoInvSelAction) + 1 -> Just SelNothing 2 -> Just $ SelCloseObject j - _ -> Just SelNothing + _ -> error "selection out of bounds" ---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) - +-- this should be in a separate module firstPosSelectionSections :: SelectionSections a -> SelectionSections a firstPosSelectionSections sss = fromMaybe sss $ do (i,j,si) <- ssLookupMin sss @@ -409,6 +405,14 @@ scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do 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) diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 33e99aad2..98224ad3b 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -36,6 +36,7 @@ invSelectionItem' cr i it = SelectionItem UndroppableIdentified -> itemDisplay it _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it _ -> itemDisplay it + invSelectionItem :: Creature -> (Int,Item) -> SelectionItem () invSelectionItem cr (i,it) = SelectionItem { _siPictures = pics diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 739300bf4..ca193b0bf 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -161,20 +161,11 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of drawNoSubInventory :: Configuration -> World -> Picture drawNoSubInventory cfig w = pictures - [ --closeobjectcursor - equipcursors + [ equipcursors , equipcursor -- the order is important, this should go on top of the other equipcursors , rboptions ] where --- closeobjectcursor = case selectedCloseObject w of --- Nothing -> mempty --- Just (i, _) -> --- drawCursorAt --- (invDisplayParams w & ldpCursorType .~ BorderCursor [North, South]) --- cfig --- (Just i) --- (inventorySelectionList w) equipcursor = case cr ^. crLeftInvSel . lisMPos of Just invid -> f cyan invid (_crInvEquipped cr IM.! invid) _ -> mempty diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index c07a9b2b2..3eccb7530 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -1,15 +1,18 @@ module Dodge.TestString where +import Data.ByteString.Lazy.Char8 (unpack) +import qualified Data.Aeson.Encode.Pretty as AEP import Control.Lens import Dodge.Data.Universe --import Data.Maybe --import ShortShow --import qualified Data.Map.Strict as M ---import qualified IntMapHelp as IM +import qualified IntMapHelp as IM testStringInit :: Universe -> [String] testStringInit u = - [ show $ u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just - ] + [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . sssSections] + --[ show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation + ++ lines (unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation) showTimeFlow :: TimeFlowStatus -> String showTimeFlow tfs = case tfs of diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 9f0a8b26b..8c885d8a2 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -6,7 +6,7 @@ module Dodge.Update.Input ( doInvRegexInput, ) where -import Color +import Dodge.Inventory import Data.Maybe import Dodge.DisplayInventory import SelectionIntMap @@ -19,7 +19,6 @@ import Dodge.Creature.Action import Dodge.Data.Universe import Dodge.Debug.Terminal import Dodge.Event.Test -import Dodge.Inventory import Dodge.Menu import Dodge.Reloading import Dodge.Save @@ -28,14 +27,14 @@ 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' :: 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) @@ -78,24 +77,28 @@ doSubInvRegexInput u doInvRegexInput :: Universe -> Universe doInvRegexInput u | backspacetonothing - = u & uvWorld . hud . hudElement . diSections %~ overSection - ( ( ssRegex .~ EmptyRegex ) - . ( ssItems . at (-1) .~ Nothing) + = u + & uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex .~ Nothing + & uvWorld . hud . hudElement . diSections %~ + ( ssSetCursor (ssLookupGT 0 (-1)) + . (overSection (ssItems . at (-1) .~ Nothing)) ) --- . initialSelPos ) + & uvWorld %~ setInvPosFromSS -- & 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) +-- | otherwise = u & uvWorld . hud . hudElement . diSections %~ +-- --overSection (doTextInputOver' u (ssRegex . regexString)) +-- overSection (id) + | otherwise = u & doTextInputOver + (uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex . _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 "" + backspacetonothing = u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . invRegex . _Just == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys @@ -143,8 +146,8 @@ updateInitialPressInGame uv sc = case sc of ScancodeX -> uv & uvWorld %~ toggleTweakInv ScancodeC -> over uvWorld toggleCombineInv uv -- the following should be put in a more sensible place - ScancodeSlash -> uv & uvWorld . hud . hudElement %~ updateEnterRegex - ScancodeBackspace -> uv & uvWorld . hud . hudElement %~ updateBackspaceRegex + ScancodeSlash -> uv & uvWorld %~ updateEnterRegex + ScancodeBackspace -> uv & uvWorld %~ updateBackspaceRegex _ -> uv updateLongPressInGame :: Universe -> Scancode -> Universe @@ -153,36 +156,40 @@ updateLongPressInGame uv sc = case sc of ScancodeSpace -> over uvWorld spaceAction uv _ -> uv -updateBackspaceRegex :: HUDElement -> HUDElement -updateBackspaceRegex di = case di ^? subInventory of - Just NoSubInventory -> di & diSections %~ overSection - ( (ssRegex %~ backssregex) - . (ssCursor ?~ SectionCursor (-1) 0 1 white) - ) - Just CombineInventory {} -> di - & subInventory . subInvMap . smRegex %~ enternonzeroregex - & subInventory . subInvMap . smSelPos ?~ 0 - & subInventory . subInvMap %~ setShownIntMap - _ -> di +updateBackspaceRegex :: World -> World +updateBackspaceRegex w = case di ^? subInventory of + Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace + Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ + ( ( smRegex %~ enternonzeroregex ) + . ( smSelPos ?~ 0 ) + . ( setShownIntMap ) + ) + _ -> w where + trybackspace cm = case cm ^? invRegex . _Just of + Just (_:_) -> cm & invRegex . _Just %~ init + & manObject .~ InInventory SortInventory + Just [] -> cm & invRegex .~ Nothing + Nothing -> cm + di = w ^. hud . hudElement 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) +updateEnterRegex :: World -> World +updateEnterRegex w = case w ^? hud . hudElement . subInventory of + Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ + ( ( invRegex %~ startregex ) + . ( manObject .~ InInventory SortInventory) ) - Just CombineInventory {} -> di - & subInventory . subInvMap . smRegex %~ enterregex - & subInventory . subInvMap . smSelPos ?~ 0 - & subInventory . subInvMap %~ setShownIntMap - _ -> di + Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~ + ( setShownIntMap + . (smSelPos ?~ 0 ) + . ( smRegex %~ enterregex) + ) + _ -> w where - enterssregex EmptyRegex = Regex "" - enterssregex x = x + startregex Nothing = Just "" + startregex x = x enterregex Nothing = Just "" enterregex (Just str) = Just str