Rethink unselectable items in lists

This commit is contained in:
2022-12-25 11:39:47 +00:00
parent a3162e8f9c
commit 3de16cbd1a
4 changed files with 14 additions and 34 deletions
+4 -1
View File
@@ -109,13 +109,16 @@ menuOptionToSelectionItem :: Universe -> Int -> MenuOption -> SelectionItem (Uni
menuOptionToSelectionItem w padAmount mo = SelectionItem
{ _siPictures = [color thecol $ text optionText]
, _siHeight = 1
, _siIsSelectable = True
, _siIsSelectable = isselectable
, _siWidth = length optionText
, _siColor = white
, _siOffX = 0
, _siPayload = f
}
where
isselectable = case _moString mo w of
MODBlockedString{} -> False
_ -> True
f = fromMaybe id $ mo ^? moEff
thecol = case _moString mo w of
MODBlockedString{} -> greyN 0.5
+4 -2
View File
@@ -35,11 +35,13 @@ makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl
drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do
i <- _slSelPos sl
selit <- filter _siIsSelectable lis !? i
--selit <- filter _siIsSelectable lis !? i
selit <- lis !? i
f <- case _ldpCursorType ldps of
BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
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
let j = sum . map _siHeight $ takeWhileArb (<= i) (\x itsel -> x + 1) 0 lis
col = _siColor selit
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
where
+2 -30
View File
@@ -16,27 +16,8 @@ import Picture
drawMenuScreen :: Configuration -> ScreenLayer -> Picture
drawMenuScreen cfig screen = case screen of
OptionScreen{_scTitle = titf, _scSelectionList = selpos, _scListDisplayParams = ldps} ->
drawOptions ldps cfig titf selpos "Use keys to navigate the menu"
-- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
drawOptions ldps cfig titf selpos
(InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
-- (DisplayScreen sd) -> sd w
--menuScreen :: Configuration -> ScreenLayer -> Picture
--menuScreen cfig screen = case screen of
-- OptionScreen{_scTitle = titf, _scSelectionList = selpos} ->
-- drawOptions cfig titf selpos "Use keys to navigate the menu"
-- (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
-- (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs
--displayStringList :: World -> [String] -> Picture
--displayStringList w ss = pictures
-- ( polygon (screenBox w)
-- : zipWith f ys ss
-- )
-- where
-- hw = halfWidth w
-- ys = [0,22..]
-- f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
drawInputMenu ::
Configuration ->
@@ -59,14 +40,11 @@ drawOptions ::
String ->
-- | Select position
SelectionList a ->
-- | Help Text
String ->
Picture
drawOptions ldps cfig title sl footer =
drawOptions ldps cfig title sl =
pictures
[ darkenBackground cfig
, drawTitle cfig title
, drawFooterText cfig red footer
, drawSelectionList ldps cfig sl
]
@@ -79,12 +57,6 @@ drawTitle cfig = winScale cfig . translate (30 - hw) (hh-50) . scale 0.4 0.4 . t
hh = halfHeight cfig
hw = halfWidth cfig
--drawTitle' :: Configuration -> String -> Picture
--drawTitle' cfig = placeString (- hw + 30) (hh - 50) 0.4
-- where
-- hh = halfHeight cfig
-- hw = halfWidth cfig
placeString ::
-- | x distance from center
Float ->
+4 -1
View File
@@ -100,15 +100,18 @@ mouseClickOptionsList screen u = fromMaybe u $ do
Just False -> fromMaybe u $ do
i <- sl ^. slSelPos
f <- sl ^? slItems . ix i . siPayload
--f <- sl ^? slItems . ix i . siPayload
return $ f u
_ -> u
mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe
mouseOverSelectionList ldps sl u
| x > xl && x < xr && ylower == yupper && mmoving
&& ylower >= 0 && ylower < ymax = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
&& ylower >= 0 && ylower < ymax && isselectable = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
| otherwise = u
where
isselectable = fromMaybe False
$ u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
ymax = maybe 0 length $ sl ^? slItems
mmoving = u ^. uvWorld . input . mouseMoving
ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50