mirror of
https://github.com/urbit/shrub.git
synced 2024-12-20 17:32:11 +03:00
20a6c0331c
This changes startup so we get the size of the current terminal to send to Urbit on startup. We then subscribe to terminal size change notifications and send those to your Urbit via the terminal muxing system. In the case where there are multiple terminal connections to your Urbit, set the terminal size to the minimum of the widths.
80 lines
1.9 KiB
Haskell
80 lines
1.9 KiB
Haskell
{-|
|
|
Interface Terminal API.
|
|
-}
|
|
module Urbit.Vere.Term.API (Ev(..),
|
|
Client(..),
|
|
ClientTake(..),
|
|
trace,
|
|
slog,
|
|
spin,
|
|
stopSpin) where
|
|
|
|
import Urbit.Prelude hiding (trace)
|
|
|
|
import Urbit.Arvo (Belt, Blit)
|
|
|
|
import Urbit.TermSize
|
|
|
|
-- External Types --------------------------------------------------------------
|
|
|
|
{-|
|
|
Input Event for terminal driver:
|
|
|
|
%blits -- list of blits from arvo.
|
|
%trace -- stderr line from runtime.
|
|
%slog -- nock worker logging with priority
|
|
%blank -- print a blank line
|
|
%spinr -- Start or stop the spinner
|
|
-}
|
|
data Ev = Blits [Blit]
|
|
| Trace Cord
|
|
| Slog (Atom, Tank)
|
|
| Blank
|
|
| Spinr (Maybe (Maybe Cord))
|
|
deriving (Show)
|
|
|
|
data ClientTake
|
|
= ClientTakeBelt Belt
|
|
| ClientTakeSize TermSize
|
|
deriving (Show)
|
|
|
|
instance ToNoun ClientTake where
|
|
toNoun = \case
|
|
ClientTakeBelt b -> toNoun $ (Cord "belt", b)
|
|
ClientTakeSize (TermSize w h) -> toNoun $ (Cord "size", (w, h))
|
|
|
|
instance FromNoun ClientTake where
|
|
parseNoun n = named "ClientTake" $ do
|
|
(Cord name, rest) <- parseNoun n
|
|
case name of
|
|
"belt" -> do
|
|
b <- parseNoun rest
|
|
pure (ClientTakeBelt b)
|
|
"size" -> do
|
|
(w, h) <- parseNoun rest
|
|
pure (ClientTakeSize (TermSize w h))
|
|
_ -> fail "weird client take"
|
|
|
|
|
|
data Client = Client
|
|
{ take :: STM (Maybe ClientTake)
|
|
, give :: [Ev] -> STM ()
|
|
}
|
|
|
|
deriveNoun ''Ev
|
|
|
|
|
|
-- Utilities -------------------------------------------------------------------
|
|
|
|
trace :: Client -> Text -> STM ()
|
|
trace ts = give ts . singleton . Trace . Cord
|
|
|
|
slog :: Client -> (Atom, Tank) -> STM ()
|
|
slog ts = give ts . singleton . Slog
|
|
|
|
spin :: Client -> Maybe Text -> STM ()
|
|
spin ts = give ts . singleton . Spinr . Just . fmap Cord
|
|
|
|
stopSpin :: Client -> STM ()
|
|
stopSpin ts = give ts [Spinr Nothing]
|