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

Allow for inventory item bolding

Browse Source
This commit is contained in:
justin
2025-12-09 22:46:57 +00:00
parent bf8c538491
commit 851b26262a
18 changed files with 274 additions and 225 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+1
View File
@@ -30,6 +30,7 @@ combineList = map f . combineItemListYouX
, _siColor = itemInvColor $ baseCI itm
, _siOffX = 2
, _siPayload = Just $ CombItem is itm
, _siDisplayMod = NoSIDisplayMod
}
combineItemListYouX :: World -> [([Int], Item)]
src/Dodge/Data/CWorld.hs
+1
View File
@@ -32,6 +32,7 @@ data CWorld = CWorld
, _numberFloorVerxs :: Int
, _chasms :: [[Point2]]
, _numberChasmVerxs :: Int
, _highlightItems :: IM.IntMap Int
}
data CWGen = CWGen
src/Dodge/Data/SelectionList.hs
+14 -10
View File
@@ -38,16 +38,20 @@ type IMSS a = IntMap (SelSection a)
data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
data SelectionItem a
= SelItem
{ _siPictures :: [String]
, _siHeight :: Int
, _siWidth :: Int
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siPayload :: Maybe a
}
data SelectionItem a = SelItem
{ _siPictures :: [String]
, _siHeight :: Int
, _siWidth :: Int
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siPayload :: Maybe a
, _siDisplayMod :: SIDisplayMod
}
data SIDisplayMod
= NoSIDisplayMod
| HighlightSI
makeLenses ''ListDisplayParams
makeLenses ''SelectionItem
src/Dodge/Data/Terminal.hs
+1
View File
@@ -58,6 +58,7 @@ data TmWdWd
| TmWdWdDoDeathTriggers
| TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus
| TmDistributeAmmo
makeLenses ''Terminal
makeLenses ''TerminalLine
src/Dodge/Default/World.hs
+1
View File
@@ -98,6 +98,7 @@ defaultCWorld =
, _incGraph = mempty
, _incNode = mempty
, _incEdges = mempty
, _highlightItems = mempty
}
defaultLWorld :: LWorld
src/Dodge/DisplayInventory.hs
+10 -7
View File
@@ -65,7 +65,7 @@ updateCombineSections w cfig =
sclose'
| null sclose =
IM.singleton 0 $
SelItem ["NONE"] 1 25 False white 2 Nothing
SelItem ["NONE"] 1 25 False white 2 Nothing NoSIDisplayMod
| otherwise = sclose
regexCombs :: IM.IntMap Item -> SelectionItem CombItem -> String -> Bool
@@ -124,7 +124,7 @@ updateDisplaySections w cfig =
[ sfinv
, sinv
, IM.singleton 0 $
SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing
SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing NoSIDisplayMod
, sfclose
, sclose
, interfaceshead
@@ -144,7 +144,7 @@ updateDisplaySections w cfig =
btitems =
IM.fromDistinctAscList . zip [0 ..] $
mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing
makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing NoSIDisplayMod
cr = you w
closeitms =
IM.fromDistinctAscList . zip [0 ..] $
@@ -165,7 +165,7 @@ filterSectionsPair infocus filtfn itms s mfilt = (x, itms')
where
filtcurs = if infocus then cFilledRect else cWireRect
x = IM.singleton 0 $
fromMaybe (SelItem [s] 1 (length s) False white 0 Nothing) $ do
fromMaybe (SelItem [s] 1 (length s) False white 0 Nothing NoSIDisplayMod) $ do
str <- mfilt
return $
SelItem
@@ -176,6 +176,7 @@ filterSectionsPair infocus filtfn itms s mfilt = (x, itms')
white
0
Nothing
NoSIDisplayMod
f y = y
-- | null y =
-- IM.singleton 0 $ SelItem ["(NONE)"] 1 (length s) True (greyN 0.5) 0 Nothing
@@ -293,8 +294,7 @@ updateSection indent mcsel sis availablelines oldoffset =
| otherwise = id
tweaklast
| aslength - offset > availablelines =
ix (availablelines - 1)
.~ color white (text . replicate 15 $ toEnum 31)
ix (availablelines - 1) .~ color white (text . replicate 15 $ toEnum 31)
| otherwise = id
(allstrings, Sum aslength) = foldMap listSelectionColorPicture sis
shownstrings = drop offset allstrings
@@ -302,7 +302,10 @@ updateSection indent mcsel sis availablelines oldoffset =
listSelectionColorPicture :: SelectionItem a -> ([Picture], Sum Int)
listSelectionColorPicture si = (g <$> _siPictures si, Sum $ _siHeight si)
where
g = translate lindent 0 . color (_siColor si) . text
textf = case si ^. siDisplayMod of
NoSIDisplayMod -> text
HighlightSI -> hackBoldText
g = translate lindent 0 . color (_siColor si) . textf
lindent = 100 * fromIntegral (_siOffX si)
regexList :: String -> [String] -> Bool
src/Dodge/Event/Test.hs
+21 -22
View File
@@ -3,30 +3,29 @@ module Dodge.Event.Test (testEvent) where
--import Dodge.Creature.State
--import Dodge.Flame
import Data.Maybe
--import Data.Maybe
import Dodge.Data.World
import LensHelp
import Linear
--import Linear
testEvent :: World -> World
testEvent w = fromMaybe w $ do
testEvent w = w & cWorld . highlightItems .~
(w ^. cWorld . lWorld . items & each .~ 20)
--fromMaybe w $ do
-- cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy
-- return $ w & makeFlame (cpos + 25) 1
--testEvent w = fromMaybe w $ do
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos . _xy
let distR = 50
t1 = V2 1 (-1)
t2 = V2 1 1
t3 = V2 distR 0
v3 = V3 t1 t2 t3
distortionBulge =
RadialDistortion
cpos
(V2 distR 0)
(V2 0 distR)
v3 v3 v3
20
return $ w & cWorld . lWorld . distortions .~ [distortionBulge
, distortionBulge & rdPos +~ 50 & rdTR . _1 +~ V2 (-1) 1
, distortionBulge & rdPos +~ (-50)
]
-- let distR = 50
-- t1 = V2 1 (-1)
-- t2 = V2 1 1
-- t3 = V2 distR 0
-- v3 = V3 t1 t2 t3
-- distortionBulge =
-- RadialDistortion
-- cpos
-- (V2 distR 0)
-- (V2 0 distR)
-- v3 v3 v3
-- 20
-- return $ w & cWorld . lWorld . distortions .~ [distortionBulge
-- , distortionBulge & rdPos +~ 50 & rdTR . _1 +~ V2 (-1) 1
-- , distortionBulge & rdPos +~ (-50)
-- ]
src/Dodge/Inventory/SelectionList.hs
+5
View File
@@ -39,8 +39,11 @@ invSelectionItem w indent loc =
, _siColor = itemInvColor ci
, _siOffX = indent
, _siPayload = Nothing
, _siDisplayMod = dmod
}
where
dmod = maybe NoSIDisplayMod (const HighlightSI)
$ w ^? cWorld . highlightItems . ix (a ^. itID . unNInt)
ci = (a,b)
(a,b,_) = loc ^. locDT . dtValue
cr = w ^?! cWorld . lWorld . creatures . ix 0
@@ -218,6 +221,7 @@ closeItemToSelectionItem w i = do
, _siColor = col
, _siOffX = 0
, _siPayload = Nothing
, _siDisplayMod = NoSIDisplayMod
}
closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
@@ -232,6 +236,7 @@ closeButtonToSelectionItem w i = do
, _siColor = yellow
, _siOffX = 0
, _siPayload = Nothing
, _siDisplayMod = NoSIDisplayMod
}
btText :: Button -> String
src/Dodge/ListDisplayParams.hs
+3 -1
View File
@@ -1,5 +1,6 @@
module Dodge.ListDisplayParams (
invDP,
-- secDP,
invCursorParams,
secondColumnLDP,
subInvX,
@@ -41,7 +42,8 @@ invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
_ -> [North, South, West]
secondColumnLDP :: ListDisplayParams
secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX (-20)
--secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX (-20)
secondColumnLDP = defaultListDisplayParams & ldpPos . spPixelOff .~ V2 subInvX 0
subInvX :: Float
subInvX = 10 * fromIntegral topInvW + 170
src/Dodge/Menu/Option.hs
+1
View File
@@ -102,6 +102,7 @@ menuOptionToSelectionItem w padAmount mo =
, _siColor = thecol
, _siOffX = 0
, _siPayload = Just (f, g)
, _siDisplayMod = NoSIDisplayMod
}
where
isselectable = case _moString mo w of
src/Dodge/Render/HUD.hs
+4 -3
View File
@@ -58,7 +58,7 @@ drawHUD cfig w = case w ^. hud of
drawInventory :: IM.IntMap (SelSection ()) -> World -> Config -> SubInventory -> Picture
drawInventory sss w cfig = \case
DisplayTerminal {} -> mempty
-- DisplayTerminal {} -> mempty
_ -> drawSelectionSections sss invDP cfig
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
<> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
@@ -222,6 +222,7 @@ drawExamineInventory cfig w =
, _siColor = white
, _siOffX = 0
, _siPayload = Nothing
, _siDisplayMod = NoSIDisplayMod
}
closeObjectInfo :: Int -> Either Item Button -> String
@@ -360,7 +361,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
drawTerminalDisplay :: LWorld -> Config -> Terminal -> Picture
drawTerminalDisplay lw cfig tm =
drawSelectionList invDP cfig f
drawSelectionList secondColumnLDP cfig f
-- <> invHead cfig ("TERMINAL-" ++ show tid)
-- <> color
-- (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
@@ -369,7 +370,7 @@ drawTerminalDisplay lw cfig tm =
where
tid = tm ^. tmID
-- tsize = getMaxLinesTM + 1
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
-- not sure if the width (55) is correct here
f = toselitm ("TERMINAL " ++ show tid,white) :
(map (toselitm . (_1 %~ (" "<>))) . displayTermInput
src/Dodge/Room/Room.hs
+5 -2
View File
@@ -428,8 +428,8 @@ distributerRoom atype aamount = do
store = sps (unusedOffPathAwayFromLink 50)
(PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
dst gw = let mj = gw ^? genPmnt . ix i . plMID . _Just
in sps (unusedOffPathAwayFromLink 50)
(PutMachine (reverse $ square 10) (mcdist mj) Nothing)
in putTerminal (mcdist mj) (defaultTerminal & tmBootLines .~ tmDistributeLines)
& plSpot .~ (unusedOffPathAwayFromLink 50)
& plExternalID ?~ i1
thepipe gw =
let p1 = gw ^?! genPmnt . ix i . plSpot . psPos
@@ -446,5 +446,8 @@ distributerRoom atype aamount = do
return $ r & rmPmnts .:~ store
& rmInPmnt <>~ [(0,dst),(1,thepipe)]
tmDistributeLines :: [TerminalLine]
tmDistributeLines = [TLine 1 [TerminalLineConst "DISTRIBUTING AMMO" white] TmDistributeAmmo]
-- cor <- shuffleLinks corridor
-- return $ tToBTree "corDoor" $ treePost [door,cor,cleatOnward door]
src/Dodge/SelectionSections/Draw.hs
+1 -5
View File
@@ -13,11 +13,7 @@ import Dodge.ScreenPos
import Dodge.SelectionSections
import Picture.Base
drawSelectionSections ::
IM.IntMap (SelSection a) ->
ListDisplayParams ->
Config ->
Picture
drawSelectionSections :: IM.IntMap (SelSection a) -> ListDisplayParams -> Config -> Picture
drawSelectionSections sss ldp cfig =
translateScreenPos cfig (ldp ^. ldpPos) $
drawListYgapScaleYoff
src/Dodge/TestString.hs
+7 -6
View File
@@ -32,12 +32,13 @@ import Data.Foldable
import Data.Monoid
testStringInit :: Universe -> [String]
testStringInit u = map show
(u ^.. uvWorld . cWorld . lWorld . machines . traverse .mcType . _McDistributer)
<>
map f (u ^.. uvWorld . cWorld . lWorld . machines . traverse)
where
f mc = show (mc ^. mcID) <> shortShow (mc ^. mcType)
testStringInit _ = mempty
--testStringInit u = map show
-- (u ^.. uvWorld . cWorld . lWorld . machines . traverse .mcType . _McDistributer)
-- <>
-- map f (u ^.. uvWorld . cWorld . lWorld . machines . traverse)
-- where
-- f mc = show (mc ^. mcID) <> shortShow (mc ^. mcType)
-- [show $ foldMap (foldMap (Sum . length . (^. seObstacles)))
-- $ u ^. uvWorld . cWorld . incGraph]
-- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor
src/Dodge/Update.hs
+6
View File
@@ -158,12 +158,18 @@ updateUniverseMid u = case _uvScreenLayers u of
(sl : _) -> u & uvWorld . unpauseClock .~ 0 & updateUseInputOnScreen sl
[] ->
(uvWorld . unpauseClock +~ 1)
. (uvWorld . cWorld . highlightItems %~ IM.mapMaybe minusone)
-- . (uvWorld . cWorld . highlightItems . filteredBy . non 0 -~ 1)
. timeFlowUpdate
. updateUseInputInGame
$ over
uvWorld
(updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
u
where
minusone x
| x > 0 = Just $ x - 1
| otherwise = Nothing
timeFlowUpdate :: Universe -> Universe
timeFlowUpdate u = case u ^. uvWorld . timeFlow of
src/Dodge/WorldEffect.hs
+18 -3
View File
@@ -1,4 +1,4 @@
--{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
module Dodge.WorldEffect (
doWdWd,
@@ -6,6 +6,7 @@ module Dodge.WorldEffect (
doTmWdWd,
) where
import Color
import Dodge.Terminal
import NewInt
import Control.Monad
@@ -26,7 +27,7 @@ import LensHelp
import System.Random
doWdWd :: WdWd -> World -> World
doWdWd we = case we of
doWdWd = \case
NoWorldEffect -> id
SetTrigger bool tid -> cWorld . lWorld . triggers . ix tid .~ bool
SetLSCol col lsid -> cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ col
@@ -93,7 +94,7 @@ doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f
doTmWdWd :: TmWdWd -> Terminal -> World -> World
doTmWdWd tmwdwd = case tmwdwd of
doTmWdWd = \case
TmTmClearDisplayedLines -> \tm ->
cWorld . lWorld . terminals . ix (tm ^. tmID) . tmDisplayedLines .~ []
TmTmSetStatus x -> \tm -> cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus .~ x
@@ -106,6 +107,20 @@ doTmWdWd tmwdwd = case tmwdwd of
return $ soundStart TerminalSound tpos sid Nothing w
TmWdWdDoDeathTriggers -> doDeathTriggers
TmWdWdfromWdWd f -> \_ -> doWdWd f
TmDistributeAmmo -> tmDistributeAmmo
tmDistributeAmmo :: Terminal -> World -> World
tmDistributeAmmo tm w = fromMaybe w $ do
let mid = tm ^. tmMachineID
sid <- w ^? cWorld . lWorld . machines . ix mid
. mcType . mcdStorageMachine . _Just
McStorage atype aamount <- w ^? cWorld . lWorld . machines . ix sid . mcType
return $ w & cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus
.~ TerminalPressTo ""
& cWorld . lWorld . terminals . ix (tm ^. tmID) . tmFutureLines .~
[TLine 1 [TerminalLineConst "" yellow] (TmTmSetStatus (TerminalPressTo "RETRY"))
,TLine 1 [TerminalLineConst "" white] TmWdWdPowerDownTerminal
]
resetTerminal :: TerminalStatus -> Terminal -> World -> World
resetTerminal x tm =
src/Picture/Base.hs
+4
View File
@@ -25,6 +25,7 @@ module Picture.Base (
line,
lineCol,
text,
hackBoldText,
textRight,
textJustifyLeft,
textJustifyRight,
@@ -194,6 +195,9 @@ text :: String -> Picture
{-# INLINE text #-}
text = drawText 0
hackBoldText :: String -> Picture
hackBoldText s = text s <> translate 10 0 (text s)
-- lines up the rightmost part of the last character with 0
textJustifyRight :: String -> Picture
{-# INLINE textJustifyRight #-}