diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 21699b03e..a60c1487d 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -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 diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 304b083fe..f184f7dd9 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -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 diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 94412bc67..e853c8105 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -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 -> diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index f6019d7b9..45c691ddc 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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