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

kh: rewrite hijack to guarantee lojacking

Browse Source 
No longer allow lojack to be called independently, instead requiring
logic to be inserted between hi- and lojack's io.
This commit is contained in:
fang 2021-06-17 22:48:48 +02:00
parent addcf42468
commit eadd7aad01
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
2 changed files with 14 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -294,29 +294,25 @@ localClient doneSignal = fst <$> mkRAcquire start stop
writeBlank ls = do
TermSize _ height <- readTVarIO termSizeVar
--NOTE hijack creates a blank line
T.hijack $ fromIntegral height
T.lojack
T.hijack (fromIntegral height) $ pure ()
pure ls
writeTrace :: LineState -> Text -> RIO e LineState
writeTrace ls p = do
TermSize _ height <- readTVarIO termSizeVar
T.hijack $ fromIntegral height
putStr p
T.lojack
T.hijack (fromIntegral height) $ putStr p
pure ls
writeSlog :: LineState -> (Atom, Tank) -> RIO e LineState
writeSlog ls slog = do
TermSize width height <- readTVarIO termSizeVar
T.hijack $ fromIntegral height
-- TODO: Ignoring priority for now. Priority changes the color of,
-- and adds a prefix of '>' to, the output.
let lines = fmap unTape $ wash (WashCfg 0 width) $ tankTree $ snd slog
T.putCsi 'm' [90] --NOTE print slogs in grey
forM (intersperse "\n" lines) $ \line -> putStr line
T.putCsi 'm' [0]
T.lojack
T.hijack (fromIntegral height) do
-- TODO: Ignoring priority for now. Priority changes the color of,
-- and adds a prefix of '>' to, the output.
let lines = fmap unTape $ wash (WashCfg 0 width) $ tankTree $ snd slog
T.putCsi 'm' [90] --NOTE print slogs in grey
forM (intersperse "\n" lines) $ \line -> putStr line
T.putCsi 'm' [0]
pure ls
{-

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

@ -10,7 +10,6 @@ module Urbit.Vere.Term.Render
, cursorRestore
, putCsi
, hijack
, lojack
) where
import ClassyPrelude
@ -45,13 +44,11 @@ putCsi c a = liftIO do
putStr $ pack $ mconcat $ intersperse ";" (fmap show a)
putStr $ pack [c]
hijack :: MonadIO m => Int -> m ()
hijack h = liftIO do
hijack :: MonadIO m => Int -> IO () -> m ()
hijack h d = liftIO do
putCsi 'r' [1, h-1] -- set scroll region to exclude bottom line
putCsi 'S' [1] -- scroll up one line
cursorMove (h-2) 0 -- move cursor to empty space
lojack :: MonadIO m => m ()
lojack = liftIO do
putCsi 'r' [] -- reset scroll region
cursorRestore -- restory cursor position
d
putCsi 'r' [] -- reset scroll region
cursorRestore -- restory cursor position