Separate selection list items from display parameters

This commit is contained in:
2022-12-23 12:22:57 +00:00
parent 6ac4e5d669
commit b072dc9e9a
10 changed files with 141 additions and 132 deletions
+12 -9
View File
@@ -7,18 +7,20 @@ import Control.Lens
import Data.Set (Set) import Data.Set (Set)
import Dodge.Data.CardinalPoint import Dodge.Data.CardinalPoint
data ListDisplayParams = ListDisplayParams
{ _ldpPosX :: Float
, _ldpPosY :: Float
, _ldpScale :: Float
, _ldpVerticalGap :: Float
, _ldpCursorType :: CursorType
, _ldpWidth :: SelectionWidth
, _ldpSizeRestriction :: SelectionSizeRestriction
}
data SelectionList = SelectionList data SelectionList = SelectionList
{ _slPosX :: Float { _slItems :: [SelectionItem]
, _slPosY :: Float
, _slScale :: Float
, _slVerticalGap :: Float
, _slItems :: [SelectionItem]
, _slShownItems :: [(SelectionItem,SelectionItemIndex)]
, _slSelPos :: Maybe Int , _slSelPos :: Maybe Int
, _slCursorType :: CursorType
, _slWidth :: SelectionWidth
, _slLength :: Int , _slLength :: Int
, _slSizeRestriction :: SelectionSizeRestriction
} }
data SelectionItemIndex = ListedSelectionItem Int data SelectionItemIndex = ListedSelectionItem Int
@@ -51,6 +53,7 @@ data SelectionItem = SelectionItem
, _siOffX :: Int , _siOffX :: Int
} }
makeLenses ''ListDisplayParams
makeLenses ''SelectionList makeLenses ''SelectionList
makeLenses ''SelectionItem makeLenses ''SelectionItem
makeLenses ''SpecialSelectionItem makeLenses ''SpecialSelectionItem
+2
View File
@@ -57,6 +57,8 @@ data ScreenLayer
, _scOptionFlag :: OptionScreenFlag , _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: SelectionList , _scSelectionList :: SelectionList
, _scAvailableLines :: Int , _scAvailableLines :: Int
, _scShownItems :: [(SelectionItem,SelectionItemIndex)]
, _scListDisplayParams :: ListDisplayParams
} }
| ColumnsScreen | ColumnsScreen
{ _scTitle :: String { _scTitle :: String
+6 -6
View File
@@ -27,7 +27,7 @@ import Data.Maybe
splashMenu :: Universe -> ScreenLayer splashMenu :: Universe -> ScreenLayer
splashMenu u = splashMenu u =
slTitleOptionsEff "AMNESIS" splashMenuOptions Nothing id u initializeOptionMenu "AMNESIS" splashMenuOptions Nothing id u
& scOptionFlag .~ SplashOptions & scOptionFlag .~ SplashOptions
splashMenuOptions :: [MenuOption] splashMenuOptions :: [MenuOption]
@@ -51,7 +51,7 @@ splashMenuOptions =
| otherwise = MODString str | otherwise = MODString str
pauseMenu :: Universe -> ScreenLayer pauseMenu :: Universe -> ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (Just "CONTINUE") unpause pauseMenu = initializeOptionMenu "PAUSED" pauseMenuOptions (Just "CONTINUE") unpause
pauseMenuOptions :: [MenuOption] pauseMenuOptions :: [MenuOption]
pauseMenuOptions = pauseMenuOptions =
@@ -77,7 +77,7 @@ saveQuitConc u = do
return $ const Nothing return $ const Nothing
seedStartMenu :: String -> Universe -> ScreenLayer seedStartMenu :: String -> Universe -> ScreenLayer
seedStartMenu str = slTitleOptionsEff str seedStartOptions (Just "BACK") popScreen seedStartMenu str = initializeOptionMenu str seedStartOptions (Just "BACK") popScreen
seedStartOptions :: [MenuOption] seedStartOptions :: [MenuOption]
seedStartOptions = seedStartOptions =
@@ -96,10 +96,10 @@ trySeedFromClipboard u = do
Just i -> return $ startSeedGame 0 i u Just i -> return $ startSeedGame 0 i u
slTitleOptions :: String -> [MenuOption] -> Universe -> ScreenLayer slTitleOptions :: String -> [MenuOption] -> Universe -> ScreenLayer
slTitleOptions title ops = slTitleOptionsEff title ops (Just "BACK") (popScreen . writeConfig) slTitleOptions title ops = initializeOptionMenu title ops (Just "BACK") (popScreen . writeConfig)
optionMenu :: Universe -> ScreenLayer optionMenu :: Universe -> ScreenLayer
optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions (Just "BACK") popScreen optionMenu = initializeOptionMenu "OPTIONS" optionsOptions (Just "BACK") popScreen
optionsOptions :: [MenuOption] optionsOptions :: [MenuOption]
optionsOptions = optionsOptions =
@@ -192,7 +192,7 @@ graphicsMenuOptions =
gameOverMenu :: Universe -> ScreenLayer gameOverMenu :: Universe -> ScreenLayer
gameOverMenu u = gameOverMenu u =
slTitleOptionsEff "GAME OVER" pauseMenuOptions Nothing id u initializeOptionMenu "GAME OVER" pauseMenuOptions Nothing id u
& scOptionFlag .~ GameOverOptions & scOptionFlag .~ GameOverOptions
-- OptionScreen -- OptionScreen
+32 -37
View File
@@ -11,49 +11,27 @@ import Dodge.Data.Universe
import qualified Data.Set as Set import qualified Data.Set as Set
import LensHelp import LensHelp
slTitleOptionsEff :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer initializeOptionMenu :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer
slTitleOptionsEff title ops defstr eff u = initializeOptionMenu title ops defstr eff u =
OptionScreen OptionScreen
{ _scTitle = title { _scTitle = title
, _scOptions = ops , _scOptions = ops
, _scOffset = 0 , _scOffset = 0
, _scMaybeOption = fmap (Toggle eff . const . MODString) defstr , _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
, _scOptionFlag = NormalOptions , _scOptionFlag = NormalOptions
, _scSelectionList = makeOptionsSelectionList (Just 0) u ops , _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops
, _scAvailableLines = 10 , _scAvailableLines = 10
, _scShownItems = []
, _scListDisplayParams = ListDisplayParams
{ _ldpPosX = 50
, _ldpPosY = 50
, _ldpScale = 2
, _ldpVerticalGap = 30
, _ldpWidth = FixedSelectionWidth 15
, _ldpSizeRestriction = SelectionSizeRestriction overflowit
, _ldpCursorType = BorderCursor (Set.fromList [North,South,West])
}
} }
refreshOptionsSelectionList :: Universe -> Universe
refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
where
f sl = case sl of
OptionScreen {_scOptions = mops} -> sl & scSelectionList . slItems .~ optionsToSelections u mops
_ -> sl
makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
makeOptionsSelectionList mselpos u mos = SelectionList
{ _slPosX = 50
, _slPosY = 50
, _slScale = 2
, _slVerticalGap = 30
, _slItems = optionsToSelections u mos
, _slShownItems = []
, _slSelPos = mselpos
, _slCursorType = BorderCursor (Set.fromList [North,South,West])
, _slWidth = FixedSelectionWidth 15
, _slLength = length $ optionsToSelections u mos
, _slSizeRestriction = SelectionSizeRestriction overflowit
-- , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do
-- str <- defstr
-- return $ BottomSelectionItem SelectionItem
-- { _siPictures = [color white $ text str]
-- , _siHeight = 1
-- , _siIsSelectable = True
-- , _siWidth = length str
-- , _siColor = white
-- , _siOffX = 0
-- }
}
where where
overflowit = SelectionItem overflowit = SelectionItem
{ _siPictures = [text "MORE OPTIONS"] { _siPictures = [text "MORE OPTIONS"]
@@ -64,9 +42,26 @@ makeOptionsSelectionList mselpos u mos = SelectionList
, _siOffX = 0 , _siOffX = 0
} }
optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem] refreshOptionsSelectionList :: Universe -> Universe
optionsToSelections u ops = map colStrToSelItem colstrs refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
where where
f sl = case sl of
OptionScreen {_scOptions = mops
, _scAvailableLines = maxlines}
-> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops
_ -> sl
makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList
makeOptionsSelectionList maxlines mselpos u mos = SelectionList
{ _slItems = optionsToSelections maxlines u mos
, _slSelPos = mselpos
, _slLength = length $ optionsToSelections maxlines u mos
}
optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem]
optionsToSelections maxlines u allops = map colStrToSelItem colstrs
where
ops = take maxlines allops
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops) maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
colstrs = map (menuOptionToString u maxOptionLength) ops colstrs = map (menuOptionToString u maxOptionLength) ops
+35 -26
View File
@@ -49,34 +49,40 @@ drawInGameHUD subinv uv =
w = _uvWorld uv w = _uvWorld uv
cfig = _uvConfig uv cfig = _uvConfig uv
defaultListDisplayParams :: ListDisplayParams
defaultListDisplayParams = ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = 0
, _ldpPosY = 0
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
, _ldpSizeRestriction = NoSelectionSizeRestriction
}
defaultSelectionList :: SelectionList defaultSelectionList :: SelectionList
defaultSelectionList = SelectionList defaultSelectionList = SelectionList
{ _slVerticalGap = 10 {_slItems = []
, _slScale = 1
, _slPosX = 0
, _slPosY = 0
, _slItems = []
, _slShownItems = []
, _slSelPos = Nothing , _slSelPos = Nothing
, _slCursorType = NoCursor
, _slWidth = FixedSelectionWidth 15
, _slLength = 0 , _slLength = 0
, _slSizeRestriction = NoSelectionSizeRestriction }
subInvListDisplayParams :: ListDisplayParams
subInvListDisplayParams = ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = subInvX
, _ldpPosY = 60
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
, _ldpSizeRestriction = NoSelectionSizeRestriction
} }
subInvSelectionList :: SelectionList subInvSelectionList :: SelectionList
subInvSelectionList = SelectionList subInvSelectionList = SelectionList
{ _slVerticalGap = 10 { _slItems = []
, _slScale = 1
, _slPosX = subInvX
, _slPosY = 60
, _slItems = []
, _slShownItems = []
, _slSelPos = Nothing , _slSelPos = Nothing
, _slCursorType = NoCursor
, _slWidth = FixedSelectionWidth 15
, _slLength = 0 , _slLength = 0
, _slSizeRestriction = NoSelectionSizeRestriction
} }
inventorySelectionList :: World -> [SelectionItem] inventorySelectionList :: World -> [SelectionItem]
@@ -98,18 +104,21 @@ inventoryCursorPos subinv w = case subinv of
CombineInventory {} -> Nothing CombineInventory {} -> Nothing
_ -> Just $ yourInvSel w _ -> Just $ yourInvSel w
inventoryDisplay :: SubInventory -> Configuration -> World -> Picture invDisplayParams :: World -> ListDisplayParams
inventoryDisplay subinv cfig w = drawSelectionList cfig $ invDisplayParams w = defaultListDisplayParams
defaultSelectionList & slItems .~ inventorySelectionList w & ldpWidth .~ FixedSelectionWidth topInvW
& slWidth .~ FixedSelectionWidth topInvW & ldpCursorType .~ BorderCursor (Set.fromList selcursortype)
& slCursorType .~ BorderCursor (Set.fromList selcursortype) & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
& slSelPos .~ inventoryCursorPos subinv w
& slWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
where where
selcursortype selcursortype
| ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West] | ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
| otherwise = [North,South,West] | otherwise = [North,South,West]
inventoryDisplay :: SubInventory -> Configuration -> World -> Picture
inventoryDisplay subinv cfig w = drawSelectionList (invDisplayParams w) cfig $
defaultSelectionList & slItems .~ inventorySelectionList w
& slSelPos .~ inventoryCursorPos subinv w
drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w LockedInventory -> mempty -- topInvCursor col cursPos cfig w
@@ -160,7 +169,7 @@ drawSubInventory subinv cfig w = case subinv of
] ]
where where
titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle
,drawSelectionList cfig subitems] <> ,drawSelectionList subInvListDisplayParams cfig subitems] <>
extrapics extrapics
closeobjectcursor = case selectedCloseObject w of closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty Nothing -> mempty
+17 -16
View File
@@ -15,36 +15,37 @@ import ListHelp
import Picture import Picture
import LensHelp import LensHelp
drawSelectionList :: Configuration -> SelectionList -> Picture drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList -> Picture
drawSelectionList cfig sl = drawSelectionList ldps cfig sl =
listPicturesAtScaleOff listPicturesAtScaleOff
(_slVerticalGap sl) (_ldpVerticalGap ldps)
(_slScale sl) (_ldpScale ldps)
(_slPosX sl) (_ldpPosX ldps)
(_slPosY sl) (_ldpPosY ldps)
cfig cfig
0 --(_slOffset sl) 0 --(_slOffset sl)
(makeSelectionListPictures sl) (makeSelectionListPictures sl)
<> drawSelectionCursor cfig sl <> drawSelectionCursor ldps cfig sl
makeSelectionListPictures :: SelectionList -> [Picture] makeSelectionListPictures :: SelectionList -> [Picture]
makeSelectionListPictures sl = case sl ^. slSizeRestriction of makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl
SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl --case sl ^. slSizeRestriction of
_ -> concatMap _siPictures $ _slItems sl -- SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl
-- _ -> concatMap _siPictures $ _slItems sl
drawSelectionCursor :: Configuration -> SelectionList -> Picture drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList -> Picture
drawSelectionCursor cfig sl = fromMaybe mempty $ do drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do
i <- _slSelPos sl i <- _slSelPos sl
selit <- filter _siIsSelectable lis !? i selit <- filter _siIsSelectable lis !? i
f <- case _slCursorType sl of f <- case _ldpCursorType ldps of
BorderCursor cps -> Just $ listCursorChooseBorderScale (_slVerticalGap sl) (_slScale sl) cps BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
NoCursor -> Nothing NoCursor -> Nothing
let j = sum . map _siHeight $ takeWhileArb (<= i) (\x itsel -> x + if _siIsSelectable itsel then 1 else 0) 0 lis let j = sum . map _siHeight $ takeWhileArb (<= i) (\x itsel -> x + if _siIsSelectable itsel then 1 else 0) 0 lis
col = _siColor selit col = _siColor selit
return $ f (_slPosX sl + (9 * fromIntegral (_siOffX selit))) (_slPosY sl) cfig j col wdth (_siHeight selit) return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
where where
lis = _slItems sl lis = _slItems sl
wdth = case _slWidth sl of wdth = case _ldpWidth ldps of
FixedSelectionWidth x -> x FixedSelectionWidth x -> x
_ -> 1 _ -> 1
+5 -4
View File
@@ -16,8 +16,8 @@ import Picture
drawMenuScreen :: Configuration -> ScreenLayer -> Picture drawMenuScreen :: Configuration -> ScreenLayer -> Picture
drawMenuScreen cfig screen = case screen of drawMenuScreen cfig screen = case screen of
OptionScreen{_scTitle = titf, _scSelectionList = selpos} -> OptionScreen{_scTitle = titf, _scSelectionList = selpos, _scListDisplayParams = ldps} ->
drawOptions cfig titf selpos "Use keys to navigate the menu" drawOptions ldps cfig titf selpos "Use keys to navigate the menu"
-- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 "" -- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
(InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
-- (DisplayScreen sd) -> sd w -- (DisplayScreen sd) -> sd w
@@ -77,6 +77,7 @@ drawInputMenu cfig title footer =
] ]
drawOptions :: drawOptions ::
ListDisplayParams ->
Configuration -> Configuration ->
-- | Title -- | Title
String -> String ->
@@ -85,12 +86,12 @@ drawOptions ::
-- | Help Text -- | Help Text
String -> String ->
Picture Picture
drawOptions cfig title sl footer = drawOptions ldps cfig title sl footer =
pictures pictures
[ darkenBackground cfig [ darkenBackground cfig
, drawTitle cfig title , drawTitle cfig title
, drawFooterText cfig red footer , drawFooterText cfig red footer
, drawSelectionList cfig sl , drawSelectionList ldps cfig sl
] ]
darkenBackground :: Configuration -> Picture darkenBackground :: Configuration -> Picture
+10 -8
View File
@@ -6,19 +6,21 @@ import Dodge.Data.Universe
import LensHelp import LensHelp
import Data.Maybe import Data.Maybe
setShownSelectionItems :: Configuration -> ScreenLayer -> ScreenLayer setShownSelectionItems :: ScreenLayer -> ScreenLayer
setShownSelectionItems cfig sl = fromMaybe sl $ do setShownSelectionItems sl = fromMaybe sl $ do
offset <- sl ^? scOffset offset <- sl ^? scOffset
maxlines <- sl ^? scAvailableLines maxlines <- sl ^? scAvailableLines
return $ sl & scSelectionList %~ setShownSelectionItems' maxlines offset return $ setShownSelectionItems' maxlines offset sl
setShownSelectionItems' :: Int -> Int -> SelectionList -> SelectionList setShownSelectionItems' :: Int -> Int -> ScreenLayer -> ScreenLayer
setShownSelectionItems' maxlines offset sl = case sl ^? slSizeRestriction of setShownSelectionItems' maxlines offset sl = case sl ^? scListDisplayParams . ldpSizeRestriction of
Just (SelectionSizeRestriction botit) Just (SelectionSizeRestriction botit)
| length allitems > maxlines -> | length allitems > maxlines ->
sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem)) sl & scShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
++ [(botit,ScrollSelectionItem)] ++ [(botit,ScrollSelectionItem)]
_ -> sl & slShownItems .~ allitems & scSelectionList . slItems .~ map fst ( take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
++ [(botit,ScrollSelectionItem)])
_ -> sl & scShownItems .~ allitems
where where
-- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem) -- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem)
allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. slItems) [0..] allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. scSelectionList . slItems) [0..]
+22 -20
View File
@@ -98,7 +98,7 @@ mouseClickOptionsList mos screen u = fromMaybe u $ do
Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
Just False -> fromMaybe u $ do Just False -> fromMaybe u $ do
i <- sl ^. slSelPos i <- sl ^. slSelPos
si <- sl ^? slShownItems . ix i . _2 si <- screen ^? scShownItems . ix i . _2
return $ maybe u ($ u) $ case si of return $ maybe u ($ u) $ case si of
ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff) ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff)
ScrollSelectionItem -> do ScrollSelectionItem -> do
@@ -109,18 +109,18 @@ mouseClickOptionsList mos screen u = fromMaybe u $ do
SpecialSelectionItem -> Just id SpecialSelectionItem -> Just id
_ -> u _ -> u
mouseOverSelectionList :: SelectionList -> Universe -> Universe mouseOverSelectionList :: ListDisplayParams -> SelectionList -> Universe -> Universe
mouseOverSelectionList sl u mouseOverSelectionList ldps sl u
| x > xl && x < xr && ylower == yupper && mmoving | x > xl && x < xr && ylower == yupper && mmoving
&& ylower >= 0 && ylower < ymax = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper && ylower >= 0 && ylower < ymax = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
| otherwise = u | otherwise = u
where where
ymax = maybe 0 length $ u ^? uvScreenLayers . _head . scSelectionList . slShownItems ymax = maybe 0 length $ u ^? uvScreenLayers . _head . scSelectionList . slItems
mmoving = u ^. uvWorld . input . mouseMoving mmoving = u ^. uvWorld . input . mouseMoving
ylower = ceiling $ (hh - (75 + y + _slPosY sl)) / 50 ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
yupper = floor $ (hh - (15 + y + _slPosY sl)) / 50 yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
xl = _slPosX sl - hw xl = _ldpPosX ldps - hw
xr = xl + _slScale sl * 15 * 9 xr = xl + _ldpScale ldps * 15 * 9
V2 x y = u ^. uvWorld . input . mousePos V2 x y = u ^. uvWorld . input . mousePos
cfig = u ^. uvConfig cfig = u ^. uvConfig
hh = halfHeight cfig hh = halfHeight cfig
@@ -129,22 +129,23 @@ mouseOverSelectionList sl u
setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer
setSelectionListRestriction' cfig screen = fromMaybe screen $ do setSelectionListRestriction' cfig screen = fromMaybe screen $ do
sl <- screen ^? scSelectionList sl <- screen ^? scSelectionList
return $ screen & scAvailableLines %~ const (setSelectionListRestriction cfig sl) ldps <- screen ^? scListDisplayParams
return $ screen & scAvailableLines %~ const (setSelectionListRestriction ldps cfig sl)
setSelectionListRestriction :: Configuration -> SelectionList -> Int setSelectionListRestriction :: ListDisplayParams -> Configuration -> SelectionList -> Int
setSelectionListRestriction cfig sl = nlines setSelectionListRestriction ldps cfig sl = nlines
where where
nlines = floor ((dToBot - vgap) / itmHeight) nlines = floor ((dToBot - vgap) / itmHeight)
vgap = sl ^. slVerticalGap vgap = ldps ^. ldpVerticalGap
itmHeight = 10 * sl ^. slScale + vgap itmHeight = 10 * ldps ^. ldpScale + vgap
dToBot = cfig ^. windowY - (sl ^. slPosY + dFromScreenBot) dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot)
dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
updateUseInput :: Universe -> Universe updateUseInput :: Universe -> Universe
updateUseInput u = case u ^? uvScreenLayers . _head of updateUseInput u = case u ^? uvScreenLayers . _head of
Just (InputScreen thetext _) -> doInputScreenInput thetext u Just (InputScreen thetext _) -> doInputScreenInput thetext u
Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist} Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps}
-> optionScreenUpdate screen mos mop flag sellist u -> optionScreenUpdate screen mos mop flag ldps sellist u
-- Just ColumnsScreen{} -> u & uvScreenLayers %~ tail -- Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
_ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of _ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
@@ -153,15 +154,16 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
-> ListDisplayParams
-> SelectionList -> SelectionList
-> Universe -> Universe -> Universe -> Universe
optionScreenUpdate screen mos mop _ sl u = optionScreenUpdate screen mos mop _ ldps sl u =
optionScreenDefEff mop optionScreenDefEff mop
. mouseClickOptionsList mos screen . mouseClickOptionsList mos screen
. mouseOverSelectionList sl . mouseOverSelectionList ldps sl
. menuWheelEvents . menuWheelEvents
. over (uvScreenLayers . _head) (setSelectionListRestriction' cfig) . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
$ over (uvScreenLayers . _head) (setShownSelectionItems cfig) $ over (uvScreenLayers . _head) setShownSelectionItems
u u
where where
cfig = u ^. uvConfig cfig = u ^. uvConfig
@@ -306,7 +308,7 @@ functionalUpdate w =
menuWheelEvents :: Universe -> Universe menuWheelEvents :: Universe -> Universe
menuWheelEvents u = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ (\y' -> (y' - y) `mod` ymax) menuWheelEvents u = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ (\y' -> (y' - y) `mod` ymax)
where where
ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slShownItems) ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slItems)
y = u ^. uvWorld . input . scrollAmount y = u ^. uvWorld . input . scrollAmount
updateWheelEvents :: World -> World updateWheelEvents :: World -> World
-6
View File
@@ -1,6 +0,0 @@
module Dodge.WindowLayout where
import Dodge.Data.Config
availableMenuLines :: Configuration -> Int
availableMenuLines = floor . (/ 50) . subtract 125 . _windowY