Simplify menu display

This commit is contained in:
2025-01-07 00:58:23 +00:00
parent 1e7611ab81
commit fe3e0b1373
6 changed files with 19 additions and 21 deletions
-1
View File
@@ -85,7 +85,6 @@ data ScreenLayer
, _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: [SelectionItem (Universe -> Universe,Universe->Universe)]
, _scAvailableLines :: Int
, _scListDisplayParams :: ListDisplayParams
, _scDisplayTime :: Int
}
| InputScreen
+1 -1
View File
@@ -15,6 +15,6 @@ loadingScreen str =
, _scOptionFlag = LoadingScreen
, _scSelectionList = []
, _scAvailableLines = 0
, _scListDisplayParams = optionListDisplayParams
-- , _scListDisplayParams = optionListDisplayParams
, _scDisplayTime = 0
}
+1 -1
View File
@@ -25,7 +25,7 @@ initializeOptionMenu title ops pmo u =
, _scOptionFlag = NormalOptions
, _scSelectionList = optionsToSelections 10 u ops pmo
, _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
, _scListDisplayParams = optionListDisplayParams
-- , _scListDisplayParams = optionListDisplayParams
, _scDisplayTime = 0
}
+3 -2
View File
@@ -3,6 +3,7 @@ module Dodge.Render.MenuScreen (
drawMenuScreen,
) where
import Dodge.ListDisplayParams
import Dodge.ScreenPos
import Dodge.Data.CardinalPoint
import Control.Lens
@@ -14,8 +15,8 @@ import Picture
drawMenuScreen :: Configuration -> Maybe Int -> ScreenLayer -> Picture
drawMenuScreen cfig spos screen = case screen of
OptionScreen{_scTitle = titf, _scSelectionList = slist, _scListDisplayParams = ldps} ->
drawOptions ldps cfig titf spos slist
OptionScreen{_scTitle = titf, _scSelectionList = slist} ->
drawOptions optionListDisplayParams cfig titf spos slist
InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help
drawInputMenu ::
+8 -13
View File
@@ -7,6 +7,7 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
import Dodge.ListDisplayParams
import Color
import Control.Applicative
import Control.Monad
@@ -339,9 +340,8 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
sss <- w ^? hud . hudElement . diSections
selpos@(i, j) <- inverseSelNumPos cfig invDP sss mpos
case w ^? hud . hudElement . subInventory . ciSelection of
Just _ -> do
guard (i == 0)
return $ OverCombFiltInv selpos
Just _ | i == 0 -> return $ OverCombFiltInv selpos
Just _ -> Nothing
_ -> do
guard $ ButtonRight `M.notMember` (w ^. input . mouseButtons)
guard =<< sss ^? ix i . ssItems . ix j . siIsSelectable
@@ -371,22 +371,17 @@ getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
getMenuMouseContext screen u = case screen ^. scOptions of
[] -> NoMouseContext
_ -> fromMaybe MouseMenuCursor $ do
ldps <- screen ^? scListDisplayParams
-- ldps <- screen ^? scListDisplayParams
let ymax = maybe 0 length $ screen ^? scSelectionList
yi <-
ldpVerticalSelection
(u ^. uvConfig)
ldps
optionListDisplayParams
(u ^. uvWorld . input . mousePos)
guard (yi >= 0 && yi < ymax)
return $
if isselectable yi
then MouseMenuClick yi
else NoMouseContext
where
isselectable yi =
fromMaybe False $
u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable
return $ case u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable of
Just True -> MouseMenuClick yi
_ -> NoMouseContext
isOverTerminalScreen :: Configuration -> Terminal -> Point2 -> Bool
isOverTerminalScreen cfig tm (V2 x y) =
+6 -3
View File
@@ -3,6 +3,7 @@ module Dodge.Update.Input.ScreenLayer (
ldpVerticalSelection,
) where
import Dodge.ListDisplayParams
import Control.Monad
import Data.Char
import qualified Data.Map.Strict as M
@@ -83,6 +84,8 @@ ldpVerticalSelection cfig ldp (V2 _ y)
ylower = ceiling ((top - y) / yoff) - 1
setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer
setSelectionListRestriction cfig screen = fromMaybe screen $ do
ldps <- screen ^? scListDisplayParams
return $ screen & scAvailableLines %~ const (getAvailableListLines ldps cfig)
setSelectionListRestriction cfig screen =
screen & scAvailableLines %~ const (getAvailableListLines optionListDisplayParams cfig)
-- fromMaybe screen $ do
-- ldps <- screen ^? scListDisplayParams
-- return $ screen & scAvailableLines %~ const (getAvailableListLines ldps cfig)