This commit is contained in:
2025-08-27 19:22:01 +01:00
parent 40d2d316cb
commit dda0526180
9 changed files with 131 additions and 138 deletions
+1 -1
View File
@@ -52,7 +52,7 @@ updateCombineSections w cfig =
updateSectionsPositioning
(const 0)
(w ^? hud . subInventory . ciSelection . _Just)
(getAvailableListLines secondColumnParams cfig)
(getAvailableListLines secondColumnLDP cfig)
(IM.fromDistinctAscList [(-1, sfclose),(0, sclose')])
where
filtcurs = w ^? hud . subInventory . ciSelection . _Just . slSec == Just (-1)
+6 -6
View File
@@ -1,9 +1,9 @@
module Dodge.ListDisplayParams (
invDP,
invCursorParams,
secondColumnParams,
secondColumnLDP,
subInvX,
menuDisplayParams,
menuLDP,
) where
import Control.Lens
@@ -40,8 +40,8 @@ invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
_ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
_ -> [North, South, West]
secondColumnParams :: ListDisplayParams
secondColumnParams =
secondColumnLDP :: ListDisplayParams
secondColumnLDP =
defaultListDisplayParams
& ldpPos . spPixelOff .~ V2 subInvX (-81)
@@ -51,8 +51,8 @@ subInvX = 10 * fromIntegral topInvW + 70
topInvW :: Int
topInvW = 15
menuDisplayParams :: ListDisplayParams
menuDisplayParams =
menuLDP :: ListDisplayParams
menuLDP =
defaultListDisplayParams
& ldpPos . spPixelOff .~ V2 11 (-70)
& ldpScale .~ 2
+1 -1
View File
@@ -24,7 +24,7 @@ initializeOptionMenu title ops pmo u =
, _scPositionedMenuOption = pmo
, _scOptionFlag = NormalOptions
, _scSelectionList = optionsToSelections 10 u ops pmo
, _scAvailableLines = getAvailableListLines menuDisplayParams (u ^. uvConfig)
, _scAvailableLines = getAvailableListLines menuLDP (u ^. uvConfig)
, _scDisplayTime = 0
}
+7 -7
View File
@@ -124,7 +124,7 @@ drawMouseOver cfig w =
(w ^? input . mouseContext . mcoCombSelect)
<|> (w ^? input . mouseContext . mcoCombCombine)
sss <- w ^? hud . subInventory . ciSections
let idp = secondColumnParams
let idp = secondColumnLDP
return . translateScreenPos cfig (idp ^. ldpPos)
. color (withAlpha 0.2 white)
$ selSecDrawCursorAt idp curs sss (j, i)
@@ -182,8 +182,8 @@ drawCombineInventory ::
Picture
drawCombineInventory cfig sss w =
invHead cfig "COMBINE"
<> drawSelectionSections sss secondColumnParams cfig
<> drawSSCursor sss secondColumnParams curs cfig msel
<> drawSelectionSections sss secondColumnLDP cfig
<> drawSSCursor sss secondColumnLDP curs cfig msel
<> combineInventoryExtra sss msel cfig w
where
curs = BoundaryCursor [North, South, West]
@@ -195,7 +195,7 @@ drawExamineInventory :: Config -> World -> Picture
drawExamineInventory cfig w =
invHead cfig "EXAMINE"
<> drawSelectionList
secondColumnParams
secondColumnLDP
cfig
( map
f
@@ -361,10 +361,10 @@ combineInventoryExtra sss msel cfig w = fold $ do
drawTerminalDisplay :: Config -> Terminal -> Picture
drawTerminalDisplay cfig tm =
invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnParams cfig f
<> drawSelectionList secondColumnLDP cfig f
<> color
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnParams cfig tsize)
(drawSelectionListBackground secondColumnLDP cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
tid = tm ^. tmID
@@ -394,7 +394,7 @@ lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
sss <- w ^? hud . diSections
combinesss <- w ^? hud . subInventory . ciSections
lp <- selNumPos cfig invDP sss 0 j
rp <- selNumPos cfig secondColumnParams combinesss 0 i
rp <- selNumPos cfig secondColumnLDP combinesss 0 i
invcol <- selSecSelCol 0 j sss
return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol
+3 -3
View File
@@ -37,14 +37,14 @@ drawOptions :: Config -> String -> Maybe Int -> [SelectionItem a] -> Picture
drawOptions cfig title msel sl =
darkenBackground cfig
<> drawTitle cfig title
<> drawSelectionList menuDisplayParams cfig sl
<> drawSelectionList menuLDP cfig sl
<> translateScreenPos
cfig
(menuDisplayParams ^. ldpPos)
(menuLDP ^. ldpPos)
( drawCursorAt
msel
sl
menuDisplayParams
menuLDP
50
(BoundaryCursor [North, South])
)
+12 -16
View File
@@ -342,15 +342,13 @@ checkTermDist w = fromMaybe w $ do
updateMouseContext :: Config -> Universe -> Universe
updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
Just screen -> u & uvWorld . input . mouseContext .~ getMenuMouseContext screen u
Nothing -> updateMouseContextGame cfig u
Nothing -> u & uvWorld . input . mouseContext %~ updateMouseContextGame cfig u
updateMouseContextGame :: Config -> Universe -> Universe
updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
OverInvDrag i _ -> u & uvWorld . input . mouseContext .~ invdrag i
OverInvDragSelect{} -> u
_ ->
u & uvWorld . input . mouseContext
.~ fromMaybe aimcontext (isrotatedrag <|> overinv <|> overcomb <|> overterm)
updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
updateMouseContextGame cfig u = \case
OverInvDrag i _ -> OverInvDrag i (inverseSelNumPos cfig invDP mpos disss)
x@OverInvDragSelect{} -> x
_ -> fromMaybe aimcontext (isrotatedrag <|> overinv <|> overcomb <|> overterm)
where
w = u ^. uvWorld
isrotatedrag = do
@@ -363,9 +361,6 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
| otherwise = MouseInGame
mpos = w ^. input . mousePos
disss = w ^. hud . diSections
invdrag i' = fromMaybe (OverInvDrag i' Nothing) $ do
(i, j) <- inverseSelNumPos cfig invDP mpos disss
return $ OverInvDrag i' (Just (i, j))
overinv = do
selpos@(i, j) <- inverseSelNumPos cfig invDP mpos disss
case w ^? hud . subInventory . ciSelection of
@@ -379,7 +374,7 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
sss <- w ^? hud . subInventory . ciSections
Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
let msel = (xl, xr)
let mpossel = inverseSelNumPos cfig secondColumnParams (w ^. input . mousePos) sss
let mpossel = inverseSelNumPos cfig secondColumnLDP (w ^. input . mousePos) sss
return $ case mpossel of
Nothing -> OverCombEscape
Just (-1, i) | (-1, i) == msel -> OverCombFilter
@@ -398,9 +393,9 @@ getMenuMouseContext screen u = case screen ^. scOptions of
[] -> NoMouseContext
_ -> fromMaybe MouseMenuCursor $ do
ymax <- length <$> screen ^? scSelectionList
yi <- ldpVerticalSelection (u ^. uvConfig) menuDisplayParams (u ^. uvWorld . input . mousePos)
yi <- ldpSelection (u ^. uvConfig) menuLDP (u ^. uvWorld . input . mousePos)
guard (yi >= 0 && yi < ymax)
return $ case u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable of
return $ case screen ^? scSelectionList . ix yi . siIsSelectable of
Just True -> MouseMenuClick yi
_ -> NoMouseContext
@@ -411,7 +406,7 @@ isOverTerminalScreen cfig (V2 x y) =
&& y <= ymax + 5
&& y >= ymin
where
ldp = secondColumnParams
ldp = secondColumnLDP
V2 xmin ymax = screenPosAbs cfig (ldp ^. ldpPos)
tsize = fromIntegral $ getMaxLinesTM + 1
s = 5 + tsize * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap)
@@ -483,6 +478,7 @@ pbFlicker pt =
zoneClouds :: World -> World
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
zoneDusts :: World -> World
zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
@@ -499,7 +495,7 @@ tmUpdate tm w = fromMaybe w $ do
w & pointTermParams
%~ ( (tmFutureLines %~ tail)
. (tmDisplayedLines %~ take getMaxLinesTM . (map displayTerminalLineString tls ++))
-- . (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
-- . (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
)
& doTmWdWd g tm
where
+4 -4
View File
@@ -1,6 +1,6 @@
module Dodge.Update.Input.ScreenLayer (
updateUseInputOnScreen,
ldpVerticalSelection,
ldpSelection,
) where
import Dodge.SoundLogic.ExternallyGeneratedSounds
@@ -71,8 +71,8 @@ mouseClickOptionsList u = fromMaybe u $ do
return $ f u & uvSoundQueue .:~ click1S
_ -> Nothing
ldpVerticalSelection :: Config -> ListDisplayParams -> Point2 -> Maybe Int
ldpVerticalSelection cfig ldp (V2 _ y)
ldpSelection :: Config -> ListDisplayParams -> Point2 -> Maybe Int
ldpSelection cfig ldp (V2 _ y)
| yupper == ylower = Just yupper
| otherwise = Nothing
where
@@ -86,4 +86,4 @@ ldpVerticalSelection cfig ldp (V2 _ y)
setSelectionListRestriction :: Config -> ScreenLayer -> ScreenLayer
setSelectionListRestriction cfig =
scAvailableLines .~ getAvailableListLines menuDisplayParams cfig
scAvailableLines .~ getAvailableListLines menuLDP cfig