Fix terminal scrolling

src/Dodge/Terminal.hs

@@ -16,10 +16,11 @@ module Dodge.Terminal (
     tlDoEffect,
     termTextColor,
     doTabComplete,
---    recComFindSuccessor,
+    recComFindSuccessor,
---    recComFindPredecessor,
+    recComFindPredecessor,
     recComFindMin,
     recComFindMax,
+    recComLookup,
 ) where
 
 import Color
@@ -36,7 +37,6 @@ import Dodge.Terminal.Type
 import Justify
 import LensHelp
 import Sound.Data
-import Control.Applicative
 
 textTerminal :: Terminal
 textTerminal = defaultTerminal{_tmBootLines = textInputBlurb []}
@@ -101,8 +101,8 @@ toggleCommands tm
             ]
         )
 
-helpPara :: [TerminalLine]
+--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."
+--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 :: TCommands
 quitCommand = RCommands . PTE.singleton "QUIT" $ Right [TLine 0 [] TmWdWdPowerDownTerminal]
@@ -178,16 +178,35 @@ recComFindMax (RCommands m) = case PTE.findMax m of
     Just (s,Left m') -> recComFindMax m' & _Just . _1 .:~ s
     Nothing -> Nothing
 
---recComFindSuccessor :: [String] -> RecCommands a -> Maybe ([String],a)
+recComLookup :: [String] -> RecCommands a -> Maybe a
---recComFindSuccessor (s:[]) (RCommands m) = case PTE.lookup s m of
+recComLookup (s:ss) (RCommands t) = do
---    Just (Left rm) ->
+    x <- PTE.lookup s t
---    _ -> do
+    case x of
---        (s',_) <- PTE.findSuccessor s m & _Just . _1 %~ return
+        Left m -> recComLookup ss m
---recComFindSuccessor (s:ss) (RCommands m) 
+        Right y -> return y
---    = do
+recComLookup [] _ = Nothing
---        Left rm <- PTE.lookup s m
+
---        recComFindSuccessor ss rm -- & _Just . _1 .:~ s
+-- assumes that the commands are well-formed, i.e. every tree does end in a
-----    fromMaybe (recComFindSuccessor (s:[]) (RCommands m)) $ 
+-- command
+recComFindSuccessor :: [String] -> RecCommands a -> Maybe ([String],a)
+recComFindSuccessor (s:ss) (RCommands m)
+    | Just (Left rm) <- PTE.lookup s m
+    , Just (ss', x) <- recComFindSuccessor ss rm = Just (s:ss',x)
+    | otherwise = case PTE.findSuccessor s m of
+            Just (s',Right x) -> Just ([s'],x)
+            Just (s',Left rm') -> recComFindMin rm' & _Just . _1 .:~ s'
+            Nothing -> Nothing
+recComFindSuccessor [] rm = recComFindMin rm
+
+recComFindPredecessor :: [String] -> RecCommands a -> Maybe ([String],a)
+recComFindPredecessor (s:ss) (RCommands m)
+    | Just (Left rm) <- PTE.lookup s m
+    , Just (ss', x) <- recComFindPredecessor ss rm = Just (s:ss',x)
+    | otherwise = case PTE.findPredecessor s m of
+            Just (s',Right x) -> Just ([s'],x)
+            Just (s',Left rm') -> recComFindMax rm' & _Just . _1 .:~ s'
+            Nothing -> Nothing
+recComFindPredecessor [] _ = Nothing
 --
 --recComFindPredecessor :: [String] -> RecCommands a -> Maybe ([String],a)
 --recComFindPredecessor (s:ss) (RCommands m) = Nothing
@@ -232,14 +251,9 @@ doTabComplete w tm = fromMaybe tm $ do
         TabMultiComplete ss -> return $ tm 
             & tmStatus .~ TerminalLineRead
             & tmFutureLines .~ 
