From d5be125a3bba29b6b9158bc4f77f4a5da07b0f3b Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 17 Nov 2024 13:03:46 +0000 Subject: [PATCH] Cleanup --- ghcidOutput | 6 +- src/Dodge/Combine/Graph.hs | 137 ++++++++++++++------------ src/Dodge/Concurrent.hs | 33 +++---- src/Dodge/Data/SelectionList.hs | 6 -- src/Dodge/Data/Universe.hs | 2 +- src/Dodge/Default/SelectionList.hs | 8 -- src/Dodge/Menu/Loading.hs | 30 +++--- src/Dodge/Menu/Option.hs | 76 +++++++------- src/Dodge/Render/HUD.hs | 8 +- src/Dodge/Render/List.hs | 6 +- src/Dodge/Render/MenuScreen.hs | 4 +- src/Dodge/Update.hs | 5 +- src/Dodge/Update/Input/ScreenLayer.hs | 4 +- 13 files changed, 156 insertions(+), 169 deletions(-) delete mode 100644 src/Dodge/Default/SelectionList.hs diff --git a/ghcidOutput b/ghcidOutput index 8d39dd275..01e245206 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1,5 +1 @@ -/home/justin/Haskell/loop/src/Dodge/Menu/Option.hs:53:35-41: warning: [-Wunused-matches] - Defined but not used: ‘mselpos’ - | -53 | makeOptionsSelectionList maxlines mselpos u mos pmo = - | ^^^^^^^ +All good (594 modules, at 13:03:38) diff --git a/src/Dodge/Combine/Graph.hs b/src/Dodge/Combine/Graph.hs index 237f702a8..97c9b5f28 100644 --- a/src/Dodge/Combine/Graph.hs +++ b/src/Dodge/Combine/Graph.hs @@ -1,73 +1,82 @@ {-# LANGUAGE LambdaCase #-} -module Dodge.Combine.Graph where -import Dodge.Data.Item -import Dodge.Combine.Combinations -import LensHelp -import GraphHelp -import Data.Text (Text) -import Data.Text.Lazy (toStrict,pack) -import qualified Data.Graph.Inductive as FGL -import GraphVizHelp -import Data.GraphViz.Attributes.Complete +module Dodge.Combine.Graph + ( combinationsDotGraph + ) where + import Data.Bifunctor +import qualified Data.Graph.Inductive as FGL +import Data.GraphViz.Attributes.Complete +import Data.Text (Text) +import Data.Text.Lazy (pack, toStrict) +import Dodge.Combine.Combinations +import Dodge.Data.Item +import GraphHelp +import GraphVizHelp +import LensHelp data CombClust = CraftClust | ItemClust | JoinClust - deriving (Eq,Ord,Show,Enum,Bounded) + deriving (Eq, Ord, Show, Enum, Bounded) -newtype CombNode = CombNode {_unCombNode :: Either ItemType [(ItAmount,ItemType)]} - deriving (Eq,Ord,Show) +newtype CombNode = CombNode {_unCombNode :: Either ItemType [(ItAmount, ItemType)]} + deriving (Eq, Ord, Show) instance Labellable CombNode where toLabelValue (CombNode Right{}) = StrLabel (pack "") toLabelValue (CombNode (Left ibt)) = StrLabel (pack $ show ibt) newtype CombEdge = CombEdge {_unCombEdge :: Int} - deriving (Eq,Ord,Show) + deriving (Eq, Ord, Show) + instance Labellable CombEdge where toLabelValue (CombEdge 0) = StrLabel (pack "") toLabelValue (CombEdge x) = StrLabel (pack $ show x) -bulletCombinations :: [([(ItAmount,ItemType)],Item)] -bulletCombinations = filter - ( (`elem` map totype bulletWeapons) - . totype - . snd - ) itemCombinations - where - totype = _itType +--bulletCombinations :: [([(ItAmount, ItemType)], Item)] +--bulletCombinations = +-- filter +-- ( (`elem` map totype bulletWeapons) +-- . totype +-- . snd +-- ) +-- itemCombinations +-- where +-- totype = _itType maxShowX :: ItemType -> Maybe Int maxShowX = \case HELD (BANGSTICK _) -> Just 2 HELD (VOLLEYGUN _) -> Just 3 - HELD (MINIGUNX _) -> Just 3 + HELD (MINIGUNX _) -> Just 3 HELD (GRAPECANNON _) -> Just 1 HELD (LAUNCHERX _) -> Just 2 --- HELD (LASWIDE _) -> Just 2 --- LASGUNFOCUS _ -> Just 2 + -- HELD (LASWIDE _) -> Just 2 + -- LASGUNFOCUS _ -> Just 2 _ -> Nothing -itemCombinationsEdges :: [(CombNode,CombNode,Int)] +itemCombinationsEdges :: [(CombNode, CombNode, Int)] itemCombinationsEdges = concatMap (f . over _2 _itType) itemCombinations ---itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) bulletCombinations where - f (abts,bt) + --itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) bulletCombinations + + f (abts, bt) | bt `elem` bts = [] | (not . all belowNumX) bts = [] - | otherwise = (CombNode $ Right abts,CombNode $ Left bt,0) : map g abts + | otherwise = (CombNode $ Right abts, CombNode $ Left bt, 0) : map g abts where bts = map snd abts - g (am,bt') = (CombNode $ Left bt',CombNode $ Right abts,_getItAmount am) + g (am, bt') = (CombNode $ Left bt', CombNode $ Right abts, _getItAmount am) combinationsGraph :: FGL.Gr CombNode CombEdge -combinationsGraph = FGL.labnfilter (f . _unCombNode . snd) - . second CombEdge $ mkGraphFromEdges itemCombinationsEdges +combinationsGraph = + FGL.labnfilter (f . _unCombNode . snd) + . second CombEdge + $ mkGraphFromEdges itemCombinationsEdges where - f Right {} = True + f Right{} = True f (Left (CRAFT _)) = False f (Left bt) = case maxShowX bt of Nothing -> True @@ -78,61 +87,65 @@ belowNumX bt = case maxShowX bt of Nothing -> True Just i -> _xNum (_ibtHeld bt) <= i -toCombNodeLabel :: CombNode -> String -toCombNodeLabel (CombNode (Left ibt)) = show ibt -toCombNodeLabel (CombNode Right{}) = "" +--toCombNodeLabel :: CombNode -> String +--toCombNodeLabel (CombNode (Left ibt)) = show ibt +--toCombNodeLabel (CombNode Right{}) = "" combinationsDotGraph :: Text --combinationsDotGraph = toStrict . printDotGraph . graphToDot nonClusteredParams $ combinationsGraph -combinationsDotGraph = toStrict . printDotGraph . graphToDot myParams - $ combinationsGraph +combinationsDotGraph = + toStrict . printDotGraph . graphToDot myParams $ + combinationsGraph + -- $ first toCombNodeLabel combinationsGraph myParams :: GraphvizParams Int CombNode CombEdge CombClust CombNode -myParams = defaultParams -- {globalAttributes = [GraphAttrs [RankDir FromLeft]]} - & isDirectedL .~ True --- & globalAttributesL .~ [GraphAttrs [RankDir FromLeft,Splines PolyLine]] - & globalAttributesL .~ [GraphAttrs [RankDir FromLeft]] - & clusterByL .~ clusterFunc - & isDotClusterL .~ const False - & clusterIDL .~ setClusterID - & fmtClusterL .~ clusterFormatting - & fmtEdgeL .~ edgeFormatting - & fmtNodeL .~ nodeFormatting +myParams = + defaultParams -- {globalAttributes = [GraphAttrs [RankDir FromLeft]]} + & isDirectedL .~ True + -- & globalAttributesL .~ [GraphAttrs [RankDir FromLeft,Splines PolyLine]] + & globalAttributesL .~ [GraphAttrs [RankDir FromLeft]] + & clusterByL .~ clusterFunc + & isDotClusterL .~ const False + & clusterIDL .~ setClusterID + & fmtClusterL .~ clusterFormatting + & fmtEdgeL .~ edgeFormatting + & fmtNodeL .~ nodeFormatting setClusterID :: CombClust -> GraphID setClusterID = Num . Int . fromEnum -clusterFunc :: (Int,CombNode) -> NodeCluster CombClust (Int,CombNode) -clusterFunc n@(_,CombNode (Left bt)) = case bt of +clusterFunc :: (Int, CombNode) -> NodeCluster CombClust (Int, CombNode) +clusterFunc n@(_, CombNode (Left bt)) = case bt of CRAFT _ -> C CraftClust (N n) _ -> C ItemClust (N n) clusterFunc n = C JoinClust (N n) clusterFormatting :: CombClust -> [GlobalAttributes] clusterFormatting cl = case cl of --- CraftClust -> [GraphAttrs [Rank SameRank]] + -- CraftClust -> [GraphAttrs [Rank SameRank]] CraftClust -> [] _ -> [] -edgeFormatting :: (Int,Int,CombEdge) -> Attributes +edgeFormatting :: (Int, Int, CombEdge) -> Attributes --edgeFormatting (_,_,CombEdge 0) = [] -- [ArrowHead (AType [(ArrMod OpenArrow BothSides ,NoArrow)]) -- ,SameTail (pack "b") -- ] -edgeFormatting (_,_,ce) = case _unCombEdge ce of - 0 -> [ xLabel ce +edgeFormatting (_, _, ce) = case _unCombEdge ce of + 0 -> + [ xLabel ce , TailPort (CompassPoint East) ] - _ -> [ xLabel ce - , ArrowHead (AType [(ArrMod OpenArrow BothSides ,NoArrow)]) + _ -> + [ xLabel ce + , ArrowHead (AType [(ArrMod OpenArrow BothSides, NoArrow)]) , HeadPort (CompassPoint West) ] - -nodeFormatting :: (Int,CombNode) -> Attributes -nodeFormatting (_,CombNode Right {}) = [Shape PointShape] -nodeFormatting (_,CombNode cn@(Left bt)) = case bt of +nodeFormatting :: (Int, CombNode) -> Attributes +nodeFormatting (_, CombNode Right{}) = [Shape PointShape] +nodeFormatting (_, CombNode cn@(Left bt)) = case bt of --CRAFT _ -> [Shape DiamondShape,toLabel (CombNode cn)] - CRAFT _ -> [Color [WC (X11Color Green) Nothing],toLabel (CombNode cn)] - _ -> [Shape BoxShape,toLabel (CombNode cn)] + CRAFT _ -> [Color [WC (X11Color Green) Nothing], toLabel (CombNode cn)] + _ -> [Shape BoxShape, toLabel (CombNode cn)] diff --git a/src/Dodge/Concurrent.hs b/src/Dodge/Concurrent.hs index 7f0ae44fc..d1ec74095 100644 --- a/src/Dodge/Concurrent.hs +++ b/src/Dodge/Concurrent.hs @@ -1,30 +1,28 @@ -module Dodge.Concurrent - ( hardQuit - , addSideEffect - , conEffects - , blockingLoad - ) where +module Dodge.Concurrent ( + hardQuit, + addSideEffect, + conEffects, + blockingLoad, +) where ---import qualified Data.Set as S +import Data.Sequence (Seq (..)) +import Dodge.Data.Universe import Dodge.Menu.Loading import LensHelp -import Dodge.Data.Universe -import Data.Sequence (Seq (..)) - ---import Control.Concurrent ---import SDL.Input.Keyboard.Codes conEffects :: Universe -> ConcurrentEffect Universe conEffects u = case u ^? uvSideEffects . _head of - Just NewSideEffect{_ceSideEffect = eff} -> ConcurrentEffect (u & uvSideEffects . _head %~ g) - (dopop eff) + Just NewSideEffect{_ceSideEffect = eff} -> + ConcurrentEffect + (u & uvSideEffects . _head %~ g) + (dopop eff) Just HardQuit -> ImmediateEffect (return Nothing) _ -> NoConcurrentEffect where g seff = RunningSideEffect (_ceString seff) dopop :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe) dopop mf = do - f <- mf + f <- mf return $ f . (uvSideEffects %~ taker) taker (_ :<| xs) = xs taker _ = mempty @@ -36,8 +34,9 @@ hardQuit :: Universe -> Universe hardQuit = uvSideEffects %~ (HardQuit <|) blockingLoad :: String -> IO (Universe -> Maybe Universe) -> Universe -> Universe -blockingLoad str f u = u & uvScreenLayers .:~ loadingScreen str - & addSideEffect f str +blockingLoad str f u = + u & uvScreenLayers .:~ loadingScreen str + & addSideEffect f str --hardQuit = addSideEffect (return $ const Nothing) "QUITTING" diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index d3a4cc905..10434e50d 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -21,11 +21,6 @@ data CursorDisplay = BoundaryCursor {_cursSides :: [CardinalPoint]} | BackdropCursor -data SelectionList a = SelectionList - { _slItems :: [SelectionItem a] --- , _slSelPos :: Maybe Int - } - data SectionCursor = SectionCursor { _scurPos :: Int , _scurSize :: Int @@ -66,7 +61,6 @@ data SelectionItem a } makeLenses ''ListDisplayParams -makeLenses ''SelectionList makeLenses ''SelectionItem makeLenses ''SelectionSection makeLenses ''SectionCursor diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 8e870144b..b3563e3e0 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -81,7 +81,7 @@ data ScreenLayer , _scOffset :: Int , _scPositionedMenuOption :: EscapeMenuOption , _scOptionFlag :: OptionScreenFlag - , _scSelectionList :: SelectionList (Universe -> Universe,Universe->Universe) + , _scSelectionList :: [SelectionItem (Universe -> Universe,Universe->Universe)] , _scAvailableLines :: Int , _scListDisplayParams :: ListDisplayParams , _scDisplayTime :: Int diff --git a/src/Dodge/Default/SelectionList.hs b/src/Dodge/Default/SelectionList.hs deleted file mode 100644 index 53f1aa42b..000000000 --- a/src/Dodge/Default/SelectionList.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Dodge.Default.SelectionList where - -import Dodge.Data.SelectionList - -defaultSelectionList :: SelectionList a -defaultSelectionList = SelectionList - {_slItems = mempty - } diff --git a/src/Dodge/Menu/Loading.hs b/src/Dodge/Menu/Loading.hs index b67fa4de9..c63b0fdd7 100644 --- a/src/Dodge/Menu/Loading.hs +++ b/src/Dodge/Menu/Loading.hs @@ -1,18 +1,20 @@ -module Dodge.Menu.Loading where +module Dodge.Menu.Loading ( + loadingScreen, +) where -import Dodge.ListDisplayParams -import Dodge.Default.SelectionList import Dodge.Data.Universe +import Dodge.ListDisplayParams loadingScreen :: String -> ScreenLayer -loadingScreen str = OptionScreen - { _scTitle = str - , _scOptions = [] - , _scOffset = 0 - , _scPositionedMenuOption = NoEscapeMenuOption - , _scOptionFlag = LoadingScreen - , _scSelectionList = defaultSelectionList - , _scAvailableLines = 0 - , _scListDisplayParams = optionListDisplayParams - , _scDisplayTime = 0 - } +loadingScreen str = + OptionScreen + { _scTitle = str + , _scOptions = [] + , _scOffset = 0 + , _scPositionedMenuOption = NoEscapeMenuOption + , _scOptionFlag = LoadingScreen + , _scSelectionList = [] + , _scAvailableLines = 0 + , _scListDisplayParams = optionListDisplayParams + , _scDisplayTime = 0 + } diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 952194fd5..895238571 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -1,17 +1,21 @@ -module Dodge.Menu.Option where +module Dodge.Menu.Option ( + initializeOptionMenu, + refreshOptionsSelectionList, + initializeOptionMenuBO, +) where -import Dodge.ListDisplayParams import Control.Applicative import Data.Maybe import Dodge.Data.SelectionList import Dodge.Data.Universe -import Dodge.Default.SelectionList +import Dodge.ListDisplayParams import Dodge.SelectionList import LensHelp import Padding import Picture.Base -initializeOptionMenu :: String -> [MenuOption] -> EscapeMenuOption -> Universe -> ScreenLayer +initializeOptionMenu :: + String -> [MenuOption] -> EscapeMenuOption -> Universe -> ScreenLayer initializeOptionMenu title ops pmo u = OptionScreen { _scTitle = title @@ -19,14 +23,15 @@ initializeOptionMenu title ops pmo u = , _scOffset = 0 , _scPositionedMenuOption = pmo , _scOptionFlag = NormalOptions - , _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops pmo + , _scSelectionList = optionsToSelections 10 u ops pmo , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig) , _scListDisplayParams = optionListDisplayParams , _scDisplayTime = 0 } -- BO = Bottom Option -initializeOptionMenuBO :: String -> [MenuOption] -> String -> (Universe -> Universe) -> Universe -> ScreenLayer +initializeOptionMenuBO :: + String -> [MenuOption] -> String -> (Universe -> Universe) -> Universe -> ScreenLayer initializeOptionMenuBO title ops str eff = initializeOptionMenu title ops pmo where pmo = BottomEscapeMenuOption $ (Toggle eff . const . MODString) str @@ -40,22 +45,9 @@ refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f , _scPositionedMenuOption = pmo , _scAvailableLines = maxlines } -> - sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops pmo + sl & scSelectionList .~ optionsToSelections maxlines u mops pmo _ -> sl -makeOptionsSelectionList :: - Int -> - Maybe Int -> - Universe -> - [MenuOption] -> - EscapeMenuOption -> - SelectionList (Universe -> Universe, Universe -> Universe) -makeOptionsSelectionList maxlines mselpos u mos pmo = - defaultSelectionList - { _slItems = optionsToSelections maxlines u mos pmo --- , _slSelPos = mselpos - } - optionsToSelections :: Int -> Universe -> @@ -72,8 +64,10 @@ optionsToSelections maxlines u allops pmo = case pmo of | maxlines >= length allops = allops | otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption] maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops) - cycleOptionsOption = Toggle cycleOptions - (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m))) + cycleOptionsOption = + Toggle + cycleOptions + (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m))) l = length allops m = div (l - 1) (max 1 (maxlines - 2)) + 1 n = div (offset + 1) (max 1 (maxlines - 2)) + 1 @@ -92,16 +86,16 @@ cycleOptions u = fromMaybe u $ do | l + curoff >= n = 0 | otherwise = l + curoff -colStrToSelItem :: (Color, String) -> SelectionItem (Universe -> Universe) -colStrToSelItem (col, str) = - SelectionItem - { _siPictures = [str] - , _siHeight = 1 - , _siIsSelectable = True - , _siColor = col - , _siOffX = 0 - , _siPayload = id - } +--colStrToSelItem :: (Color, String) -> SelectionItem (Universe -> Universe) +--colStrToSelItem (col, str) = +-- SelectionItem +-- { _siPictures = [str] +-- , _siHeight = 1 +-- , _siIsSelectable = True +-- , _siColor = col +-- , _siOffX = 0 +-- , _siPayload = id +-- } optionValueOffset :: Universe -> MenuOption -> Int optionValueOffset u mo = case _moString mo u of @@ -135,12 +129,12 @@ menuOptionToSelectionItem w padAmount mo = MODStringOption s t -> rightPad padAmount '.' s ++ t x -> _modString x -menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String) -menuOptionToString w padAmount mo = (thecol, optionText) - where - thecol = case _moString mo w of - MODBlockedString{} -> greyN 0.5 - _ -> white - optionText = case _moString mo w of - MODStringOption s t -> rightPad padAmount '.' s ++ t - x -> _modString x +--menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String) +--menuOptionToString w padAmount mo = (thecol, optionText) +-- where +-- thecol = case _moString mo w of +-- MODBlockedString{} -> greyN 0.5 +-- _ -> white +-- optionText = case _moString mo w of +-- MODStringOption s t -> rightPad padAmount '.' s ++ t +-- x -> _modString x diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 5641b7c06..e03b854d2 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -24,7 +24,6 @@ import Dodge.Data.Config import Dodge.Data.DoubleTree import Dodge.Data.SelectionList import Dodge.Data.World -import Dodge.Default.SelectionList import Dodge.DoubleTree import Dodge.Equipment.Text import Dodge.Inventory @@ -180,15 +179,14 @@ drawExamineInventory cfig w = <> drawSelectionList secondColumnParams cfig - ( defaultSelectionList & slItems - .~ map f + ( (map f ( makeParagraph 55 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w))) w - ) + )) ) where f str = @@ -359,7 +357,7 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig) where toselitm (str, col) = SelectionItem [str] 1 True col 0 () - thesellist tm = defaultSelectionList & slItems .~ thelist tm + thesellist tm = thelist tm thelist tm = map toselitm . displayTermInput tm . reverse diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index df42d48f6..101cf75fe 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -31,7 +31,7 @@ import LensHelp import ListHelp import Picture -drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture +drawSelectionList :: ListDisplayParams -> Configuration -> [SelectionItem a] -> Picture drawSelectionList ldps cfig sl = translateScreenPos cfig (ldps ^. ldpPos) $ drawListYgapScaleYoff @@ -59,8 +59,8 @@ drawSelectionListBackground ldp cfig l = translateScreenPos cfig (ldp ^. ldpPos) s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap)) e = 555 -- HACK isOverTerminalScreen -makeSelectionListPictures :: SelectionList a -> [Picture] -makeSelectionListPictures = concatMap f . _slItems +makeSelectionListPictures :: [SelectionItem a] -> [Picture] +makeSelectionListPictures = concatMap f where f si = map (color (_siColor si) . text) $ _siPictures si diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 077d3721f..834c8bb59 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -38,7 +38,7 @@ drawOptions :: -- | Title String -> Maybe Int -> - SelectionList a -> + [SelectionItem a] -> Picture drawOptions ldps cfig title msel sl = darkenBackground cfig @@ -46,7 +46,7 @@ drawOptions ldps cfig title msel sl = <> drawSelectionList ldps cfig sl <> translateScreenPos cfig (ldps ^. ldpPos) (drawCursorAt msel - (sl ^. slItems) + sl ldps (BoundaryCursor [North, South]) ) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1be941981..f68cd747d 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -401,16 +401,15 @@ updateMouseContext cfig u = [] -> NoMouseContext _ -> fromMaybe MouseMenuCursor $ do ldps <- screen ^? scListDisplayParams - let ymax = maybe 0 length $ screen ^? scSelectionList . slItems + let ymax = maybe 0 length $ screen ^? scSelectionList yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos) --- guard $ mmoving || (_scDisplayTime screen <= 1) guard (yi >= 0 && yi < ymax) return $ if isselectable yi then MouseMenuClick yi else NoMouseContext isselectable yi = fromMaybe False $ - u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable + u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable -- mmoving = u ^. uvWorld . input . mouseMoving w = u ^. uvWorld aimcontext diff --git a/src/Dodge/Update/Input/ScreenLayer.hs b/src/Dodge/Update/Input/ScreenLayer.hs index 22cc74287..5674b22c2 100644 --- a/src/Dodge/Update/Input/ScreenLayer.hs +++ b/src/Dodge/Update/Input/ScreenLayer.hs @@ -62,12 +62,12 @@ mouseClickOptionsList u = fromMaybe u $ do Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of Just 0 -> fromMaybe u $ do i <- u ^? uvWorld . input . mouseContext . mcoMenuClick - f <- sl ^? slItems . ix i . siPayload . _1 + f <- sl ^? ix i . siPayload . _1 return $ f u _ -> case u ^. uvWorld . input . mouseButtons . at ButtonRight of Just 0 -> fromMaybe u $ do i <- u ^? uvWorld . input . mouseContext . mcoMenuClick - f <- sl ^? slItems . ix i . siPayload . _2 + f <- sl ^? ix i . siPayload . _2 return $ f u _ -> u