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