Work on terminal tab completion/scrolling
This commit is contained in:
+165
-90
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Dodge.Terminal (
|
||||
makeTermLine,
|
||||
@@ -10,10 +11,15 @@ module Dodge.Terminal (
|
||||
makeTermPara,
|
||||
terminalReturnEffect,
|
||||
getCommands,
|
||||
tabComplete,
|
||||
-- tabComplete,
|
||||
tlSetStatus,
|
||||
tlDoEffect,
|
||||
termTextColor,
|
||||
doTabComplete,
|
||||
-- recComFindSuccessor,
|
||||
-- recComFindPredecessor,
|
||||
recComFindMin,
|
||||
recComFindMax,
|
||||
) where
|
||||
|
||||
import Color
|
||||
@@ -30,6 +36,7 @@ import Dodge.Terminal.Type
|
||||
import Justify
|
||||
import LensHelp
|
||||
import Sound.Data
|
||||
import Control.Applicative
|
||||
|
||||
textTerminal :: Terminal
|
||||
textTerminal = defaultTerminal{_tmBootLines = textInputBlurb []}
|
||||
@@ -46,27 +53,26 @@ termSoundLine = TLine 0 [] . TmWdWdTermSound
|
||||
termTextColor :: Color
|
||||
termTextColor = greyN 0.9
|
||||
|
||||
getCommands :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
--type TCommands = PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
type TCommands = RecCommands [TerminalLine]
|
||||
|
||||
getCommands :: World -> Terminal -> TCommands
|
||||
getCommands w tm = foldMap (getCommand w tm) $ tm ^. tmCommands
|
||||
|
||||
getCommand ::
|
||||
World ->
|
||||
Terminal ->
|
||||
TCom ->
|
||||
PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
getCommand :: World -> Terminal -> TCom -> TCommands
|
||||
getCommand w tm = \case
|
||||
TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
|
||||
TCInfo x z -> RCommands $ PTE.singleton x (Right (makeTermPara z))
|
||||
TCBase -> quitCommand <> toggleCommands tm
|
||||
TCDamageCommand -> damageCodeCommand w tm
|
||||
|
||||
damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
damageCodeCommand w _ =
|
||||
PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
|
||||
damageCodeCommand :: World -> Terminal -> TCommands
|
||||
damageCodeCommand w _ = RCommands .
|
||||
PTE.singleton "DAMAGECODE" . Left . RCommands $ PTE.fromList $ mapMaybe f [minBound ..]
|
||||
where
|
||||
f :: SensorType -> Maybe (String, [TerminalLine])
|
||||
f :: SensorType -> Maybe (String, Either TCommands [TerminalLine])
|
||||
f st = do
|
||||
s <- g st
|
||||
return (s, decodeSensorType st w)
|
||||
return (s, Right $ decodeSensorType st w)
|
||||
g =
|
||||
fmap (map toUpper . reverse)
|
||||
. List.stripPrefix (reverse "Sensor")
|
||||
@@ -78,15 +84,16 @@ decodeSensorType st w = fromMaybe [] $ do
|
||||
x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
|
||||
return [makeTermLine $ show x]
|
||||
|
||||
toggleCommands :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
toggleCommands :: Terminal -> TCommands
|
||||
toggleCommands tm
|
||||
| null ts = mempty
|
||||
| otherwise = PTE.singleton "TOGGLE" $ PTE.fromList $ f <$> M.toList ts
|
||||
| otherwise = RCommands . PTE.singleton "TOGGLE" . Left . RCommands . PTE.fromList
|
||||
$ f <$> M.toList ts
|
||||
where
|
||||
ts = tm ^. tmToggles
|
||||
f (s, x) =
|
||||
( s
|
||||
,
|
||||
, Right
|
||||
[ TLine
|
||||
1
|
||||
[TerminalLineConst (s ++ " TOGGLE DONE!") termTextColor]
|
||||
@@ -97,8 +104,8 @@ toggleCommands tm
|
||||
helpPara :: [TerminalLine]
|
||||
helpPara = makeTermPara "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE."
|
||||
|
||||
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdPowerDownTerminal])
|
||||
quitCommand :: TCommands
|
||||
quitCommand = RCommands . PTE.singleton "QUIT" $ Right [TLine 0 [] TmWdWdPowerDownTerminal]
|
||||
|
||||
makeTermLine :: String -> TerminalLine
|
||||
makeTermLine = makeColorTermLine termTextColor
|
||||
@@ -121,51 +128,118 @@ makeColorTermLine col str = TLine 1 [TerminalLineConst str col] TmWdId
|
||||
commandColor :: Color
|
||||
commandColor = yellow
|
||||
|
||||
tabComplete :: World -> Terminal -> Terminal
|
||||
tabComplete w tm = fromMaybe tm $ do
|
||||
--tabComplete :: World -> Terminal -> Terminal
|
||||
--tabComplete w tm = fromMaybe tm $ do
|
||||
-- s <- tm ^? tmStatus . tiText
|
||||
-- return $ tabComplete' s w tm
|
||||
--
|
||||
---- ugly, can improve output to explain when showing available arguments
|
||||
--tabComplete' :: String -> World -> Terminal -> Terminal
|
||||
--tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
|
||||
-- Just m -> f (s ++ " ") $ PTE.toList $ PTE.lookupPrefix a m
|
||||
-- Nothing -> f "" $ PTE.toList $ PTE.lookupPrefix s $ getCommands w tm
|
||||
-- where
|
||||
-- ss = words s'
|
||||
-- s = fromMaybe "" $ ss ^? ix 0
|
||||
-- a = fromMaybe "" $ ss ^? ix 1
|
||||
-- f y m' = case fmap fst m' of
|
||||
-- [] -> tm
|
||||
-- [x] -> tm & tmStatus . tiText .~ (y ++ x)
|
||||
-- xs ->
|
||||
-- tm
|
||||
-- & tmStatus
|
||||
-- .~ TerminalLineRead
|
||||
-- & tmFutureLines
|
||||
-- .~ ( makeColorTermPara
|
||||
-- commandColor
|
||||
-- (unwords xs)
|
||||
-- <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s']
|
||||
-- )
|
||||
|
||||
data TabCompletion a
|
||||
= TabMatch a
|
||||
| TabComplete String
|
||||
| TabMultiComplete [String]
|
||||
| TabFail
|
||||
|
||||
data RecCommands a =
|
||||
RCommands {_rCommands :: (PTE.TrieMap Char (Either (RecCommands a) a))}
|
||||
|
||||
-- assumes that each command Trie has at least one successful command
|
||||
recComFindMin :: RecCommands a -> Maybe ([String], a)
|
||||
recComFindMin (RCommands m) = case PTE.findMin m of
|
||||
Just (s,Right a) -> Just ([s],a)
|
||||
Just (s,Left m') -> recComFindMin m' & _Just . _1 .:~ s
|
||||
Nothing -> Nothing
|
||||
|
||||
recComFindMax :: RecCommands a -> Maybe ([String], a)
|
||||
recComFindMax (RCommands m) = case PTE.findMax m of
|
||||
Just (s,Right a) -> Just ([s],a)
|
||||
Just (s,Left m') -> recComFindMax m' & _Just . _1 .:~ s
|
||||
Nothing -> Nothing
|
||||
|
||||
--recComFindSuccessor :: [String] -> RecCommands a -> Maybe ([String],a)
|
||||
--recComFindSuccessor (s:[]) (RCommands m) = case PTE.lookup s m of
|
||||
-- Just (Left rm) ->
|
||||
-- _ -> do
|
||||
-- (s',_) <- PTE.findSuccessor s m & _Just . _1 %~ return
|
||||
--recComFindSuccessor (s:ss) (RCommands m)
|
||||
-- = do
|
||||
-- Left rm <- PTE.lookup s m
|
||||
-- recComFindSuccessor ss rm -- & _Just . _1 .:~ s
|
||||
---- fromMaybe (recComFindSuccessor (s:[]) (RCommands m)) $
|
||||
--
|
||||
--recComFindPredecessor :: [String] -> RecCommands a -> Maybe ([String],a)
|
||||
--recComFindPredecessor (s:ss) (RCommands m) = Nothing
|
||||
|
||||
instance Semigroup (RecCommands a) where
|
||||
RCommands x <> RCommands y = RCommands $ x <> y
|
||||
|
||||
instance Monoid (RecCommands a) where
|
||||
mempty = RCommands mempty
|
||||
|
||||
|
||||
tbComplete :: String -> PTE.TrieMap Char a -> TabCompletion a
|
||||
tbComplete s t = case e of
|
||||
[] | Just x <- mx -> TabMatch x
|
||||
[] -> case fmap fst $ PTE.toList t' of
|
||||
[] -> TabFail
|
||||
ss -> TabMultiComplete ss
|
||||
_ -> TabComplete e
|
||||
where
|
||||
(e, mx, t') = PTE.splitPrefix $ PTE.deletePrefix s t
|
||||
|
||||
recTabComplete :: String -> TCommands -> TabCompletion [TerminalLine]
|
||||
recTabComplete s (RCommands t) = fromMaybe (TabMultiComplete $ allstrings $ t) $ do
|
||||
(s1,ss) <- stripHead $ words s
|
||||
case tbComplete s1 t of
|
||||
TabComplete e -> return $ TabComplete e
|
||||
TabMultiComplete es -> return $ TabMultiComplete (fmap (s1 <>) es)
|
||||
TabFail -> return $ TabFail
|
||||
TabMatch (Right x) -> return $ TabMatch x
|
||||
TabMatch (Left rm) -> return $ recTabComplete (unwords ss) rm
|
||||
where
|
||||
stripHead (x:xs) = Just (x,xs)
|
||||
stripHead _ = Nothing
|
||||
allstrings = fmap fst . PTE.toList
|
||||
|
||||
doTabComplete :: World -> Terminal -> Terminal
|
||||
doTabComplete w tm = fromMaybe tm $ do
|
||||
s <- tm ^? tmStatus . tiText
|
||||
return $ tabComplete' s w tm
|
||||
case recTabComplete s $ getCommands w tm of
|
||||
TabMatch _ -> return tm
|
||||
TabComplete e -> return $ tm & tmStatus . tiText <>~ e
|
||||
TabMultiComplete ss -> return $ tm
|
||||
& tmStatus .~ TerminalLineRead
|
||||
& tmFutureLines .~
|
||||
(makeColorTermPara commandColor (unwords ss) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
|
||||
|
||||
-- ugly, can improve output to explain when showing available arguments
|
||||
tabComplete' :: String -> World -> Terminal -> Terminal
|
||||
tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
|
||||
Just m -> f (s ++ " ") $ PTE.toList $ PTE.lookupPrefix a m
|
||||
Nothing -> f "" $ PTE.toList $ PTE.lookupPrefix s $ getCommands w tm
|
||||
where
|
||||
ss = words s'
|
||||
s = fromMaybe "" $ ss ^? ix 0
|
||||
a = fromMaybe "" $ ss ^? ix 1
|
||||
f y m' = case fmap fst m' of
|
||||
[] -> tm
|
||||
[x] -> tm & tmStatus . tiText .~ (y ++ x)
|
||||
xs ->
|
||||
tm
|
||||
& tmStatus
|
||||
.~ TerminalLineRead
|
||||
& tmFutureLines
|
||||
.~ ( makeColorTermPara
|
||||
commandColor
|
||||
(unwords xs)
|
||||
<> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s']
|
||||
)
|
||||
|
||||
tComplete
|
||||
:: String
|
||||
-> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
-> Either (String,[String]) (String,[String])
|
||||
tComplete s pt = fromMaybe (Left (mempty,allcommands pt)) $ do
|
||||
s1 <- words s ^? ix 0
|
||||
let (e1,mx,pt') = PTE.splitPrefix $ PTE.deletePrefix s1 pt
|
||||
case e1 of
|
||||
[] -> do
|
||||
pt'' <- mx
|
||||
return $ fromMaybe (Right (mempty, allcommands pt'')) $ do
|
||||
s2 <- words s ^? ix 1
|
||||
let (e2,_,pt3) = PTE.splitPrefix $ PTE.deletePrefix s2 pt''
|
||||
Just $ Right (e2, allcommands pt3)
|
||||
_ -> Just $ Left (e1, allcommands pt')
|
||||
where
|
||||
allcommands = fmap fst . PTE.toList
|
||||
TabFail -> return tm
|
||||
-- (e,Right x) -> return $ tm & tmStatus . tiText .~ e
|
||||
-- (e,Left ss) -> return $ tm
|
||||
-- & tmStatus .~ TerminalLineRead
|
||||
-- & tmFutureLines .~ (makeColorTermPara commandColor (unwords ss) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput e])
|
||||
|
||||
-- damageCodeCommand :: TerminalCommand
|
||||
-- damageCodeCommand =
|
||||
@@ -193,33 +267,34 @@ simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs
|
||||
|
||||
-- list available arguments on function input?
|
||||
terminalReturnEffect :: Int -> World -> World
|
||||
terminalReturnEffect tmid w = fromMaybe w $ do
|
||||
tm' <- w ^? cWorld . lWorld . terminals . ix tmid
|
||||
let tm = tabComplete w tm'
|
||||
s <- tm ^? tmStatus . tiText
|
||||
let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
|
||||
let args = words s
|
||||
case args of
|
||||
[] -> return helpPara
|
||||
(x : _) -> do
|
||||
teff <- PTE.lookup x (getCommands w tm)
|
||||
let y = fromMaybe "" (args ^? ix 1)
|
||||
PTE.lookup y teff
|
||||
return $
|
||||
w
|
||||
& totm
|
||||
. tmDisplayedLines
|
||||
.:~ (getPromptTM ++ s, termTextColor)
|
||||
& totm
|
||||
. tmFutureLines
|
||||
.~ ss
|
||||
<> tlSetStatus (TerminalTextInput "")
|
||||
& totm
|
||||
. tmCommandHistory
|
||||
%~ take 10
|
||||
. (s :)
|
||||
& totm
|
||||
. tmStatus
|
||||
.~ TerminalLineRead
|
||||
where
|
||||
totm = cWorld . lWorld . terminals . ix tmid
|
||||
terminalReturnEffect tmid w = w
|
||||
-- fromMaybe w $ do
|
||||
-- tm' <- w ^? cWorld . lWorld . terminals . ix tmid
|
||||
-- let tm = tabComplete w tm'
|
||||
-- s <- tm ^? tmStatus . tiText
|
||||
-- let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
|
||||
-- let args = words s
|
||||
-- case args of
|
||||
-- [] -> return helpPara
|
||||
-- (x : _) -> do
|
||||
-- teff <- PTE.lookup x (getCommands w tm)
|
||||
-- let y = fromMaybe "" (args ^? ix 1)
|
||||
-- PTE.lookup y teff
|
||||
-- return $
|
||||
-- w
|
||||
-- & totm
|
||||
-- . tmDisplayedLines
|
||||
-- .:~ (getPromptTM ++ s, termTextColor)
|
||||
-- & totm
|
||||
-- . tmFutureLines
|
||||
-- .~ ss
|
||||
-- <> tlSetStatus (TerminalTextInput "")
|
||||
-- & totm
|
||||
-- . tmCommandHistory
|
||||
-- %~ take 10
|
||||
-- . (s :)
|
||||
-- & totm
|
||||
-- . tmStatus
|
||||
-- .~ TerminalLineRead
|
||||
-- where
|
||||
-- totm = cWorld . lWorld . terminals . ix tmid
|
||||
|
||||
@@ -422,7 +422,7 @@ updateKeysTextInputTerminal tmid u =
|
||||
| otherwise = id
|
||||
tryTabComplete
|
||||
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 =
|
||||
uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld)
|
||||
uvWorld . cWorld . lWorld . terminals . ix tmid %~ doTabComplete (u ^. uvWorld)
|
||||
| otherwise = id
|
||||
|
||||
updateKeyInGame :: Universe -> Scancode -> Int -> Universe
|
||||
|
||||
+67
-69
@@ -1,11 +1,9 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Update.Scroll (
|
||||
updateWheelEvent,
|
||||
) where
|
||||
module Dodge.Update.Scroll (updateWheelEvent) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
|
||||
--import qualified Data.ListTrie.Patricia.Map.Enum as PTE
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Dodge.Base
|
||||
@@ -130,74 +128,74 @@ moveCombineSel yi =
|
||||
|
||||
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 %~ g
|
||||
-- | 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
|
||||
where
|
||||
dowrap = if yi > 0 then wrapup else wrapdown
|
||||
wrapup s coms = PTE.findSuccessor s coms <|> PTE.findMin coms
|
||||
wrapdown s coms = PTE.findPredecessor s coms <|> PTE.findMax coms
|
||||
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
|
||||
return $ tm & tmStatus . tiText .~ 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
|
||||
-- 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
|
||||
-- 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
|
||||
-- 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
|
||||
--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
|
||||
|
||||
Reference in New Issue
Block a user