diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 6c352928a..c26f6cb76 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -206,7 +206,7 @@ recComFindPredecessor (s:ss) (RCommands m) Just (s',Right x) -> Just ([s'],x) Just (s',Left rm') -> recComFindMax rm' & _Just . _1 .:~ s' Nothing -> Nothing -recComFindPredecessor [] _ = Nothing +recComFindPredecessor [] rm = recComFindMax rm -- --recComFindPredecessor :: [String] -> RecCommands a -> Maybe ([String],a) --recComFindPredecessor (s:ss) (RCommands m) = Nothing diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 649c5bab2..22b21a7d4 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -1,9 +1,7 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Update.Scroll (updateWheelEvent) where -import Control.Applicative import Control.Monad ---import qualified Data.ListTrie.Patricia.Map.Enum as PTE import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base @@ -127,76 +125,14 @@ moveCombineSel yi = return $ ci & ciSelection %~ scrollSelectionSections yi sss terminalWheelEvent :: Int -> Int -> World -> World -terminalWheelEvent yi tmid w --- | w & has (input . mouseButtons . ix ButtonRight) --- , Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus = --- w & cWorld . lWorld . terminals . ix tmid %~ f - | Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus = - w & cWorld . lWorld . terminals . ix tmid %~ f - | otherwise = w +terminalWheelEvent yi tmid w = w & cWorld . lWorld . terminals . ix tmid %~ f where - dowrap = if yi > 0 then wrapup else wrapdown - wrapup s coms = recComFindSuccessor (words s) coms -- <|> recComFindMin coms - wrapdown s coms = recComFindPredecessor (words s) coms -- <|> recComFindMax coms + dowrap = if yi > 0 then recComFindSuccessor else recComFindPredecessor f tm = fromMaybe tm $ do let coms = getCommands w tm - x <- tm ^? tmStatus . tiText - let s = fromMaybe "" $ x ^? to words . ix 0 - --(s', _) <- dowrap s coms + x <- words <$> tm ^? tmStatus . tiText (s', _) <- dowrap x coms return $ tm & tmStatus . tiText .~ unwords s' ----- g tm = fromMaybe tm $ do ----- let coms = getCommands w tm ----- x <- tm ^? tmStatus . tiText ----- let s = fromMaybe "" $ x ^? to words . ix 0 ----- y = fromMaybe "" $ x ^? to words . ix 1 ----- (s', arg, _) <- ----- if yi > 0 ----- then doubleFindSucc s y coms <|> doubleFindMin coms ----- else doubleFindPred s y coms <|> doubleFindMax coms ----- return $ tm & tmStatus . tiText .~ s' ++ " " ++ arg - ---doubleFindMin :: (Enum a, Enum b) => PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a], [b], c) ---doubleFindMin m = do --- (x, n) <- PTE.findMin m --- case PTE.findMin n of --- Just (y, z) -> Just (x, y, z) --- Nothing -> Nothing --- ---doubleFindSucc :: (Enum a, Enum b) => [a] -> [b] -> PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a], [b], c) ---doubleFindSucc xs ys m = case PTE.lookup xs m of --- Just m' -> case PTE.findSuccessor ys m' of --- Just (ys', z) -> Just (xs, ys', z) --- Nothing -> dfs xs m --- Nothing -> dfs xs m --- where --- dfs xs' m' = case PTE.findSuccessor xs' m' of --- Just (xs'', n) -> case PTE.findMin n of --- Just (ys', z) -> Just (xs'', ys', z) --- Nothing -> dfs xs'' m' --- Nothing -> Nothing --- ----- there are edge cases where this doesn't behave as might be expected ---doubleFindMax :: (Enum a, Enum b) => PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a], [b], c) ---doubleFindMax m = do --- (x, n) <- PTE.findMax m --- case PTE.findMax n of --- Just (y, z) -> Just (x, y, z) --- Nothing -> Nothing --- ---doubleFindPred :: --- (Enum a, Enum b) => [a] -> [b] -> PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a], [b], c) ---doubleFindPred xs ys m = case PTE.lookup xs m of --- Just m' -> case PTE.findPredecessor ys m' of --- Just (ys', z) -> Just (xs, ys', z) --- Nothing -> dfs xs m --- Nothing -> dfs xs m --- where --- dfs xs' m' = case PTE.findPredecessor xs' m' of --- Just (xs'', n) -> case PTE.findMax n of --- Just (ys', z) -> Just (xs'', ys', z) --- Nothing -> dfs xs'' m' --- Nothing -> Nothing scrollRBOption :: Int -> Int -> Int -> Int scrollRBOption dy ymax