diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index f184f7dd9..758a610e6 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -35,13 +35,11 @@ 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 <- 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 + 1) 0 lis + let j = sum . map _siHeight $ take i 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/Update.hs b/src/Dodge/Update.hs index 45c691ddc..d090b19c2 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -100,7 +100,6 @@ 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 @@ -151,7 +150,6 @@ optionScreenUpdate screen mop _ ldps sl u = . mouseOverSelectionList ldps sl . menuWheelEvents . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig) --- $ over (uvScreenLayers . _head) setShownSelectionItems $ u where cfig = u ^. uvConfig @@ -293,12 +291,30 @@ functionalUpdate w = . over uvWorld updateWheelEvents $ over uvWorld updatePastWorlds w +--menuWheelEvents :: Universe -> Universe +--menuWheelEvents u = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ (\y' -> (y' - y) `mod` ymax) +-- where +-- ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slItems) +-- y = u ^. uvWorld . input . scrollAmount + menuWheelEvents :: Universe -> Universe -menuWheelEvents u = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ (\y' -> (y' - y) `mod` ymax) +menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y))) where - ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slItems) y = u ^. uvWorld . input . scrollAmount +-- you probably want i to be 1 or -1 +menuWheelStep :: Int -> Universe -> Universe +menuWheelStep i u = fromMaybe u $ do + sl <- u ^? uvScreenLayers . _head . scSelectionList + selpos <- sl ^? slSelPos . _Just + ymax <- fmap length (sl ^? slItems) + let newpos = (selpos - i) `mod` ymax + itm <- sl ^? slItems . ix newpos + let newu = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ const newpos + if _siIsSelectable itm + then Just newu + else Just $ menuWheelStep i newu + updateWheelEvents :: World -> World updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y))) where