From 86943f4170f7c58275f14554f935871f2c754086 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 23 Feb 2023 16:13:40 +0000 Subject: [PATCH] Cleanup, tweak selection sections positioning --- src/Dodge/Creature/State.hs | 14 ++-- src/Dodge/Data/SelectionList.hs | 8 -- src/Dodge/DisplayInventory.hs | 17 ++-- src/Dodge/Inventory.hs | 1 - src/Dodge/Inventory/SelectionList.hs | 28 +------ src/Dodge/ListDisplayParams.hs | 6 +- src/Dodge/Render/HUD.hs | 120 ++++++++++++--------------- src/Dodge/Update/Scroll.hs | 5 +- 8 files changed, 79 insertions(+), 120 deletions(-) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index faa2f5bbe..df2594684 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -237,9 +237,10 @@ invSideEff :: Creature -> World -> World invSideEff cr w = updateTargeting (crGetTargeting cr) cr $ weaponReloadSounds cr $ - IM.foldl' f w (_crInv cr) - -- be careful with side effects that affect creature targeting + IM.foldl' f w (_crInv cr) where + -- be careful with side effects that affect creature targeting + f w' it = itemInvSideEffect cr it $ --doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv) @@ -258,10 +259,11 @@ createAttachLight cr it = createTorchLightOffset cr it attachoff attachoff = it ^?! itDimension . dimAttachPos itemUpdate :: Creature -> Int -> Item -> Item -itemUpdate cr i = updateAutoRecharge - . (itUse %~ useUpdate) - . (itLocation .~ InInv (_crID cr) i) - . (itIsHeld .~ itmisheld) +itemUpdate cr i = + updateAutoRecharge + . (itUse %~ useUpdate) + . (itLocation .~ InInv (_crID cr) i) + . (itIsHeld .~ itmisheld) where itmisheld = Just i == (cr ^? crManipulation . manObject . inInventory . ispItem) diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index a348e9256..2671f6b7b 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -82,14 +82,6 @@ data SelectionItem a = SelectionItem , _siColor :: Color , _siOffX :: Int } - | SelectionRegex - { _siPictures :: [String] - , _siHeight :: Int - , _siIsSelectable :: Bool - , _siColor :: Color - , _siOffX :: Int - } - --deriving (Eq, Ord, Show, Read) --Generic, Flat) makeLenses ''ListDisplayParams makeLenses ''SelectionList diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index a98e344e4..a814c1cac 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -58,7 +58,7 @@ updateCombineSections w cfig sss = return $ IM.singleton 0 - (SelectionRegex ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0) + (SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0) mstr = w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED" @@ -108,7 +108,7 @@ updateDisplaySections w cfig sss = coitems' = IM.fromDistinctAscList . zip [0 ..] $ map closeObjectToSelectionItem (w ^. hud . closeObjects) - invitems' = IM.mapWithKey (invSelectionItem' cr) inv + invitems' = IM.mapWithKey (invSelectionItem cr) inv cr = you w inv = _crInv (you w) nfreeslots = crNumFreeSlots cr @@ -123,7 +123,7 @@ updateDisplaySections w cfig sss = return $ IM.singleton 0 - (SelectionRegex [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0) + (SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0) itms' = fromMaybe itms $ do str <- mstr return $ IM.filter (plainRegex str) itms @@ -136,10 +136,10 @@ updateInventorySectionItems w = w where f olditems = fromMaybe olditems $ do cr <- w ^? cWorld . lWorld . creatures . ix 0 - invitms <- cr ^? crInv + invitms <- IM.mapWithKey (invSelectionItem cr) <$> cr ^? crInv return $ case w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just of - Just str -> IM.filter (plainRegex str) $ IM.mapWithKey (invSelectionItem' cr) invitms - _ -> IM.mapWithKey (invSelectionItem' cr) invitms + Just str -> IM.filter (plainRegex str) invitms + _ -> invitms plainRegex :: String -> SelectionItem a -> Bool plainRegex = flip $ andOrRegex (\si str -> regexList str (_siPictures si)) @@ -193,7 +193,10 @@ updateSection sis mcsel availablelines ss = csize = length $ _siPictures si ccolor = _siColor si return $ SectionCursor (cpos - offset) csize ccolor - offset = fromMaybe oldoffset $ do + nocursoroffset = if length allstrings - oldoffset <= availablelines + then max 0 (length allstrings - availablelines) + else oldoffset + offset = fromMaybe nocursoroffset $ do csel <- mcsel maxcsel <- fst <$> IM.lookupMax sis si <- sis ^? ix csel diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 362930940..3e7e40732 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -307,7 +307,6 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment where - --invsel = crSel (you w) minvsel = cr ^? crManipulation . manObject . inInventory . ispItem cr = you w invselcanactivate = isJust $ do diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 1712c9b48..08ad57554 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -1,6 +1,5 @@ module Dodge.Inventory.SelectionList ( invSelectionItem - , invSelectionItem' , closeObjectToSelectionItem ) where @@ -12,14 +11,8 @@ import Dodge.Data.SelectionList import Dodge.Data.World import LensHelp ---makeInventorySelectionList :: World -> SelectionList () ---makeInventorySelectionList w = defaultSelectionList --- & slItems .~ inventorySelectionList w --- & slSelPos .~ inventoryCursorPos w --- --- -invSelectionItem' :: Creature -> Int -> Item -> SelectionItem () -invSelectionItem' cr i it = SelectionItem +invSelectionItem :: Creature -> Int -> Item -> SelectionItem () +invSelectionItem cr i it = SelectionItem { _siPictures = pics , _siHeight = length pics , _siIsSelectable = True @@ -35,23 +28,6 @@ invSelectionItem' cr i it = SelectionItem _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it _ -> itemDisplay it -invSelectionItem :: Creature -> (Int,Item) -> SelectionItem () -invSelectionItem cr (i,it) = SelectionItem - { _siPictures = pics - , _siHeight = length pics - , _siIsSelectable = True - --, _siWidth = 15 - , _siColor = col - , _siOffX = 0 - , _siPayload = () - } - where - col = _itInvColor it - pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of - UndroppableIdentified -> itemDisplay it - _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it - _ -> itemDisplay it --- closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem () closeObjectToSelectionItem e = SelectionItem { _siPictures = pics diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index 1797eca29..d13827fc0 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -1,4 +1,8 @@ -module Dodge.ListDisplayParams where +module Dodge.ListDisplayParams + ( invDisplayParams + , secondColumnParams + , subInvX + ) where import Dodge.Data.CardinalPoint import SDL (MouseButton (..)) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 2b7c4cc4c..be7dbf3c1 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,23 +3,23 @@ module Dodge.Render.HUD ( drawHUD, ) where -import Dodge.ListDisplayParams -import Dodge.Inventory -import Dodge.Data.Combine -import Dodge.Default.SelectionList -import Dodge.Creature.Info +import Dodge.SelectionSections.Draw import Control.Lens import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Vector as V import Dodge.Base import Dodge.Clock ---import Dodge.Combine +import Dodge.Creature.Info import Dodge.Data.CardinalPoint +import Dodge.Data.Combine import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.Data.World +import Dodge.Default.SelectionList +import Dodge.Inventory import Dodge.Item.Info +import Dodge.ListDisplayParams import Dodge.Render.Connectors import Dodge.Render.List import Dodge.Tweak.Show @@ -35,62 +35,42 @@ import SDL (MouseButton (..)) drawHUD :: Configuration -> World -> Picture drawHUD cfig w = case w ^. hud . hudElement of DisplayCarte -> drawCarte cfig w - DisplayInventory {_diSections = sections, _subInventory = subinv} -> + DisplayInventory{_diSections = sections, _subInventory = subinv} -> drawHP cfig w - <> inventoryDisplay sections w cfig + <> drawInventory sections w cfig <> drawSubInventory subinv cfig w drawHP :: Configuration -> World -> Picture drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w -drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture -drawSelectionSections sss ldps cfig = listPicturesAtScaleOff - (_ldpVerticalGap ldps) - (_ldpScale ldps) - (_ldpPosX ldps) - (_ldpPosY ldps) - cfig - 0 - pics - <> thecursor' - where - thecursor' = fromMaybe mempty $ do - (i,j) <- sss ^? sssExtra . sssSelPos . _Just - return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j - pics = foldMap _ssShownItems (_sssSections sss) +drawInventory :: SelectionSections () -> World -> Configuration -> Picture +drawInventory sss w = drawSelectionSections sss (invDisplayParams w) -inventoryDisplay :: SelectionSections () -> World -> Configuration -> Picture -inventoryDisplay sss w = drawSelectionSections sss (invDisplayParams w) - drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of LockedInventory -> mempty -- topInvCursor col cursPos cfig w NoSubInventory -> drawNoSubInventory cfig w ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) - CombineInventory {_ciSections = sss} - -> titledSub' cfig "COMBINE" sss - <> combineInventoryExtra sss cfig w + CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w -titledSub :: Configuration -> String -> SelectionList a -> Picture -titledSub cfig subtitle subitems = - invHead cfig subtitle - <> drawSelectionList secondColumnParams cfig subitems -titledSub' :: Configuration -> String -> SelectionSections a -> Picture -titledSub' cfig subtitle subitems = - invHead cfig subtitle - <> drawSelectionSections subitems secondColumnParams cfig +drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture +drawCombineInventory cfig sss w = + invHead cfig "COMBINE" + <> drawSelectionSections sss secondColumnParams cfig + <> combineInventoryExtra sss cfig w drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture drawExamineInventory cfig mtweaki w = - titledSub - cfig - "EXAMINE" - (defaultSelectionList & slItems .~ ammoTweakSelectionItems itm - ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w)) ) w)) + invHead cfig "EXAMINE" <> examineInventoryExtra mtweaki itm cfig + <> drawSelectionList secondColumnParams + cfig + ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm + ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w))) w) + ) where itm = yourItem w f str = @@ -98,15 +78,15 @@ drawExamineInventory cfig mtweaki w = { _siPictures = [str] , _siHeight = 1 , _siIsSelectable = True - --, _siWidth = length str - , _siColor = white + , --, _siWidth = length str + _siColor = white , _siOffX = 0 , _siPayload = () } closeObjectInfo :: Int -> Either FloorItem Button -> String closeObjectInfo n x = case x of - Left FlIt{_flIt = itm} -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm + Left FlIt{_flIt = itm} -> itemInfo itm ++ " It is on the floor" ++ floorItemPickupInfo n itm Right _ -> "Some sort of switch or button." floorItemPickupInfo :: Int -> Item -> String @@ -114,10 +94,10 @@ floorItemPickupInfo n itm | n >= ceiling (_itInvSize itm) = ", but you have space to pick it up." | otherwise = ", and you don't have space to pick it up." --- note the use of ^?! +-- note the use of ^?! -- it is probably desirable for this to crash hard for now yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a -yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of +yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of Just (InInventory (SelItem i _)) -> f $ yourInv w ^?! ix i Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i _ -> x @@ -134,8 +114,9 @@ drawNoSubInventory cfig w = invid <- cr ^. crLeftInvSel . lisMPos sss <- w ^? hud . hudElement . diSections pos <- selSecSelPos 0 invid sss - return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText - $ _crInvEquipped cr IM.! invid + return $ + listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $ + _crInvEquipped cr IM.! invid f col invid epos = fromMaybe mempty $ do sss <- w ^? hud . hudElement . diSections pos <- selSecSelPos 0 invid sss @@ -152,11 +133,12 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do -- consider moving this functionality out into a tweaks module tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15 - -- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) + +-- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra sss cfig w = fromMaybe mempty $ do - (i,j) <- sss ^? sssExtra . sssSelPos . _Just + (i, j) <- sss ^? sssExtra . sssSelPos . _Just si <- sss ^? sssSections . ix i . ssItems . ix j cpos <- selSecSelPos i j sss let col = _siColor si @@ -175,7 +157,8 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do where invcursor i = fromMaybe mempty $ do sss' <- w ^? hud . hudElement . diSections - return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss' 0 i + return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i + -- fromMaybe mempty $ do -- i <- mi -- let cpos = getIthPos i (sm ^. smShownItems) @@ -198,8 +181,6 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do -- sss <- w ^? hud . hudElement . diSections -- return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i - - --thirdColumnPara :: [String] -> SelectionList () --thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs) -- where @@ -225,10 +206,11 @@ displayTerminal tid cfig w = fromMaybe mempty $ do where --toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 () toselitm (str, col) = SelectionItem [str] 1 True col 0 () - thesellist tm = defaultSelectionList - { _slItems = thelist tm --- , _slLength = length (thelist tm) - } + thesellist tm = + defaultSelectionList + { _slItems = thelist tm + -- , _slLength = length (thelist tm) + } thelist tm = map toselitm . displayTermInput tm . reverse @@ -244,12 +226,15 @@ displayTerminal tid cfig w = fromMaybe mempty $ do | otherwise = [] drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture -drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} - = fromMaybe mempty $ do - curpos <- you w ^? crManipulation . manObject . inInventory . ispItem +drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} = + fromMaybe mempty $ do + sss <- w ^? hud . hudElement . diSections + (i', j) <- sss ^? sssExtra . sssSelPos . _Just + curpos <- selSecSelPos i' j sss let midtext str = listTextPictureAt 252 0 cfig curpos (text str) let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) - return $ listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) + return $ + listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) <> case ae of DoNotMoveEquipment -> mempty PutOnEquipment{} -> @@ -279,8 +264,6 @@ eqPosText ep = case ep of OnLegs -> "LEGS" OnSpecial -> "EQUIPPED" - - combineCounts :: Configuration -> World -> [Int] -> Picture combineCounts cfig w = winScale cfig . foldMap f . group where @@ -293,7 +276,8 @@ combineCounts cfig w = winScale cfig . foldMap f . group f _ = mempty lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture -lnkMidPosInvSelsCol cfig w i col = winScale cfig +lnkMidPosInvSelsCol cfig w i col = + winScale cfig . foldMap f where f j = fromMaybe mempty $ do @@ -305,8 +289,6 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig hh = halfHeight cfig hw = halfWidth cfig - - ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()] ammoTweakSelectionItems = textSelItems . ammoTweakStrings @@ -418,8 +400,8 @@ picsToSelectable pics = { _siPictures = pics , _siHeight = length pics , _siIsSelectable = True - --, _siWidth = wdth - , _siColor = white + , --, _siWidth = wdth + _siColor = white , _siOffX = 0 , _siPayload = () } diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 60a428d27..9e973986d 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -49,8 +49,9 @@ updateWheelEvent yi w = case w ^. hud . hudElement of invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w) moveCombineSel :: Int -> World -> World -moveCombineSel yi = hud . hudElement . subInventory . ciSections - %~ scrollSelectionSections yi +moveCombineSel yi = (hud . hudElement . subInventory . ciSections + %~ scrollSelectionSections yi) + . (worldEventFlags . at CombineInventoryChange ?~ ()) moveSubSel :: Int -> Int -> World -> World moveSubSel yi maxyi =