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

Cleanup, tweak selection sections positioning

Browse Source
This commit is contained in:
justin
2023-02-23 16:13:40 +00:00
parent c5bfa36bde
commit 86943f4170
8 changed files with 79 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+8 -6
View File
@@ -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)
src/Dodge/Data/SelectionList.hs
-8
View File
@@ -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
src/Dodge/DisplayInventory.hs
+10 -7
View File
@@ -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
src/Dodge/Inventory.hs
-1
View File
@@ -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
src/Dodge/Inventory/SelectionList.hs
+2 -26
View File
@@ -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
src/Dodge/ListDisplayParams.hs
+5 -1
View File
@@ -1,4 +1,8 @@
module Dodge.ListDisplayParams where
module Dodge.ListDisplayParams
( invDisplayParams
, secondColumnParams
, subInvX
) where
import Dodge.Data.CardinalPoint
import SDL (MouseButton (..))
src/Dodge/Render/HUD.hs
+51 -69
View File
@@ -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 = ()
}
src/Dodge/Update/Scroll.hs
+3 -2
View File
@@ -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 =