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

Commit before extending selection sections: overlapping elements

Browse Source
This commit is contained in:
justin
2023-05-19 13:38:21 +01:00
parent 2f0bb5115b
commit ac87621640
13 changed files with 131 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+4 -4
View File
@@ -46,19 +46,19 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
combineList :: World -> [SelectionItem CombinableItem]
combineList w = case combineList' w of
[] -> [SelectionInfo ["No possible combinations"] 1 False white 0]
[] -> [SelectionInfo ["No possible combinations"] 1 False white 0 0]
xs -> xs
combineList' :: World -> [SelectionItem CombinableItem]
combineList' = map f . combineListInfo
where
f (is,(strs,itm)) = SelectionItem
{ _siPictures = itemDisplay itm
, _siHeight = length (itemDisplay itm)
{ _siPictures = basicItemDisplay itm
, _siHeight = length (basicItemDisplay itm)
, _siIsSelectable = True
--, _siWidth = maximum (map length (itemDisplay itm))
, _siColor = _itInvColor itm
, _siOffX = 0
, _siOffY = 0
, _siPayload = CombinableItem is itm strs
}
src/Dodge/Creature/Test.hs
+2 -3
View File
@@ -43,9 +43,8 @@ crWeaponReady cr = fromMaybe False $ do
asource <- cr ^? crInv . ix i . itUse . heldConsumption . laSource
case asource of
InternalSource ia -> return (_iaLoaded ia > 0 && _iaPrimed ia)
ExternalSource ea -> do
srcid <- ea ^? _Just
x <- cr ^? crInv . ix srcid . itUse . equipEffect . eeUse . euseAmmoAmount
AboveSource -> do
x <- cr ^? crInv . ix (i - 1) . itUse . equipEffect . eeUse . euseAmmoAmount
return (x > 0)
crCanSeeCr :: Creature -> (World, Creature) -> Bool
src/Dodge/Data/Item/Use/Consumption.hs
+1 -1
View File
@@ -28,7 +28,7 @@ data HeldConsumption
data AmmoSource
= InternalSource InternalAmmo
| ExternalSource { _eaAttachment :: Maybe Int }
| AboveSource
deriving (Eq, Show, Read) --Generic, Flat)
data InternalAmmo = InternalAmmo
src/Dodge/Data/SelectionList.hs
+2
View File
@@ -78,6 +78,7 @@ data SelectionItem a
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siOffY :: Int
, _siPayload :: a
}
| SelectionInfo
@@ -86,6 +87,7 @@ data SelectionItem a
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siOffY :: Int
}
makeLenses ''ListDisplayParams
src/Dodge/DisplayInventory.hs
+22 -7
View File
@@ -53,14 +53,14 @@ updateCombineSections w cfig sss =
invitms <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
showncombs
| null filtcombs = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
| null filtcombs = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0 0
| otherwise = filtcombs
filtinv = fromMaybe mempty $ do
str <- mstr
return $
IM.singleton
0
(SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
(SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0 0)
mstr = w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just
numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
@@ -105,7 +105,7 @@ updateDisplaySections w cfig sss =
(filtinv, invx) = filtpair (-1) invitems' "INV. "
(filtclose, closex) = filtpair 2 coitems' "NEARBY "
youx = (1, youitems)
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 0 ()
thetext = displayFreeSlots nfreeslots
availablelines = getAvailableListLines (invDisplayParams w) cfig
coitems' =
@@ -126,7 +126,7 @@ updateDisplaySections w cfig sss =
return $
IM.singleton
0
(SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
(SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0 0)
itms' = fromMaybe itms $ do
str <- mstr
return $ IM.filter (plainRegex str) itms
@@ -240,7 +240,7 @@ updateSection sis mcsel availablelines ss =
++ [translate 0 100 . color moredowncolor . textVMirror $ theindent ++ replicate 15 '^']
| otherwise = tweakfirst shownstrings
moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
allstrings :: [(Color, String)]
-- allstrings :: [(Color, String)]
allstrings = foldMap g sis
shownstrings = drop offset allstrings
h (col, str) = color col . text $ theindent ++ str
@@ -248,6 +248,21 @@ updateSection sis mcsel availablelines ss =
--xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
g si = map (_siColor si,) $ _siPictures si
overlapSelectionItems :: [SelectionItem a] -> IM.IntMap (Picture, Color)
overlapSelectionItems = go 0
where
go :: Int -> [SelectionItem a] -> IM.IntMap (Picture,Color)
go _ [] = mempty
go i (si : xs) = doinsert $ go (i + _siHeight si) xs
where
thecol = _siColor si
doinsert m =
ifoldr
(\j str -> IM.insertWith ihelp (i + j + _siOffY si) (color thecol (text str), thecol))
m
(_siPictures si)
ihelp (a,_) (b,col) = (a <> b, col)
enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w =
w & hud . hudElement . subInventory
@@ -257,7 +272,7 @@ enterCombineInv cfig w =
where
cm' = IM.fromAscList $ zip [0 ..] $ combineList' w
cm
| null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
| null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0 0
| otherwise = cm'
sss =
SelectionSections
@@ -274,7 +289,7 @@ enterCombineInv cfig w =
availablelines = getAvailableListLines secondColumnParams cfig
filtsection =
SelectionSection
{ _ssItems = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
{ _ssItems = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0 0
, _ssCursor = Nothing
, _ssMinSize = 0
, _ssOffset = 0
src/Dodge/Inventory/SelectionList.hs
+9 -7
View File
@@ -15,21 +15,22 @@ import Picture.Base
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
invSelectionItem cr i it =
SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = length pics
{ _siPictures = (pics & ix 0 %~ (++ anyequippos ++ anyhotkey))
, _siHeight = itSlotsTaken it
, _siIsSelectable = True
, _siColor = col
, _siOffX = 0
, _siOffY = 0
, _siPayload = ()
}
where
anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
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
pics = case _itCurseStatus it of
UndroppableIdentified -> itemDisplay cr it
-- _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
_ -> itemDisplay cr it
hotkeyToString :: Hotkey -> String
hotkeyToString x = case x of
@@ -55,6 +56,7 @@ closeObjectToSelectionItem e =
, --, _siWidth = 15
_siColor = col
, _siOffX = 2
, _siOffY = 0
, _siPayload = ()
}
where
@@ -63,5 +65,5 @@ closeObjectToSelectionItem e =
--
closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
closeObjectToTextPictures e = case e of
Left flit -> let it = _flIt flit in (itemDisplay it, _itInvColor it)
Left flit -> let it = _flIt flit in (basicItemDisplay it, _itInvColor it)
Right bt -> ([_btText bt], yellow)
src/Dodge/Item/Display.hs
+77 -64
View File
@@ -1,41 +1,48 @@
module Dodge.Item.Display (
itemDisplay,
selectedItemDisplay,
-- selectedItemDisplay,
itemString,
itemBaseName,
basicItemDisplay,
) where
import Control.Applicative
import Control.Monad
import Dodge.Item.Info
import Data.Maybe
import Data.Sequence
import Dodge.Data.Creature
import Dodge.Item.SlotsTaken
import Dodge.Module
import LensHelp
import Padding
itemDisplay :: Item -> [String]
itemDisplay it = itemDisplayWithNumber (showConsumption (_itUse it)) it
itemDisplay :: Creature -> Item -> [String]
itemDisplay cr itm = --itemDisplayWithNumber (showConsumption cr it) it
zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
itemDisplayWithNumber :: String -> Item -> [String]
itemDisplayWithNumber numberstr it =
Prelude.take (itSlotsTaken it) $
(midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) :
catMaybes [maybeWarmupStatus it, maybeRateStatus it]
++ moduleStrings it
++ repeat "\\"
zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDefaults f g h xs ys = go xs ys
where
thename = itemBaseName it
theparam =
fromMaybe []
. listToMaybe
$ mapMaybe
($ it)
[ maybeModeStatus
]
go [] bs = map g bs
go as [] = map f as
go (a:as) (b:bs) = h a b : go as bs
itemDisplayPad :: [Char] -> String -> [Char]
itemDisplayPad ls rs
| rs == "" = ls
| otherwise = midPadL 15 ' ' ls (' ':rs)
basicItemDisplay :: Item -> [String]
basicItemDisplay itm =
Prelude.take (itSlotsTaken itm) $
itemBaseName itm :
catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
++ moduleStrings itm
++ repeat "\\"
itemString :: Item -> String
itemString = head . itemDisplay
itemString = head . basicItemDisplay
itemBaseName :: Item -> String
itemBaseName it = case _iyBase $ _itType it of
@@ -48,17 +55,6 @@ itemBaseName it = case _iyBase $ _itType it of
EQUIP eit -> show eit
Consumable cit -> show cit
selectedItemDisplay :: Creature -> Item -> [String]
selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itUse it)) it
-- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.
showSelectedConsumption :: Creature -> ItemUse -> String
showSelectedConsumption cr iu = case iu of
HeldUse{} -> showReloadProgress cr (iu ^?! heldConsumption . laSource)
LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
EquipUse{_equipEffect = ee} -> showEquipmentNumber ee
_ -> show $ iu ^?! useAmount . getItAmount -- partial, be careful if adding new data constructors
showAutoRechargeProgress :: LeftConsumption -> String
showAutoRechargeProgress lc = case lc of
AutoRecharging{}
@@ -66,43 +62,65 @@ showAutoRechargeProgress lc = case lc of
| otherwise -> show (_arLoaded lc)
ChargeableAmmo{} -> show (_wpCharge lc)
showReloadProgress :: Creature -> AmmoSource -> String
showReloadProgress cr ic = case cr ^? crManipulation . manObject . inInventory . iselAction of
Just (ReloadAction i la) -> show i ++ showLoadActionType la ic
_ -> case ic of
InternalSource ia -> case ia ^? iaProgress . _Just . ix 0 of
Nothing -> show $ ia ^. iaLoaded
Just la -> show (_actionTime la) ++ showLoadActionType la ic
ExternalSource ea -> fromMaybe "X" $ do
i <- ea ^? _Just
itm <- cr ^? crInv . ix i
return $ show $ itemBaseName itm
--showReloadProgress :: Creature -> Item -> String
--showReloadProgress cr itm = case cr ^? crManipulation . manObject . inInventory . iselAction of
-- Just (ReloadAction i la) -> show i ++ showLoadActionType la ic
-- _ -> case ic of
-- InternalSource ia -> case ia ^? iaProgress . _Just . ix 0 of
-- Nothing -> show $ ia ^. iaLoaded
-- Just la -> show (_actionTime la) ++ showLoadActionType la ic
-- AboveSource -> fromMaybe "XXXX" $ do
-- i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
-- x <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
-- return $ showIntKMG' x
-- where
-- ic = (itm ^?! itUse . heldConsumption . laSource)
showConsumption :: ItemUse -> String
showConsumption iu = case iu of
HeldUse{} -> showReloadProgress' (_heldConsumption iu)
LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
EquipUse{_equipEffect = ee} -> showEquipmentNumber ee
_ -> show $ iu ^?! useAmount . getItAmount
itemNumberDisplay :: Creature -> Item -> [String]
itemNumberDisplay cr itm = case iu of
HeldUse{} -> [showReloadProgress' cr itm]
LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)]
EquipUse{} -> showEquipmentNumber cr itm
_ -> [show $ iu ^?! useAmount . getItAmount]
where
iu = itm ^?! itUse
showEquipmentNumber :: EquipEffect -> String
showEquipmentNumber ee = case _eeUse ee of
EFuelSource x _ -> show x
EAmmoSource {_euseAmmoAmount = x} -> showIntKMG' x
EBatterySource {_euseBatteryAmount = x} -> show x
_ -> ""
showEquipmentNumber :: Creature -> Item -> [String]
showEquipmentNumber cr itm = case _eeUse ee of
EFuelSource x _ -> [show x]
EAmmoSource {} -> showAmmoSource cr itm
EBatterySource {_euseBatteryAmount = x} -> [show x]
_ -> [""]
where
ee = itm ^?! itUse . equipEffect
showReloadProgress' :: HeldConsumption -> String
showReloadProgress' ic = case ic ^? laSource of
showAmmoSource :: Creature -> Item -> [String]
showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
eu <- itm ^? itUse . equipEffect . eeUse
atype <- eu ^? euseAmmoSourceType
x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
i <- itm ^? itLocation . ipInvID
(do
at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
guard (at' == atype && as == AboveSource)
return ["vvvv",x] ) <|> Just [x]
showReloadProgress' :: Creature -> Item -> String
showReloadProgress' cr itm = case ic ^? laSource of
Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of
Nothing -> fromMaybe "" $ do
x <- ic ^? laSource . _InternalSource . iaLoaded
return $ show x
Just la -> show (_actionTime la) ++ showLoadActionType la (_laSource ic)
Just (ExternalSource ea) -> fromMaybe "X" $ do
i <- ea ^? _Just
return $ show i
Just AboveSource -> fromMaybe "XXXX" $ do
i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
_ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
--return $ showIntKMG' x
return ""
_ -> ""
where
ic = itm ^?! itUse . heldConsumption
showLoadActionType :: LoadAction -> AmmoSource -> String
showLoadActionType la as = case la of
@@ -123,11 +141,6 @@ maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of
let n = show x
in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
maybeModeStatus :: Item -> Maybe String
maybeModeStatus it = case it ^? itUse . heldScroll of
Just HeldScrollCharMode{_hsCharMode = (c :<| _)} -> Just [' ', c]
_ -> Nothing
maybeRateStatus :: Item -> Maybe String
maybeRateStatus it = case it ^? itUse . heldDelay . rateMaxMax of
Nothing -> Nothing
src/Dodge/Item/Held/Cane.hs
+1 -1
View File
@@ -121,7 +121,7 @@ miniGunUse i =
& heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
& heldAim . aimHandlePos .~ 5
& heldConsumption
.~ (defaultBulletLoadable & laSource .~ ExternalSource Nothing)
.~ (defaultBulletLoadable & laSource .~ AboveSource)
--(defaultBulletLoadable
-- & laSource . iaMax .~ 1500
-- & laSource . iaLoaded .~ 1500
src/Dodge/Item/Weapon/TriggerType.hs
+5 -5
View File
@@ -139,9 +139,9 @@ ammoCheckI :: ChainEffect
ammoCheckI eff itm cr w = case itm ^? itUse . heldConsumption . laSource of
Just (InternalSource ia) | _iaLoaded ia <= 0 || not (_iaPrimed ia)
-> w
Just (ExternalSource ea) | fromMaybe True $ do
invid <- ea ^? _Just
x <- cr ^? crInv . ix invid . itUse . equipEffect . eeUse . euseAmmoAmount
Just AboveSource | fromMaybe True $ do
invid <- itm ^? itLocation . ipInvID
x <- cr ^? crInv . ix (invid - 1) . itUse . equipEffect . eeUse . euseAmmoAmount
return $ x <= 0
-> w
_ -> eff itm cr $ w & cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading
@@ -370,8 +370,8 @@ useAmmoAmount' :: Int -> Int -> IM.IntMap Item -> IM.IntMap Item
useAmmoAmount' itref x inv = case inv ^? ix itref . itUse . heldConsumption . laSource of
Just InternalSource{}
-> inv & ix itref . itUse . heldConsumption . laSource . _InternalSource . iaLoaded -~ x
Just (ExternalSource (Just eqid))
-> inv & ix eqid . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
Just AboveSource
-> inv & ix (itref - 1) . itUse . equipEffect . eeUse . euseAmmoAmount -~ x
_ -> inv
-- . crInv . ix itRef . itUse . heldConsumption . laSource
src/Dodge/Menu/Option.hs
+2
View File
@@ -100,6 +100,7 @@ colStrToSelItem (col, str) =
, _siIsSelectable = True
, _siColor = col
, _siOffX = 0
, _siOffY = 0
, _siPayload = id
}
@@ -120,6 +121,7 @@ menuOptionToSelectionItem w padAmount mo =
, _siIsSelectable = isselectable
, _siColor = thecol
, _siOffX = 0
, _siOffY = 0
, _siPayload = (f, g)
}
where
src/Dodge/Reloading.hs
+2 -21
View File
@@ -9,7 +9,7 @@ import Dodge.Data.Item.Use.Consumption.LoadAction
import Control.Lens
import Dodge.Data.Creature
import Data.Maybe
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
crCancelReloading :: Creature -> Creature
crCancelReloading cr =
@@ -53,26 +53,7 @@ tryStartLoading cr = fromMaybe cr $ do
as <- cr ^? crInv . ix i . itUse . heldConsumption . laSource
case as of
InternalSource ia -> return $ startLoading ia cr
ExternalSource ea -> return $ toggleExternalLoadSource i ea cr
toggleExternalLoadSource :: Int -> Maybe Int -> Creature -> Creature
toggleExternalLoadSource invid mcureqid cr = fromMaybe cr $ do
st <- inv ^? ix invid . itUse . heldConsumption . laSourceType
(eqid,eqitm) <- ifind (\_ a -> Just st == a ^? itUse . equipEffect . eeUse . euseAmmoSourceType) msplit
return $ cr
& crInv . ix invid . itUse . heldConsumption . laSource . _ExternalSource ?~ eqid
& crInv . ix eqid . itUse . equipEffect . eeUse . euseAmmoLink ?~ invid
& detachExternalSource eqitm
where
inv = cr ^. crInv
msplit = fromMaybe inv $ do
cureqid <- mcureqid
return . snd $ IM.split cureqid inv
detachExternalSource :: Item -> Creature -> Creature
detachExternalSource itm cr = fromMaybe cr $ do
i <- itm ^? itUse . equipEffect . eeUse . euseAmmoLink . _Just
return $ cr & crInv . ix i . itUse . heldConsumption . laSource . _ExternalSource .~ Nothing
AboveSource -> return cr
startLoading :: InternalAmmo -> Creature -> Creature
startLoading ic cr = case ic ^? iaProgress . _Just . ix 0 of
src/Dodge/Render/HUD.hs
+3 -1
View File
@@ -99,6 +99,7 @@ drawExamineInventory cfig mtweaki w =
, _siIsSelectable = True
, _siColor = white
, _siOffX = 0
, _siOffY = 0
, _siPayload = ()
}
@@ -214,7 +215,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
<> drawSelectionList secondColumnParams cfig (thesellist tm)
where
toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
toselitm (str, col) = SelectionItem [str] 1 True col 0 0 ()
thesellist tm = defaultSelectionList & slItems .~ thelist tm
thelist tm =
map toselitm . displayTermInput tm
@@ -333,6 +334,7 @@ picsToSelectable pics =
, _siIsSelectable = True
, _siColor = white
, _siOffX = 0
, _siOffY = 0
, _siPayload = ()
}
src/Dodge/Room/Containing.hs
+1 -1
View File
@@ -19,7 +19,7 @@ import RandomHelp
roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String)
roomsContaining crs its = tToBTree str <$> roomsContaining' crs its
where
str = "roomsContaining " ++ concatMap _crName crs ++ concatMap (head . itemDisplay) its
str = "roomsContaining " ++ concatMap _crName crs ++ concatMap (head . basicItemDisplay) its
roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' crs its = do