+            [TLine 0 [TerminalLineConst (getPromptTM <> s) termTextColor] TmWdId] <>
             (makeColorTermPara commandColor (unwords ss) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
-
-
         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 =
@@ -267,7 +281,25 @@ simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs
 
 -- list available arguments on function input?
 terminalReturnEffect :: Int -> World -> World
-terminalReturnEffect tmid w = w
+terminalReturnEffect tmid w = w 
+    & cWorld . lWorld . terminals . ix tmid %~ terminalReturnLocal w
+
+terminalReturnLocal :: World -> Terminal -> Terminal
+terminalReturnLocal w tm = fromMaybe tm $ do
+    s <- tm ^? tmStatus . tiText
+    return $ tm 
+        & tmFutureLines .~ [TLine 0 [TerminalLineConst (getPromptTM <> s) termTextColor] TmWdId]
+        & case recTabComplete s $ getCommands w tm of
+            TabMatch x -> (tmStatus .~ TerminalLineRead )
+                . (tmFutureLines <>~ (x<>tlSetStatus (TerminalTextInput "")))
+            TabComplete e -> tmStatus . tiText <>~ e
+            TabMultiComplete ss ->
+                (tmStatus .~ TerminalLineRead)
+                . ( tmFutureLines <>~ 
+                (makeColorTermPara commandColor (unwords ss) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
+                )
+            TabFail -> id
+
 -- fromMaybe w $ do
 --    tm' <- w ^? cWorld . lWorld . terminals . ix tmid
 --    let tm = tabComplete w tm'

src/Dodge/Update/Scroll.hs

@@ -131,19 +131,20 @@ 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 =
+    | Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
---        w & cWorld . lWorld . terminals . ix tmid %~ f
+        w & cWorld . lWorld . terminals . ix tmid %~ f
     | otherwise = w
   where
---    dowrap = if yi > 0 then wrapup else wrapdown
+    dowrap = if yi > 0 then wrapup else wrapdown
---    wrapup s coms = recComFindSuccessor (words s) coms <|> recComFindMin coms
+    wrapup s coms = recComFindSuccessor (words s) coms -- <|> recComFindMin coms
---    wrapdown s coms = recComFindPredecessor (words s) coms <|> recComFindMax coms
+    wrapdown s coms = recComFindPredecessor (words s) coms -- <|> recComFindMax coms
---    f tm = fromMaybe tm $ do
+    f tm = fromMaybe tm $ do
---        let coms = getCommands w tm
+        let coms = getCommands w tm
---        x <- tm ^? tmStatus . tiText
+        x <- tm ^? tmStatus . tiText
---        let s = fromMaybe "" $ x ^? to words . ix 0
+        let s = fromMaybe "" $ x ^? to words . ix 0
---        (s', _) <- dowrap s coms
+        --(s', _) <- dowrap s coms
---        return $ tm & tmStatus . tiText .~ unwords s'
+        (s', _) <- dowrap x coms
+        return $ tm & tmStatus . tiText .~ unwords s'
 ----    g tm = fromMaybe tm $ do
 ----        let coms = getCommands w tm
 ----        x <- tm ^? tmStatus . tiText

tags

@@ -3253,7 +3253,7 @@ doScopeZoom	src/Dodge/Update/Scroll.hs	89;"	f
 doSectionSize	src/Dodge/DisplayInventory.hs	215;"	f
 doSideEffects	appDodge/Main.hs	117;"	f
 doStrategyActions	src/Dodge/Creature/ReaderUpdate.hs	172;"	f
-doTabComplete	src/Dodge/Terminal.hs	221;"	f
+doTabComplete	src/Dodge/Terminal.hs	226;"	f
 doTestDrawing	src/Dodge/Render.hs	40;"	f
 doTextInputOver	src/Dodge/Update/Input/Text.hs	15;"	f
 doTextInputOverUniverse	src/Dodge/Update/Input/Text.hs	12;"	f
@@ -4958,7 +4958,7 @@ shuffleRoomPos	src/Dodge/Layout.hs	82;"	f
 shuffleTail	src/RandomHelp.hs	59;"	f
 sigmoid	src/Dodge/Base.hs	151;"	f
 simpleCrSprings	src/Dodge/Update.hs	876;"	f
-simpleTermMessage	src/Dodge/Terminal.hs	260;"	f
+simpleTermMessage	src/Dodge/Terminal.hs	259;"	f
 sineRaisePitchOneSecS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	716;"	f
 sineRaisePitchTwoSecS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	752;"	f
 singleAmmo	src/Dodge/Item/AmmoSlots.hs	64;"	f
@@ -5145,7 +5145,8 @@ termScreenColor	src/Dodge/Terminal/Color.hs	8;"	f
 termSoundLine	src/Dodge/Terminal.hs	50;"	f
 termTextColor	src/Dodge/Terminal.hs	53;"	f
 terminalLDP	src/Dodge/ListDisplayParams.hs	44;"	f
-terminalReturnEffect	src/Dodge/Terminal.hs	264;"	f
+terminalReturnEffect	src/Dodge/Terminal.hs	263;"	f
+terminalReturnLocal	src/Dodge/Terminal.hs	267;"	f
 terminalSPic	src/Dodge/Machine/Draw.hs	47;"	f
 terminalScreenGlow	src/Dodge/Machine/Update.hs	44;"	f
 terminalShape	src/Dodge/Machine/Draw.hs	50;"	f