urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-19 08:32:39 +03:00
Code Issues Packages Projects Releases Wiki Activity

kh: always draw spinner on bottom line

Browse Source 
Now always draws the spinner on the bottom line, regardless of the
cursor position.
This commit is contained in:
fang 2021-04-16 14:55:34 +02:00
parent fab0f65d58
commit 8716c49b45
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
1 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs
View File

@ -286,7 +286,9 @@ localClient doneSignal = fst <$> mkRAcquire start stop
writeTerminal :: TQueue [Term.Ev] -> TMVar () -> TVar TermSize -> RIO e ()
writeTerminal q spinner termSizeVar = do
currentTime <- io $ now
loop (LineState "" (CurPos 0 0) Nothing Nothing True 0 currentTime)
loop
termSizeVar
(LineState "" (CurPos 0 0) Nothing Nothing True 0 currentTime)
where
writeBlank :: LineState -> RIO e LineState
writeBlank ls = do
@ -324,7 +326,6 @@ localClient doneSignal = fst <$> mkRAcquire start stop
event shortly after a previous spin, use a shorter delay to
avoid giving the impression of a half-idle system.
-}
--TODO this is too eager and does termRestoreLine on every keypress!
doSpin :: LineState -> Maybe Text -> RIO e LineState
doSpin ls@LineState{..} mTxt = do
maybe (pure ()) cancel lsSpinTimer
@ -357,7 +358,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop
-- If we ever actually ran the spinner display callback, we need
-- to force a redisplay of the command prompt.
if not lsSpinFirstRender || True
if not lsSpinFirstRender
then termRestoreLine ls termSizeVar
else pure ()
@ -373,13 +374,20 @@ localClient doneSignal = fst <$> mkRAcquire start stop
Term.Spinr (Just txt) -> doSpin ls (unCord <$> txt)
Term.Spinr Nothing -> unspin ls
-- TODO What does this do?
spin :: LineState -> RIO e LineState
spin ls@LineState{..} = do
spin :: TVar TermSize -> LineState -> RIO e LineState
spin ts ls@LineState{..} = do
let spinner = (spinners !! lsSpinFrame) ++ case lsSpinCause of
Nothing -> ""
Just str -> leftBracket ++ str ++ rightBracket
--NOTE even after first render, because cursor might have moved...
if row lsCurPos > 0
then do
TermSize _ h <- readTVarIO ts
T.cursorMove (fromIntegral h - 1) 0
else
T.cursorRestore
putStr (spinner <> pack (ANSI.cursorBackwardCode (length spinner)))
let newFrame = (lsSpinFrame + 1) `mod` length spinners
@ -388,11 +396,11 @@ localClient doneSignal = fst <$> mkRAcquire start stop
, lsSpinFrame = newFrame
}
loop :: LineState -> RIO e ()
loop ls = do
loop :: TVar TermSize -> LineState -> RIO e ()
loop ts ls = do
join $ atomically $ asum
[ readTQueue q >>= pure . (foldM execEv ls >=> loop)
, takeTMVar spinner >> pure (spin ls >>= loop)
[ readTQueue q >>= pure . (foldM execEv ls >=> loop ts)
, takeTMVar spinner >> pure (spin ts ls >>= loop ts)
]
-- Writes an individual blit to the screen
@ -475,11 +483,6 @@ localClient doneSignal = fst <$> mkRAcquire start stop
T.cursorSave
pure ls { lsCurPos = CurPos row col }
-- Moves the cursor left without any mutation of the LineState. Used only
-- in cursor spinning.
_termSpinnerMoveLeft :: Int -> RIO e ()
_termSpinnerMoveLeft = liftIO . ANSI.cursorBackward
-- Displays and sets the current line
termShowLine :: LineState -> Text -> RIO e LineState
termShowLine ls@LineState{lsCurPos} newStr = do