mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-22 14:21:34 +03:00
e9f09e32c1
If you connect to an urbit using the remote terminal code, slogs would not be printed to them since they were hard coded to be printed to stderr. This threads slog printing to the terminal driver, and puts them in scrollback. (It does not actually fix slogs being printed on one line.)
160 lines
4.2 KiB
Haskell
160 lines
4.2 KiB
Haskell
{-|
|
|
Tracks terminal state so that new terminal connections can be brought
|
|
up to speed.
|
|
-}
|
|
module Urbit.Vere.Term.Logic
|
|
( SpinnerCause(..), St, Ev(..), Ef(..)
|
|
, init
|
|
, step
|
|
, drawState
|
|
, fromTermEv
|
|
, toTermEv
|
|
) where
|
|
|
|
import Urbit.Prelude hiding (init)
|
|
|
|
import Data.Sequence (Seq((:<|)))
|
|
|
|
import qualified Urbit.Arvo as Arvo
|
|
import qualified Urbit.Vere.Term.API as Term
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data SpinnerCause = User | Event Text
|
|
deriving (Show)
|
|
|
|
type SpinnerState = Maybe SpinnerCause
|
|
|
|
{-|
|
|
%line -- Output a line above the edit line.
|
|
%spin -- Set the spinner state.
|
|
%bell -- Ring a bell (no change to the state).
|
|
%draw -- Redraw the current line (no change to the state).
|
|
%move -- Move the cursor position.
|
|
%edit -- Set the edit line, moving the cursor to the end.
|
|
%more -- Write the edit line to history, and clear it.
|
|
-}
|
|
data Ev
|
|
= EvLine Text
|
|
| EvSlog (Atom, Tank)
|
|
| EvSpin SpinnerState
|
|
| EvMove Word
|
|
| EvBell
|
|
| EvDraw
|
|
| EvEdit Text
|
|
| EvMore
|
|
deriving (Show)
|
|
|
|
data Ef
|
|
= EfClear
|
|
| EfWrite Text
|
|
| EfShift Int
|
|
| EfRing
|
|
| EfSpin SpinnerState
|
|
deriving (Show)
|
|
|
|
data History
|
|
= HistoryText Text
|
|
| HistorySlog (Atom, Tank)
|
|
deriving (Show)
|
|
|
|
data St = St
|
|
{ sHistory :: Seq History
|
|
, sLine :: Text
|
|
, sCurPos :: Word
|
|
, sSpinner :: SpinnerState
|
|
}
|
|
deriving (Show)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
init :: St
|
|
init = St mempty "" 0 Nothing
|
|
|
|
{-|
|
|
When we process `EvMore`, we need to append a newline to the end of
|
|
the current line. During normal play, the ENTER key inserts the
|
|
newline for us, so we need to recreate that newline when we rebuild
|
|
the state for a new terminal connection.
|
|
-}
|
|
step :: St -> Ev -> St
|
|
step st@St{..} = \case
|
|
EvLine t -> st & recordText t
|
|
EvSlog s -> st & recordSlog s
|
|
EvSpin s -> st { sSpinner = s }
|
|
EvMove w -> st { sCurPos = min w (word $ length sLine) }
|
|
EvEdit t -> st { sLine = t, sCurPos = word (length t) }
|
|
EvMore -> st { sLine = "", sCurPos = 0 } & recordText (sLine <> "\n")
|
|
EvBell -> st
|
|
EvDraw -> st
|
|
where
|
|
word :: Integral i => i -> Word
|
|
word = fromIntegral
|
|
|
|
recordText :: Text -> St -> St
|
|
recordText t st@St{..} = st {
|
|
sHistory = trim (sHistory |> (HistoryText t))
|
|
}
|
|
|
|
recordSlog :: (Atom, Tank) -> St -> St
|
|
recordSlog t st@St{..} = st {
|
|
sHistory = trim (sHistory |> (HistorySlog t))
|
|
}
|
|
|
|
trim :: Seq a -> Seq a
|
|
trim s | length s < 20 = s
|
|
trim (_ :<| s) = s
|
|
trim s = s
|
|
|
|
drawState :: St -> [Ev]
|
|
drawState St{..} = hist <> out <> cur <> spin
|
|
where
|
|
hist = fmap drawHistory $ toList sHistory
|
|
out = if null sLine then [] else [EvEdit sLine]
|
|
cur = if 0 == sCurPos then [] else [EvMove $ fromIntegral $ sCurPos]
|
|
spin = maybe [] (singleton . EvSpin . Just) sSpinner
|
|
|
|
drawHistory (HistoryText t) = EvLine t
|
|
drawHistory (HistorySlog s) = EvSlog s
|
|
|
|
|
|
-- Conversion ------------------------------------------------------------------
|
|
|
|
fromBlit :: Arvo.Blit -> Maybe Ev
|
|
fromBlit = \case
|
|
Arvo.Hop w -> Just $ EvMove $ fromIntegral w
|
|
Arvo.Bel () -> Just EvBell
|
|
Arvo.Clr () -> Just EvDraw
|
|
Arvo.Lin s -> Just $ EvEdit (pack s)
|
|
Arvo.Mor () -> Just EvMore
|
|
_ -> Nothing
|
|
|
|
toCause :: Maybe Cord -> SpinnerCause
|
|
toCause Nothing = User
|
|
toCause (Just (Cord c)) = Event c
|
|
|
|
fromCause :: SpinnerCause -> Maybe Cord
|
|
fromCause User = Nothing
|
|
fromCause (Event t) = Just (Cord t)
|
|
|
|
fromTermEv :: Term.Ev -> [Ev]
|
|
fromTermEv = \case
|
|
Term.Blits bs -> catMaybes (fromBlit <$> bs)
|
|
Term.Trace t -> [EvLine $ unCord t]
|
|
Term.Blank -> [EvLine ""]
|
|
Term.Spinr s -> [EvSpin $ toCause <$> s]
|
|
Term.Slog s -> [EvSlog s]
|
|
|
|
toTermEv :: Ev -> Term.Ev
|
|
toTermEv = \case
|
|
EvLine "" -> Term.Blank
|
|
EvLine t -> Term.Trace (Cord t)
|
|
EvSlog s -> Term.Slog s
|
|
EvSpin s -> Term.Spinr (fromCause <$> s)
|
|
EvMove w -> Term.Blits [Arvo.Hop $ fromIntegral w]
|
|
EvBell -> Term.Blits [Arvo.Bel ()]
|
|
EvDraw -> Term.Blits [Arvo.Clr ()]
|
|
EvEdit t -> Term.Blits [Arvo.Lin $ unpack t]
|
|
EvMore -> Term.Blits [Arvo.Mor ()]
|