Rethink unselectable items in lists
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user