From ce251577386560acad75189904beeb6db4c96cf0 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 24 Jan 2023 11:54:59 +0000 Subject: [PATCH] Commit before messing with main inventory display --- src/Dodge/Combine.hs | 4 ++-- src/Dodge/Data/HUD.hs | 1 + src/Dodge/Data/SelectionList.hs | 18 +++++++++++++++- src/Dodge/Default/SelectionList.hs | 2 +- src/Dodge/Default/World.hs | 11 ++++++++-- src/Dodge/Inventory/Add.hs | 19 +++++------------ src/Dodge/Menu/Option.hs | 1 - src/Dodge/Render/HUD.hs | 4 ++-- src/Dodge/Render/List.hs | 2 ++ src/Dodge/Update/Input.hs | 23 +++++++++++++-------- src/Dodge/Update/Scroll.hs | 9 ++++---- src/Dodge/Update/UsingInput.hs | 33 +++++++++++++----------------- src/SelectionIntMap.hs | 2 ++ 13 files changed, 74 insertions(+), 55 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 59beb817a..4cb069eca 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -103,8 +103,8 @@ fullModuleName :: ItemModuleType -> String fullModuleName = fromMaybe "EMPTYMODULE" . moduleName toggleCombineInv :: World -> World -toggleCombineInv w = case w ^. hud . hudElement of - DisplayInventory CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory +toggleCombineInv w = case w ^? hud . hudElement . subInventory of + Just CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory _ -> w & enterCombineInv enterCombineInv :: World -> World diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index c7829a5fc..c8801a542 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -15,6 +15,7 @@ import Geometry.Data data HUDElement = DisplayInventory { _subInventory :: SubInventory + , _diSections :: SelectionSections () } | DisplayCarte -- deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index f8cf16c42..21b45db76 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -23,13 +23,29 @@ data ListDisplayParams = ListDisplayParams data SelectionList a = SelectionList { _slItems :: [SelectionItem a] , _slSelPos :: Maybe Int - , _slLength :: Int , _slRegex :: String , _slRegexInput :: Bool , _slRegexList :: [(SelectionItem a, Maybe Int)] } --deriving (Eq, Ord, Show, Read) --Generic, Flat) +data SelectionSections a = SelectionSections + { _sssSections :: IntMap (SelectionSection a) + , _sssSelPos :: Maybe Int + , _sssMaxSize :: Int + } + +data SelectionSection a = SelectionSection + { _ssItems :: [SelectionItem a] + , _ssSelPos :: Maybe Int + , _ssRegex :: String + , _ssRegexInput :: Bool + , _ssMinSize :: Int + , _ssOffset :: Int + , _ssShownItems :: IntMap (SelectionItem a) + } + + data SelectionIntMap a = SelectionIntMap { _smItems :: [SelectionItem a] , _smSelPos :: Maybe Int diff --git a/src/Dodge/Default/SelectionList.hs b/src/Dodge/Default/SelectionList.hs index a7912aaf7..f2ea1b6dd 100644 --- a/src/Dodge/Default/SelectionList.hs +++ b/src/Dodge/Default/SelectionList.hs @@ -6,7 +6,7 @@ defaultSelectionList :: SelectionList a defaultSelectionList = SelectionList {_slItems = [] , _slSelPos = Nothing - , _slLength = 0 +-- , _slLength = 0 , _slRegex = "" , _slRegexInput = False , _slRegexList = [] diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index e29cd3300..4748b0bb2 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,6 +1,6 @@ module Dodge.Default.World where ---import Dodge.Data.SelectionList +import Dodge.Data.SelectionList import Data.Graph.Inductive.Graph hiding ((&)) import qualified Data.Map as M import Dodge.Data.World @@ -142,10 +142,17 @@ defaultLWorld = , _lClock = 0 } +defaultDisplaySections :: SelectionSections a +defaultDisplaySections = SelectionSections + { _sssSections = mempty + , _sssSelPos = Just 0 + , _sssMaxSize = 20 + } + defaultHUD :: HUD defaultHUD = HUD - { _hudElement = DisplayInventory NoSubInventory + { _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultDisplaySections} , _carteCenter = V2 0 0 , _carteZoom = 0.5 , _carteRot = 0 diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 1c0205a32..6185ae334 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -35,20 +35,11 @@ tryPutItemInInv cid flit w = case maybeInvSlot of maybeInvSlot = checkInvSlotsYou it w updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it) .~ InInv cid invid ---{- | Pick up a specific item. -} ---putItemInInv :: Int -> FloorItem -> World -> World ---putItemInInv cid flit w = case maybeInvSlot of --- Nothing -> w --- Just i -> w --- & updateItLocation i --- & floorItems %~ IM.delete (_flItID flit) --- & creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it --- where --- it = _flIt flit --- maybeInvSlot = checkInvSlotsYou it w --- updateItLocation invid w' = case _itID it of --- Nothing -> w' --- Just j -> w' & itemPositions . ix j .~ InInv cid invid +createAndSelectItem :: Item -> World -> World +createAndSelectItem itm w = case createPutItem itm w of + (Just i, w') -> w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i NoInvSelAction + (Nothing, w') -> w' + createPutItem :: Item -> World -> (Maybe Int, World) createPutItem it w = uncurry (putItemInInvID 0) $ diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index d53fc710d..6cd6049c7 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -66,7 +66,6 @@ makeOptionsSelectionList maxlines mselpos u mos pmo = defaultSelectionList { _slItems = optionsToSelections maxlines u mos pmo , _slSelPos = mselpos - , _slLength = length $ optionsToSelections maxlines u mos pmo } optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)] diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 7f2f48587..b406f85ca 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -38,7 +38,7 @@ import SDL (MouseButton (..)) drawHUD :: Configuration -> World -> Picture drawHUD cfig w = case w ^. hud . hudElement of DisplayCarte -> drawCarte cfig w - DisplayInventory subinv -> + DisplayInventory {_diSections = sections, _subInventory = subinv} -> drawInGameHUD sl cfig w <> drawSubInventory subinv cfig w where @@ -241,7 +241,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 () thesellist tm = defaultSelectionList { _slItems = thelist tm - , _slLength = length (thelist tm) +-- , _slLength = length (thelist tm) } thelist tm = map toselitm . displayTermInput tm diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 2cb21ffbc..3b3af3b9d 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,5 +1,6 @@ module Dodge.Render.List where +--import Picture.Text import SelectionIntMap import qualified Data.IntMap.Strict as IM --import Data.Foldable @@ -43,6 +44,7 @@ makeSelectionListPictures :: SelectionList a -> [Picture] makeSelectionListPictures sl = concatMap f $ getShownItems sl where f si = map (color (_siColor si) . text) $ _siPictures si + --f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si makeSelectionMapPictures :: SelectionIntMap a -> [Picture] makeSelectionMapPictures sl = foldMap f $ _smShownItems sl diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 1927ba6a1..cacb6967a 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -5,6 +5,7 @@ module Dodge.Update.Input ( doSubInvRegexInput, ) where +import Dodge.DisplayInventory import SelectionIntMap import qualified Data.Map.Strict as M import Data.Char @@ -91,7 +92,7 @@ updateKeyInGame uv sc InitialPress = case sc of ScancodeSpace -> over uvWorld spaceAction uv ScancodeP -> pauseGame uv ScancodeF -> over uvWorld youDropItem uv - ScancodeM -> over uvWorld toggleMap uv + ScancodeM -> toggleMap uv ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crToggleReloading uv ScancodeT -> over uvWorld testEvent uv ScancodeX -> uv & uvWorld %~ toggleTweakInv @@ -119,24 +120,28 @@ pauseGame u = u & uvScreenLayers .~ [pauseMenu u] spaceAction :: World -> World spaceAction w = case w ^?! hud . hudElement of DisplayCarte -> w & hud . carteCenter .~ theLoc - DisplayInventory NoSubInventory -> case selectedCloseObject w of + DisplayInventory {_subInventory = NoSubInventory} -> case selectedCloseObject w of Just (_, Left flit) -> pickUpItem 0 flit w Just (_, Right but) -> doButtonEvent (_btEvent but) but w _ -> w - DisplayInventory DisplayTerminal{} -> w & hud . hudElement . subInventory .~ NoSubInventory + DisplayInventory {_subInventory = DisplayTerminal{}} + -> w & hud . hudElement . subInventory .~ NoSubInventory _ -> w & hud . hudElement . subInventory .~ NoSubInventory where --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w -toggleMap :: World -> World -toggleMap w = case w ^?! hud . hudElement of - DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory - _ -> w & hud . hudElement .~ DisplayCarte +toggleMap :: Universe -> Universe +toggleMap u = case u ^?! uvWorld . hud . hudElement of + DisplayCarte -> u & uvWorld . hud . hudElement .~ DisplayInventory {_subInventory = NoSubInventory, _diSections = makeDisplayInventory w cfig} + _ -> u & uvWorld . hud . hudElement .~ DisplayCarte + where + w = u ^. uvWorld + cfig = u ^. uvConfig toggleTweakInv :: World -> World -toggleTweakInv w = case w ^. hud . hudElement of - DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory +toggleTweakInv w = case w ^? hud . hudElement . subInventory of + Just ExamineInventory{} -> w & thepointer .~ NoSubInventory _ -> w & thepointer .~ ExamineInventory mi where thepointer = hud . hudElement . subInventory diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 70fc8df04..d6105aa00 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -22,7 +22,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of DisplayCarte | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *) | otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi) - DisplayInventory NoSubInventory + DisplayInventory {_subInventory = NoSubInventory} -- functions that modify the inventory should be centralised so that -- this lock can be sensibly applied, perhaps | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w @@ -33,13 +33,14 @@ updateWheelEvent yi w = case w ^. hud . hudElement of | lbDown -> w & cWorld . camPos . camZoom +~ y | invKeyDown -> changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w - DisplayInventory (ExamineInventory mi) + DisplayInventory {_subInventory = ExamineInventory mi} | invKeyDown && rbDown -> w & moveTweakSel yi | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w | rbDown -> w & changeTweakParam mi yi | otherwise -> w & moveTweakSel yi - DisplayInventory (CombineInventory SelectionIntMap {_smRegexInput = False}) -> w & moveCombineSel yi - DisplayInventory (DisplayTerminal tmid) -> terminalWheelEvent yi tmid w + DisplayInventory {_subInventory = CombineInventory SelectionIntMap {_smRegexInput = False}} + -> w & moveCombineSel yi + DisplayInventory {_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w _ -> w where y = fromIntegral yi diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index ed9a18c27..e1791d4e7 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -3,14 +3,13 @@ module Dodge.Update.UsingInput ( updateUsingInput, ) where -import Dodge.Combine -import SelectionIntMap -import Dodge.Data.Combine -import Dodge.Data.SelectionList import Control.Lens import qualified Data.Map.Strict as M import Dodge.Base.You +import Dodge.Combine import Dodge.Creature.Impulse.UseItem +import Dodge.Data.Combine +import Dodge.Data.SelectionList import Dodge.Data.World import Dodge.InputFocus import Dodge.Inventory @@ -19,10 +18,11 @@ import Dodge.Terminal.LeftButton import Geometry import ListHelp import SDL +import SelectionIntMap updateUsingInput :: World -> World updateUsingInput w = case w ^. hud . hudElement of - DisplayInventory subinv -> + DisplayInventory {_subInventory = subinv} -> pressedMBEffects subinv (_mouseButtons (_input w)) w DisplayCarte -> updatePressedButtonsCarte (_mouseButtons (_input w)) w @@ -30,9 +30,9 @@ 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, _smRegexInput = False} + CombineInventory SelectionIntMap{_smSelPos = mi, _smRegexInput = False} | lbinitialpress -> maybeexitcombine (maybe id doCombine mi w) - CombineInventory SelectionIntMap {_smRegexInput = True} + CombineInventory SelectionIntMap{_smRegexInput = True} | lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False DisplayTerminal tmid | lbinitialpress && inTermFocus w -> @@ -43,9 +43,9 @@ pressedMBEffects subinv pkeys w = case subinv of 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' + | 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 pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World @@ -58,7 +58,7 @@ pressedMBEffectsNoInventory pkeys w | otherwise = w where inTopInv = case w ^. hud . hudElement of - DisplayInventory NoSubInventory -> True + DisplayInventory {_subInventory = NoSubInventory} -> True _ -> False isDown but = but `M.member` pkeys rotation = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w)) @@ -68,13 +68,7 @@ pressedMBEffectsNoInventory pkeys w doCombine :: Int -> World -> World doCombine i w = case w ^? hud . hudElement . subInventory . subInvMap . smShownItems . ix i . siPayload of Nothing -> w - Just (CombinableItem is it _) -> - selectinv --enterCombineInv - . createPutItem it - $ foldr (rmInvItem 0) w (sort is) - where - selectinv (Just i', w') = w' & cWorld . lWorld . creatures . ix 0 . crInvSel .~ InvSel i' NoInvSelAction - selectinv (Nothing, w') = w' + Just (CombinableItem is it _) -> createAndSelectItem it $ foldr (rmInvItem 0) w (sort is) updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World updatePressedButtonsCarte pkeys w @@ -92,4 +86,5 @@ updatePressedButtonsCarte pkeys w isDown but = but `M.member` pkeys rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w)) czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w)) - trans = rotateV (w ^. hud . carteRot) $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w)) + trans = rotateV (w ^. hud . carteRot) + $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w)) diff --git a/src/SelectionIntMap.hs b/src/SelectionIntMap.hs index bbe87cb5c..96581599a 100644 --- a/src/SelectionIntMap.hs +++ b/src/SelectionIntMap.hs @@ -56,3 +56,5 @@ getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1) where yint = getIthPos i (sm ^. smShownItems) +selectionSectionsToIntMap :: SelectionSections a -> SelectionIntMap a +selectionSectionsToIntMap ss = undefined