{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Yi.Frontend.Vty
( start
, baseVtyConfig
) where
import Prelude hiding (concatMap, error,
reverse)
import Control.Concurrent (MVar, forkIO, myThreadId, newEmptyMVar,
takeMVar, tryPutMVar, tryTakeMVar)
import Control.Concurrent.STM (atomically, isEmptyTChan, readTChan)
import Control.Exception (IOException, handle)
import Lens.Micro.Platform (makeLenses, view, use, Lens')
import Control.Monad (void, when)
import Data.Char (chr, ord)
import Data.Default (Default)
import qualified Data.DList as D (empty, snoc, toList)
import Data.Foldable (concatMap, toList)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.List.PointedList.Circular as PL (PointedList (_focus), withFocus)
import qualified Data.Map.Strict as M ((!))
import Data.Maybe (fromMaybe, maybeToList)
import Data.Monoid (Endo (appEndo), (<>))
import qualified Data.Text as T (Text, cons, empty,
justifyLeft, length, pack,
singleton, snoc, take,
unpack)
import Data.Typeable (Typeable)
import GHC.Conc (labelThread)
import qualified Graphics.Vty as Vty (Attr, Cursor (Cursor, NoCursor),
Config,
Event (EvResize), Image,
Input (_eventChannel),
Output (displayBounds),
Picture (picCursor), Vty (inputIface, outputIface, refresh, shutdown, update),
bold, char, charFill,
defAttr, emptyImage,
horizCat, mkVty,
picForLayers,
standardIOConfig,
string,
reverseVideo, text',
translate, underline,
vertCat, withBackColor,
withForeColor,
withStyle, (<|>))
import System.Exit (ExitCode, exitWith)
import Yi.Buffer
import Yi.Config
import Yi.Debug (logError, logPutStrLn)
import Yi.Editor
import Yi.Event (Event)
import qualified Yi.Rope as R
import Yi.Style
import Yi.Types (YiConfigVariable)
import qualified Yi.UI.Common as Common
import qualified Yi.UI.SimpleLayout as SL
import Yi.Layout (HasNeighborWest)
import Yi.UI.LineNumbers (getDisplayLineNumbersLocal)
import Yi.UI.TabBar (TabDescr (TabDescr), tabBarDescr)
import Yi.UI.Utils (arrangeItems, attributesPictureAndSelB)
import Yi.Frontend.Vty.Conversions (colorToAttr, fromVtyEvent)
import Yi.Window (Window (bufkey, isMini, wkey, width, height))
data Rendered = Rendered
{ Rendered -> Image
picture :: !Vty.Image
, Rendered -> Maybe (Int, Int)
cursor :: !(Maybe (Int,Int))
}
data FrontendState = FrontendState
{ FrontendState -> Vty
fsVty :: Vty.Vty
, FrontendState -> Config
fsConfig :: Config
, FrontendState -> MVar ExitCode
fsEndMain :: MVar ExitCode
, FrontendState -> MVar ()
fsEndInputLoop :: MVar ()
, FrontendState -> MVar ()
fsEndRenderLoop :: MVar ()
, FrontendState -> MVar ()
fsDirty :: MVar ()
, FrontendState -> IORef Editor
fsEditorRef :: IORef Editor
}
newtype BaseVtyConfig = BaseVtyConfig { BaseVtyConfig -> Maybe Config
_baseVtyConfig' :: Maybe Vty.Config }
deriving (Typeable, BaseVtyConfig
BaseVtyConfig -> Default BaseVtyConfig
forall a. a -> Default a
def :: BaseVtyConfig
$cdef :: BaseVtyConfig
Default)
instance YiConfigVariable BaseVtyConfig
makeLenses ''BaseVtyConfig
baseVtyConfig :: Lens' Config (Maybe Vty.Config)
baseVtyConfig :: (Maybe Config -> f (Maybe Config)) -> Config -> f Config
baseVtyConfig = (BaseVtyConfig -> f BaseVtyConfig) -> Config -> f Config
forall a. YiConfigVariable a => Lens Config Config a a
configVariable ((BaseVtyConfig -> f BaseVtyConfig) -> Config -> f Config)
-> ((Maybe Config -> f (Maybe Config))
-> BaseVtyConfig -> f BaseVtyConfig)
-> (Maybe Config -> f (Maybe Config))
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Config -> f (Maybe Config))
-> BaseVtyConfig -> f BaseVtyConfig
Lens' BaseVtyConfig (Maybe Config)
baseVtyConfig'
start :: UIBoot
start :: UIBoot
start Config
config [Event] -> IO ()
submitEvents [Action] -> IO ()
submitActions Editor
editor = do
let baseConfig :: Maybe Config
baseConfig = Getting (Maybe Config) Config (Maybe Config)
-> Config -> Maybe Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Config) Config (Maybe Config)
Lens' Config (Maybe Config)
baseVtyConfig Config
config
Vty
vty <- Config -> IO Vty
Vty.mkVty (Config -> IO Vty) -> IO Config -> IO Vty
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Maybe Config
baseConfig of
Maybe Config
Nothing -> IO Config
Vty.standardIOConfig
Just Config
conf -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
conf
let inputChan :: TChan Event
inputChan = Input -> TChan Event
Vty._eventChannel (Vty -> Input
Vty.inputIface Vty
vty)
MVar ()
endInput <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ExitCode
endMain <- IO (MVar ExitCode)
forall a. IO (MVar a)
newEmptyMVar
MVar ()
endRender <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
MVar ()
dirty <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
IORef Editor
editorRef <- Editor -> IO (IORef Editor)
forall a. a -> IO (IORef a)
newIORef Editor
editor
let
inputLoop :: IO ()
inputLoop :: IO ()
inputLoop = MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
endInput IO (Maybe ()) -> (Maybe () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO () -> (() -> IO ()) -> Maybe () -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (do
let go :: DList Event -> IO ()
go DList Event
evs = do
Event
e <- IO Event
getEvent
Bool
done <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (TChan Event -> STM Bool
forall a. TChan a -> STM Bool
isEmptyTChan TChan Event
inputChan)
if Bool
done
then [Event] -> IO ()
submitEvents (DList Event -> [Event]
forall a. DList a -> [a]
D.toList (DList Event
evs DList Event -> Event -> DList Event
forall a. DList a -> a -> DList a
`D.snoc` Event
e))
else DList Event -> IO ()
go (DList Event
evs DList Event -> Event -> DList Event
forall a. DList a -> a -> DList a
`D.snoc` Event
e)
DList Event -> IO ()
go DList Event
forall a. DList a
D.empty
IO ()
inputLoop)
(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
getEvent :: IO Yi.Event.Event
getEvent :: IO Event
getEvent = do
Event
event <- STM Event -> IO Event
forall a. STM a -> IO a
atomically (TChan Event -> STM Event
forall a. TChan a -> STM a
readTChan TChan Event
inputChan)
case Event
event of
(Vty.EvResize Int
_ Int
_) -> do
[Action] -> IO ()
submitActions []
IO Event
getEvent
Event
_ -> Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Event
fromVtyEvent Event
event)
renderLoop :: IO ()
renderLoop :: IO ()
renderLoop = do
MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
dirty
MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
endRender IO (Maybe ()) -> (Maybe () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO () -> (() -> IO ()) -> Maybe () -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
except :: IOException) -> do
Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn Text
"refresh crashed with IO Error"
Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logError (String -> Text
T.pack (IOException -> String
forall a. Show a => a -> String
show IOException
except)))
(IORef Editor -> IO Editor
forall a. IORef a -> IO a
readIORef IORef Editor
editorRef IO Editor -> (Editor -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FrontendState -> Editor -> IO ()
refresh FrontendState
fs IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
renderLoop))
(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
fs :: FrontendState
fs = Vty
-> Config
-> MVar ExitCode
-> MVar ()
-> MVar ()
-> MVar ()
-> IORef Editor
-> FrontendState
FrontendState Vty
vty Config
config MVar ExitCode
endMain MVar ()
endInput MVar ()
endRender MVar ()
dirty IORef Editor
editorRef
ThreadId
inputThreadId <- IO () -> IO ThreadId
forkIO IO ()
inputLoop
ThreadId -> String -> IO ()
labelThread ThreadId
inputThreadId String
"VtyInput"
ThreadId
renderThreadId <- IO () -> IO ThreadId
forkIO IO ()
renderLoop
ThreadId -> String -> IO ()
labelThread ThreadId
renderThreadId String
"VtyRender"
UI Editor -> IO (UI Editor)
forall (m :: * -> *) a. Monad m => a -> m a
return (UI Editor -> IO (UI Editor)) -> UI Editor -> IO (UI Editor)
forall a b. (a -> b) -> a -> b
$! UI Any
forall e. UI e
Common.dummyUI
{ main :: IO ()
Common.main = FrontendState -> IO ()
main FrontendState
fs
, end :: Maybe ExitCode -> IO ()
Common.end = FrontendState -> Maybe ExitCode -> IO ()
end FrontendState
fs
, refresh :: Editor -> IO ()
Common.refresh = FrontendState -> Editor -> IO ()
requestRefresh FrontendState
fs
, userForceRefresh :: IO ()
Common.userForceRefresh = Vty -> IO ()
Vty.refresh Vty
vty
, layout :: Editor -> IO Editor
Common.layout = FrontendState -> Editor -> IO Editor
layout FrontendState
fs
}
main :: FrontendState -> IO ()
main :: FrontendState -> IO ()
main FrontendState
fs = do
ThreadId
tid <- IO ThreadId
myThreadId
ThreadId -> String -> IO ()
labelThread ThreadId
tid String
"VtyMain"
ExitCode
exitCode <- MVar ExitCode -> IO ExitCode
forall a. MVar a -> IO a
takeMVar (FrontendState -> MVar ExitCode
fsEndMain FrontendState
fs)
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode
layout :: FrontendState -> Editor -> IO Editor
layout :: FrontendState -> Editor -> IO Editor
layout FrontendState
fs Editor
e = do
(Int
colCount, Int
rowCount) <- Output -> IO (Int, Int)
Vty.displayBounds (Vty -> Output
Vty.outputIface (FrontendState -> Vty
fsVty FrontendState
fs))
let (Editor
e', Layout
_layout) = Int -> Int -> Editor -> (Editor, Layout)
SL.layout Int
colCount Int
rowCount Editor
e
Editor -> IO Editor
forall (m :: * -> *) a. Monad m => a -> m a
return Editor
e'
end :: FrontendState -> Maybe ExitCode -> IO ()
end :: FrontendState -> Maybe ExitCode -> IO ()
end FrontendState
fs Maybe ExitCode
mExit = do
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar (FrontendState -> MVar ()
fsEndInputLoop FrontendState
fs) ()
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar (FrontendState -> MVar ()
fsEndRenderLoop FrontendState
fs) ()
Vty -> IO ()
Vty.shutdown (FrontendState -> Vty
fsVty FrontendState
fs)
case Maybe ExitCode
mExit of
Maybe ExitCode
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ExitCode
code -> IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MVar ExitCode -> ExitCode -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar (FrontendState -> MVar ExitCode
fsEndMain FrontendState
fs) ExitCode
code)
requestRefresh :: FrontendState -> Editor -> IO ()
requestRefresh :: FrontendState -> Editor -> IO ()
requestRefresh FrontendState
fs Editor
e = do
IORef Editor -> Editor -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (FrontendState -> IORef Editor
fsEditorRef FrontendState
fs) Editor
e
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar (FrontendState -> MVar ()
fsDirty FrontendState
fs) ()
refresh :: FrontendState -> Editor -> IO ()
refresh :: FrontendState -> Editor -> IO ()
refresh FrontendState
fs Editor
e = do
(Int
colCount, Int
rowCount) <- Output -> IO (Int, Int)
Vty.displayBounds (Vty -> Output
Vty.outputIface (FrontendState -> Vty
fsVty FrontendState
fs))
let (Editor
_e, SL.Layout Rect
tabbarRect Map WindowRef (Rect, Bool)
winRects Rect
promptRect) = Int -> Int -> Editor -> (Editor, Layout)
SL.layout Int
colCount Int
rowCount Editor
e
ws :: PointedList Window
ws = Editor -> PointedList Window
windows Editor
e
([Text]
cmd, StyleName
cmdSty) = Editor -> ([Text], StyleName)
statusLineInfo Editor
e
niceCmd :: [Text]
niceCmd = [Text] -> Int -> Int -> [Text]
arrangeItems [Text]
cmd (Rect -> Int
SL.sizeX Rect
promptRect) (Editor -> Int
maxStatusHeight Editor
e)
mkLine :: Text -> Text
mkLine = Int -> Char -> Text -> Text
T.justifyLeft Int
colCount Char
' ' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
colCount
formatCmdLine :: Text -> Image
formatCmdLine Text
text = Attributes -> Text -> Image
withAttributes Attributes
statusBarStyle (Text -> Text
mkLine Text
text)
winImage :: (Window, Bool) -> Rendered
winImage (Window
win, Bool
hasFocus) =
let (Rect
rect, Bool
nb) = Map WindowRef (Rect, Bool)
winRects Map WindowRef (Rect, Bool) -> WindowRef -> (Rect, Bool)
forall k a. Ord k => Map k a -> k -> a
M.! Window -> WindowRef
wkey Window
win
in Config -> Editor -> Rect -> Bool -> (Window, Bool) -> Rendered
renderWindow (FrontendState -> Config
fsConfig FrontendState
fs) Editor
e Rect
rect Bool
nb (Window
win, Bool
hasFocus)
windowsAndImages :: PointedList (Window, Rendered)
windowsAndImages =
((Window, Bool) -> (Window, Rendered))
-> PointedList (Window, Bool) -> PointedList (Window, Rendered)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Window
w, Bool
f) -> (Window
w, (Window, Bool) -> Rendered
winImage (Window
w, Bool
f))) (PointedList Window -> PointedList (Window, Bool)
forall a. PointedList a -> PointedList (a, Bool)
PL.withFocus PointedList Window
ws)
bigImages :: [Image]
bigImages =
((Window, Rendered) -> Image) -> [(Window, Rendered)] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Rendered -> Image
picture (Rendered -> Image)
-> ((Window, Rendered) -> Rendered) -> (Window, Rendered) -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rendered) -> Rendered
forall a b. (a, b) -> b
snd)
(((Window, Rendered) -> Bool)
-> [(Window, Rendered)] -> [(Window, Rendered)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Window, Rendered) -> Bool) -> (Window, Rendered) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Bool
isMini (Window -> Bool)
-> ((Window, Rendered) -> Window) -> (Window, Rendered) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rendered) -> Window
forall a b. (a, b) -> a
fst) (PointedList (Window, Rendered) -> [(Window, Rendered)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList PointedList (Window, Rendered)
windowsAndImages))
miniImages :: [Image]
miniImages =
((Window, Rendered) -> Image) -> [(Window, Rendered)] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Rendered -> Image
picture (Rendered -> Image)
-> ((Window, Rendered) -> Rendered) -> (Window, Rendered) -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rendered) -> Rendered
forall a b. (a, b) -> b
snd)
(((Window, Rendered) -> Bool)
-> [(Window, Rendered)] -> [(Window, Rendered)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> Bool
isMini (Window -> Bool)
-> ((Window, Rendered) -> Window) -> (Window, Rendered) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window, Rendered) -> Window
forall a b. (a, b) -> a
fst) (PointedList (Window, Rendered) -> [(Window, Rendered)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList PointedList (Window, Rendered)
windowsAndImages))
statusBarStyle :: Attributes
statusBarStyle =
((Endo Attributes -> Attributes -> Attributes
forall a. Endo a -> a -> a
appEndo (Endo Attributes -> Attributes -> Attributes)
-> StyleName -> UIStyle -> Attributes -> Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StyleName
cmdSty) (UIStyle -> Attributes -> Attributes)
-> (UIStyle -> Attributes) -> UIStyle -> Attributes
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UIStyle -> Attributes
baseAttributes)
(UIConfig -> UIStyle
configStyle (Config -> UIConfig
configUI (FrontendState -> Config
fsConfig FrontendState
fs)))
tabBarImage :: Image
tabBarImage =
Rect -> UIStyle -> [(Text, Bool)] -> Image
renderTabBar Rect
tabbarRect (UIConfig -> UIStyle
configStyle (Config -> UIConfig
configUI (FrontendState -> Config
fsConfig FrontendState
fs)))
((TabDescr -> (Text, Bool)) -> [TabDescr] -> [(Text, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\(TabDescr Text
t Bool
f) -> (Text
t, Bool
f)) (PointedList TabDescr -> [TabDescr]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Editor -> PointedList TabDescr
tabBarDescr Editor
e)))
cmdImage :: Image
cmdImage = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cmd
then Image
Vty.emptyImage
else Int -> Int -> Image -> Image
Vty.translate
(Rect -> Int
SL.offsetX Rect
promptRect)
(Rect -> Int
SL.offsetY Rect
promptRect)
([Image] -> Image
Vty.vertCat ((Text -> Image) -> [Text] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Image
formatCmdLine [Text]
niceCmd))
cursorPos :: Cursor
cursorPos =
let (Window
w, Rendered
image) = PointedList (Window, Rendered) -> (Window, Rendered)
forall a. PointedList a -> a
PL._focus PointedList (Window, Rendered)
windowsAndImages
in case (Window -> Bool
isMini Window
w, Rendered -> Maybe (Int, Int)
cursor Rendered
image) of
(Bool
False, Just (Int
y, Int
x)) ->
Int -> Int -> Cursor
Vty.Cursor (Int -> Int
forall a. Enum a => Int -> a
toEnum Int
x) (Int -> Int
forall a. Enum a => Int -> a
toEnum Int
y)
(Bool
True, Just (Int
_, Int
x)) -> Int -> Int -> Cursor
Vty.Cursor (Int -> Int
forall a. Enum a => Int -> a
toEnum Int
x) (Int -> Int
forall a. Enum a => Int -> a
toEnum (Int
rowCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
(Bool
_, Maybe (Int, Int)
Nothing) -> Cursor
Vty.NoCursor
Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn Text
"refreshing screen."
Vty -> Picture -> IO ()
Vty.update (FrontendState -> Vty
fsVty FrontendState
fs)
([Image] -> Picture
Vty.picForLayers ([Image
tabBarImage, Image
cmdImage] [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ [Image]
bigImages [Image] -> [Image] -> [Image]
forall a. [a] -> [a] -> [a]
++ [Image]
miniImages))
{ picCursor :: Cursor
Vty.picCursor = Cursor
cursorPos }
renderWindow :: Config -> Editor -> SL.Rect -> HasNeighborWest -> (Window, Bool) -> Rendered
renderWindow :: Config -> Editor -> Rect -> Bool -> (Window, Bool) -> Rendered
renderWindow Config
cfg' Editor
e (SL.Rect Int
x Int
y Int
_ Int
_) Bool
nb (Window
win, Bool
focused) =
Image -> Maybe (Int, Int) -> Rendered
Rendered (Int -> Int -> Image -> Image
Vty.translate Int
x Int
y (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ if Bool
nb then Image
vertSep Image -> Image -> Image
Vty.<|> Image
pict else Image
pict)
(((Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
i, Int
j) -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y, Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x')) Maybe (Int, Int)
cur)
where
cfg :: UIConfig
cfg = Config -> UIConfig
configUI Config
cfg'
w :: Int
w = Window -> Int
Yi.Window.width Window
win
h :: Int
h = Window -> Int
Yi.Window.height Window
win
x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool
nb then Int
1 else Int
0
w' :: Int
w' = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- if Bool
nb then Int
1 else Int
0
b :: FBuffer
b = BufferRef -> Editor -> FBuffer
findBufferWith (Window -> BufferRef
bufkey Window
win) Editor
e
sty :: UIStyle
sty = UIConfig -> UIStyle
configStyle UIConfig
cfg
notMini :: Bool
notMini = Bool -> Bool
not (Window -> Bool
isMini Window
win)
displayLineNumbers :: Bool
displayLineNumbers =
let local :: Maybe Bool
local = (Editor, Maybe Bool) -> Maybe Bool
forall a b. (a, b) -> b
snd ((Editor, Maybe Bool) -> Maybe Bool)
-> (Editor, Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Config -> EditorM (Maybe Bool) -> Editor -> (Editor, Maybe Bool)
forall a. Config -> EditorM a -> Editor -> (Editor, a)
runEditor Config
cfg' (BufferRef -> BufferM (Maybe Bool) -> EditorM (Maybe Bool)
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer (Window -> BufferRef
bufkey Window
win) BufferM (Maybe Bool)
getDisplayLineNumbersLocal) Editor
e
global :: Bool
global = UIConfig -> Bool
configLineNumbers UIConfig
cfg
in Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
global Maybe Bool
local
(Int
lineCount, FBuffer
_) = Window -> FBuffer -> BufferM Int -> (Int, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM Int
lineCountB
(Int
topLine, FBuffer
_) = Window -> FBuffer -> BufferM Int -> (Int, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM Int
screenTopLn
linesInfo :: Maybe (Int, Int)
linesInfo = if Bool
notMini Bool -> Bool -> Bool
&& Bool
displayLineNumbers
then (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
topLine, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
lineCount) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
else Maybe (Int, Int)
forall a. Maybe a
Nothing
wNumbers :: Int
wNumbers = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd Maybe (Int, Int)
linesInfo
off :: Int
off = if Bool
notMini then Int
1 else Int
0
h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
off
ground :: Attributes
ground = UIStyle -> Attributes
baseAttributes UIStyle
sty
wsty :: Attr
wsty = Attributes -> Attr -> Attr
attributesToAttr Attributes
ground Attr
Vty.defAttr
eofsty :: Attributes
eofsty = Endo Attributes -> Attributes -> Attributes
forall a. Endo a -> a -> a
appEndo (StyleName
eofStyle UIStyle
sty) Attributes
ground
(Point
point, FBuffer
_) = Window -> FBuffer -> BufferM Point -> (Point, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM Point
pointB
(YiString
text, FBuffer
_) = Window -> FBuffer -> BufferM YiString -> (YiString, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b (BufferM YiString -> (YiString, FBuffer))
-> BufferM YiString -> (YiString, FBuffer)
forall a b. (a -> b) -> a -> b
$
(YiString, YiString) -> YiString
forall a b. (a, b) -> a
fst ((YiString, YiString) -> YiString)
-> (YiString -> (YiString, YiString)) -> YiString -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YiString -> (YiString, YiString)
R.splitAtLine Int
h' (YiString -> YiString) -> BufferM YiString -> BufferM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> Point -> BufferM YiString
streamB Direction
Forward Point
fromMarkPoint
region :: Region
region = Point -> Size -> Region
mkSizeRegion Point
fromMarkPoint (Size -> Region) -> (Int -> Size) -> Int -> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Size
Size (Int -> Region) -> Int -> Region
forall a b. (a -> b) -> a -> b
$! YiString -> Int
R.length YiString
text
(Just (MarkSet Mark
fromM Mark
_ Mark
_), FBuffer
_) = Window
-> FBuffer
-> BufferM (Maybe (MarkSet Mark))
-> (Maybe (MarkSet Mark), FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b (Window -> BufferM (Maybe (MarkSet Mark))
getMarks Window
win)
fromMarkPoint :: Point
fromMarkPoint = if Bool
notMini
then (Point, FBuffer) -> Point
forall a b. (a, b) -> a
fst ((Point, FBuffer) -> Point) -> (Point, FBuffer) -> Point
forall a b. (a -> b) -> a -> b
$ Window -> FBuffer -> BufferM Point -> (Point, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b (BufferM Point -> (Point, FBuffer))
-> BufferM Point -> (Point, FBuffer)
forall a b. (a -> b) -> a -> b
$ Getting Point FBuffer Point -> BufferM Point
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Point FBuffer Point -> BufferM Point)
-> Getting Point FBuffer Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Mark -> Lens' FBuffer Point
markPointA Mark
fromM
else Int -> Point
Point Int
0
([(Point, Attributes)]
attributes, FBuffer
_) = Window
-> FBuffer
-> BufferM [(Point, Attributes)]
-> ([(Point, Attributes)], FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b (BufferM [(Point, Attributes)] -> ([(Point, Attributes)], FBuffer))
-> BufferM [(Point, Attributes)]
-> ([(Point, Attributes)], FBuffer)
forall a b. (a -> b) -> a -> b
$ UIStyle
-> Maybe SearchExp -> Region -> BufferM [(Point, Attributes)]
attributesPictureAndSelB UIStyle
sty (Editor -> Maybe SearchExp
currentRegex Editor
e) Region
region
colors :: [(Point, Attr)]
colors = ((Point, Attributes) -> (Point, Attr))
-> [(Point, Attributes)] -> [(Point, Attr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Attributes -> Attr) -> (Point, Attributes) -> (Point, Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Attr
Vty.defAttr) ((Attr -> Attr) -> Attr)
-> (Attributes -> Attr -> Attr) -> Attributes -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Attr -> Attr
attributesToAttr)) [(Point, Attributes)]
attributes
bufData :: [(Char, Attr)]
bufData = Attr -> [(Point, Attr)] -> [(Point, Char)] -> [(Char, Attr)]
forall a. a -> [(Point, a)] -> [(Point, Char)] -> [(Char, a)]
paintChars Attr
Vty.defAttr [(Point, Attr)]
colors ([(Point, Char)] -> [(Char, Attr)])
-> [(Point, Char)] -> [(Char, Attr)]
forall a b. (a -> b) -> a -> b
$! [Point] -> String -> [(Point, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Point
fromMarkPoint..] (YiString -> String
R.toString YiString
text)
tabWidth :: Int
tabWidth = IndentSettings -> Int
tabSize (IndentSettings -> Int)
-> ((IndentSettings, FBuffer) -> IndentSettings)
-> (IndentSettings, FBuffer)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IndentSettings, FBuffer) -> IndentSettings
forall a b. (a, b) -> a
fst ((IndentSettings, FBuffer) -> Int)
-> (IndentSettings, FBuffer) -> Int
forall a b. (a -> b) -> a -> b
$ Window
-> FBuffer -> BufferM IndentSettings -> (IndentSettings, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM IndentSettings
indentSettingsB
prompt :: Text
prompt = if Window -> Bool
isMini Window
win then FBuffer -> Text
miniIdentString FBuffer
b else Text
""
cur :: Maybe (Int, Int)
cur = ((Point2D -> (Int, Int)) -> Maybe Point2D -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SL.Point2D Int
curx Int
cury) -> (Int
cury, Text -> Int
T.length Text
prompt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wNumbers Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
curx)) (Maybe Point2D -> Maybe (Int, Int))
-> ((Maybe Point2D, FBuffer) -> Maybe Point2D)
-> (Maybe Point2D, FBuffer)
-> Maybe (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Point2D, FBuffer) -> Maybe Point2D
forall a b. (a, b) -> a
fst)
(Window
-> FBuffer -> BufferM (Maybe Point2D) -> (Maybe Point2D, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b
(Size2D -> Point -> Point -> BufferM (Maybe Point2D)
SL.coordsOfCharacterB
(Int -> Int -> Size2D
SL.Size2D (Int
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wNumbers) Int
h)
Point
fromMarkPoint
Point
point))
rendered :: [Image]
rendered =
Attr
-> Int
-> Int
-> Int
-> Maybe (Int, Int)
-> [(Char, Attr)]
-> [Image]
drawText Attr
wsty Int
h' Int
w'
Int
tabWidth
Maybe (Int, Int)
linesInfo
([(Char
c, Attr
wsty) | Char
c <- Text -> String
T.unpack Text
prompt] [(Char, Attr)] -> [(Char, Attr)] -> [(Char, Attr)]
forall a. [a] -> [a] -> [a]
++ [(Char, Attr)]
bufData [(Char, Attr)] -> [(Char, Attr)] -> [(Char, Attr)]
forall a. [a] -> [a] -> [a]
++ [(Char
' ', Attr
wsty)])
commonPref :: [Text]
commonPref = String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Editor -> [String]
commonNamePrefix Editor
e
(Text
modeLine0, FBuffer
_) = Window -> FBuffer -> BufferM Text -> (Text, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b (BufferM Text -> (Text, FBuffer))
-> BufferM Text -> (Text, FBuffer)
forall a b. (a -> b) -> a -> b
$ [Text] -> BufferM Text
getModeLine [Text]
commonPref
modeLine :: Maybe Text
modeLine = if Bool
notMini then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
modeLine0 else Maybe Text
forall a. Maybe a
Nothing
prepare :: Text -> Image
prepare = Attributes -> Text -> Image
withAttributes Attributes
modeStyle (Text -> Image) -> (Text -> Text) -> Text -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> Text -> Text
T.justifyLeft Int
w' Char
' ' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
w'
modeLines :: [Image]
modeLines = (Text -> Image) -> [Text] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Image
prepare ([Text] -> [Image]) -> [Text] -> [Image]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
modeLine
modeStyle :: Attributes
modeStyle = (if Bool
focused then Endo Attributes -> Attributes -> Attributes
forall a. Endo a -> a -> a
appEndo (StyleName
modelineFocusStyle UIStyle
sty) else Attributes -> Attributes
forall a. a -> a
id) (UIStyle -> Attributes
modelineAttributes UIStyle
sty)
filler :: T.Text
filler :: Text
filler = if Int
w' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Text
T.empty
else Int -> Char -> Text -> Text
T.justifyLeft Int
w' Char
' ' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (UIConfig -> Char
configWindowFill UIConfig
cfg)
pict :: Image
pict = [Image] -> Image
Vty.vertCat ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$ Int -> [Image] -> [Image]
forall a. Int -> [a] -> [a]
take Int
h' ([Image]
rendered [Image] -> [Image] -> [Image]
forall a. Semigroup a => a -> a -> a
<> Image -> [Image]
forall a. a -> [a]
repeat (Attributes -> Text -> Image
withAttributes Attributes
eofsty Text
filler)) [Image] -> [Image] -> [Image]
forall a. Semigroup a => a -> a -> a
<> [Image]
modeLines
sepStyle :: Attr
sepStyle = Attributes -> Attr -> Attr
attributesToAttr (UIStyle -> Attributes
modelineAttributes UIStyle
sty) Attr
Vty.defAttr
vertSep :: Image
vertSep = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
sepStyle Char
' ' Int
1 Int
h
withAttributes :: Attributes -> T.Text -> Vty.Image
withAttributes :: Attributes -> Text -> Image
withAttributes Attributes
sty = Attr -> Text -> Image
Vty.text' (Attributes -> Attr -> Attr
attributesToAttr Attributes
sty Attr
Vty.defAttr)
attributesToAttr :: Attributes -> Vty.Attr -> Vty.Attr
attributesToAttr :: Attributes -> Attr -> Attr
attributesToAttr (Attributes Color
fg Color
bg Bool
reverse Bool
bd Bool
_itlc Bool
underline') =
(if Bool
reverse then (Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.reverseVideo) else Attr -> Attr
forall a. a -> a
id) (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Bool
bd then (Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.bold) else Attr -> Attr
forall a. a -> a
id) (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Bool
underline' then (Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.underline) else Attr -> Attr
forall a. a -> a
id) (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Color -> Attr -> Attr) -> Color -> Attr -> Attr
colorToAttr ((Attr -> Color -> Attr) -> Color -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Color -> Attr
Vty.withForeColor) Color
fg (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Color -> Attr -> Attr) -> Color -> Attr -> Attr
colorToAttr ((Attr -> Color -> Attr) -> Color -> Attr -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Attr -> Color -> Attr
Vty.withBackColor) Color
bg
paintChars :: a -> [(Point, a)] -> [(Point, Char)] -> [(Char, a)]
paintChars :: a -> [(Point, a)] -> [(Point, Char)] -> [(Char, a)]
paintChars a
sty [(Point, a)]
changes [(Point, Char)]
cs = String -> [a] -> [(Char, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Point, Char) -> Char) -> [(Point, Char)] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point, Char) -> Char
forall a b. (a, b) -> b
snd [(Point, Char)]
cs) [a]
attrs
where attrs :: [a]
attrs = a -> [(Point, a)] -> [(Point, Char)] -> [a]
forall a. a -> [(Point, a)] -> [(Point, Char)] -> [a]
stys a
sty [(Point, a)]
changes [(Point, Char)]
cs
stys :: a -> [(Point, a)] -> [(Point, Char)] -> [a]
stys :: a -> [(Point, a)] -> [(Point, Char)] -> [a]
stys a
sty [] [(Point, Char)]
cs = [ a
sty | (Point, Char)
_ <- [(Point, Char)]
cs ]
stys a
sty ((Point
endPos, a
sty') : [(Point, a)]
xs) [(Point, Char)]
cs = [ a
sty | (Point, Char)
_ <- [(Point, Char)]
previous ] [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> a -> [(Point, a)] -> [(Point, Char)] -> [a]
forall a. a -> [(Point, a)] -> [(Point, Char)] -> [a]
stys a
sty' [(Point, a)]
xs [(Point, Char)]
later
where ([(Point, Char)]
previous, [(Point, Char)]
later) = ((Point, Char) -> Bool)
-> [(Point, Char)] -> ([(Point, Char)], [(Point, Char)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Point
endPos Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<=) (Point -> Bool)
-> ((Point, Char) -> Point) -> (Point, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, Char) -> Point
forall a b. (a, b) -> a
fst) [(Point, Char)]
cs
drawText :: Vty.Attr
-> Int
-> Int
-> Int
-> Maybe (Int, Int)
-> [(Char, Vty.Attr)]
-> [Vty.Image]
drawText :: Attr
-> Int
-> Int
-> Int
-> Maybe (Int, Int)
-> [(Char, Attr)]
-> [Image]
drawText Attr
wsty Int
h Int
w Int
tabWidth Maybe (Int, Int)
linesInfo [(Char, Attr)]
bufData
| Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = []
| Bool
otherwise = case Maybe (Int, Int)
linesInfo of
Maybe (Int, Int)
Nothing -> [Image]
renderedLines
Just (Int
firstLine, Int
lineNumberWidth) -> Int -> Int -> [Image]
renderedLinesWithNumbers Int
firstLine Int
lineNumberWidth
where
wrapped :: Int -> [[[(Char, Attr)]]]
wrapped Int
w' = ([(Char, Attr)] -> [[(Char, Attr)]])
-> [[(Char, Attr)]] -> [[[(Char, Attr)]]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [(Char, Attr)] -> [[(Char, Attr)]]
forall x. Int -> [x] -> [[x]]
wrapLine Int
w' ([(Char, Attr)] -> [[(Char, Attr)]])
-> ([(Char, Attr)] -> [(Char, Attr)])
-> [(Char, Attr)]
-> [[(Char, Attr)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Attr)] -> [(Char, Attr)]
addSpace ([(Char, Attr)] -> [(Char, Attr)])
-> ([(Char, Attr)] -> [(Char, Attr)])
-> [(Char, Attr)]
-> [(Char, Attr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Attr) -> [(Char, Attr)])
-> [(Char, Attr)] -> [(Char, Attr)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char, Attr) -> [(Char, Attr)]
forall b. (Char, b) -> [(Char, b)]
expandGraphic) ([[(Char, Attr)]] -> [[[(Char, Attr)]]])
-> [[(Char, Attr)]] -> [[[(Char, Attr)]]]
forall a b. (a -> b) -> a -> b
$ Int -> [[(Char, Attr)]] -> [[(Char, Attr)]]
forall a. Int -> [a] -> [a]
take Int
h ([[(Char, Attr)]] -> [[(Char, Attr)]])
-> [[(Char, Attr)]] -> [[(Char, Attr)]]
forall a b. (a -> b) -> a -> b
$ [(Char, Attr)] -> [[(Char, Attr)]]
forall a. [(Char, a)] -> [[(Char, a)]]
lines' [(Char, Attr)]
bufData
renderedLinesWithNumbers :: Int -> Int -> [Image]
renderedLinesWithNumbers Int
firstLine Int
lineNumberWidth =
let lns0 :: [(Maybe Int, [(Char, Attr)])]
lns0 = Int
-> [(Maybe Int, [(Char, Attr)])] -> [(Maybe Int, [(Char, Attr)])]
forall a. Int -> [a] -> [a]
take Int
h ([(Maybe Int, [(Char, Attr)])] -> [(Maybe Int, [(Char, Attr)])])
-> [(Maybe Int, [(Char, Attr)])] -> [(Maybe Int, [(Char, Attr)])]
forall a b. (a -> b) -> a -> b
$ Int -> [[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])]
concatWithNumbers Int
firstLine ([[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])])
-> [[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])]
forall a b. (a -> b) -> a -> b
$ Int -> [[[(Char, Attr)]]]
wrapped (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineNumberWidth)
renderLineWithNumber :: (Maybe Int, [(Char, Attr)]) -> Image
renderLineWithNumber (Maybe Int
num, [(Char, Attr)]
ln) = Int -> Maybe Int -> Image
renderLineNumber Int
lineNumberWidth Maybe Int
num Image -> Image -> Image
Vty.<|> Int -> [(Char, Attr)] -> Image
fillColorLine (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineNumberWidth) [(Char, Attr)]
ln
in ((Maybe Int, [(Char, Attr)]) -> Image)
-> [(Maybe Int, [(Char, Attr)])] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int, [(Char, Attr)]) -> Image
renderLineWithNumber [(Maybe Int, [(Char, Attr)])]
lns0
renderedLines :: [Image]
renderedLines = ([(Char, Attr)] -> Image) -> [[(Char, Attr)]] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [(Char, Attr)] -> Image
fillColorLine Int
w) ([[(Char, Attr)]] -> [Image]) -> [[(Char, Attr)]] -> [Image]
forall a b. (a -> b) -> a -> b
$ Int -> [[(Char, Attr)]] -> [[(Char, Attr)]]
forall a. Int -> [a] -> [a]
take Int
h ([[(Char, Attr)]] -> [[(Char, Attr)]])
-> [[(Char, Attr)]] -> [[(Char, Attr)]]
forall a b. (a -> b) -> a -> b
$ [[[(Char, Attr)]]] -> [[(Char, Attr)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[(Char, Attr)]]] -> [[(Char, Attr)]])
-> [[[(Char, Attr)]]] -> [[(Char, Attr)]]
forall a b. (a -> b) -> a -> b
$ Int -> [[[(Char, Attr)]]]
wrapped Int
w
colorChar :: (Char, Attr) -> Image
colorChar (Char
c, Attr
a) = Attr -> Char -> Image
Vty.char Attr
a Char
c
concatWithNumbers :: Int -> [[[(Char, Vty.Attr)]]] -> [(Maybe Int, [(Char, Vty.Attr)])]
concatWithNumbers :: Int -> [[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])]
concatWithNumbers Int
_ [] = []
concatWithNumbers Int
n ([]:[[[(Char, Attr)]]]
ls) = Int -> [[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])]
concatWithNumbers Int
n [[[(Char, Attr)]]]
ls
concatWithNumbers Int
n (([(Char, Attr)]
l0:[[(Char, Attr)]]
ls0):[[[(Char, Attr)]]]
ls) = (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n, [(Char, Attr)]
l0) (Maybe Int, [(Char, Attr)])
-> [(Maybe Int, [(Char, Attr)])] -> [(Maybe Int, [(Char, Attr)])]
forall a. a -> [a] -> [a]
: ([(Char, Attr)] -> (Maybe Int, [(Char, Attr)]))
-> [[(Char, Attr)]] -> [(Maybe Int, [(Char, Attr)])]
forall a b. (a -> b) -> [a] -> [b]
map (\[(Char, Attr)]
l -> (Maybe Int
forall a. Maybe a
Nothing, [(Char, Attr)]
l)) [[(Char, Attr)]]
ls0 [(Maybe Int, [(Char, Attr)])]
-> [(Maybe Int, [(Char, Attr)])] -> [(Maybe Int, [(Char, Attr)])]
forall a. [a] -> [a] -> [a]
++ Int -> [[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])]
concatWithNumbers (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [[[(Char, Attr)]]]
ls
renderLineNumber :: Int -> Maybe Int -> Vty.Image
renderLineNumber :: Int -> Maybe Int -> Image
renderLineNumber Int
w' (Just Int
n) = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
wsty Char
' ' (Int
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
1
Image -> Image -> Image
Vty.<|>
Attr -> String -> Image
Vty.string Attr
wsty (Int -> String
forall a. Show a => a -> String
show Int
n)
Image -> Image -> Image
Vty.<|>
Attr -> Char -> Image
Vty.char Attr
wsty Char
' '
renderLineNumber Int
w' Maybe Int
Nothing = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
wsty Char
' ' Int
w' Int
1
fillColorLine :: Int -> [(Char, Vty.Attr)] -> Vty.Image
fillColorLine :: Int -> [(Char, Attr)] -> Image
fillColorLine Int
w' [] = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
Vty.defAttr Char
' ' Int
w' Int
1
fillColorLine Int
w' [(Char, Attr)]
l = [Image] -> Image
Vty.horizCat (((Char, Attr) -> Image) -> [(Char, Attr)] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Attr) -> Image
colorChar [(Char, Attr)]
l)
Image -> Image -> Image
Vty.<|>
Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
a Char
' ' (Int
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(Char, Attr)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Char, Attr)]
l) Int
1
where (Char
_, Attr
a) = [(Char, Attr)] -> (Char, Attr)
forall a. [a] -> a
last [(Char, Attr)]
l
addSpace :: [(Char, Vty.Attr)] -> [(Char, Vty.Attr)]
addSpace :: [(Char, Attr)] -> [(Char, Attr)]
addSpace [] = [(Char
' ', Attr
wsty)]
addSpace [(Char, Attr)]
l = case Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
lineLength Int
w of
Int
0 -> [(Char, Attr)]
l
Int
_ -> [(Char, Attr)]
l [(Char, Attr)] -> [(Char, Attr)] -> [(Char, Attr)]
forall a. [a] -> [a] -> [a]
++ [(Char
' ', Attr
wsty)]
where
lineLength :: Int
lineLength = [(Char, Attr)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Char, Attr)]
l
lines' :: [(Char, a)] -> [[(Char, a)]]
lines' :: [(Char, a)] -> [[(Char, a)]]
lines' [] = []
lines' [(Char, a)]
s = case [(Char, a)]
s' of
[] -> [[(Char, a)]
l]
((Char
_,a
_):[(Char, a)]
s'') -> [(Char, a)]
l [(Char, a)] -> [[(Char, a)]] -> [[(Char, a)]]
forall a. a -> [a] -> [a]
: [(Char, a)] -> [[(Char, a)]]
forall a. [(Char, a)] -> [[(Char, a)]]
lines' [(Char, a)]
s''
where
([(Char, a)]
l, [(Char, a)]
s') = ((Char, a) -> Bool) -> [(Char, a)] -> ([(Char, a)], [(Char, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (Char -> Bool) -> ((Char, a) -> Char) -> (Char, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, a) -> Char
forall a b. (a, b) -> a
fst) [(Char, a)]
s
wrapLine :: Int -> [x] -> [[x]]
wrapLine :: Int -> [x] -> [[x]]
wrapLine Int
_ [] = []
wrapLine Int
n [x]
l = let ([x]
x,[x]
rest) = Int -> [x] -> ([x], [x])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [x]
l in [x]
x [x] -> [[x]] -> [[x]]
forall a. a -> [a] -> [a]
: Int -> [x] -> [[x]]
forall x. Int -> [x] -> [[x]]
wrapLine Int
n [x]
rest
expandGraphic :: (Char, b) -> [(Char, b)]
expandGraphic (Char
'\t', b
p) = Int -> (Char, b) -> [(Char, b)]
forall a. Int -> a -> [a]
replicate Int
tabWidth (Char
' ', b
p)
expandGraphic (Char
c, b
p)
| Int
numeric Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = [(Char
'^', b
p), (Int -> Char
chr (Int
numeric Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64), b
p)]
| Bool
otherwise = [(Char
c, b
p)]
where numeric :: Int
numeric = Char -> Int
ord Char
c
renderTabBar :: SL.Rect -> UIStyle -> [(T.Text, Bool)] -> Vty.Image
renderTabBar :: Rect -> UIStyle -> [(Text, Bool)] -> Image
renderTabBar Rect
r UIStyle
uiStyle [(Text, Bool)]
ts = (Image -> Image -> Image
Vty.<|> Image
padding) (Image -> Image) -> ([Image] -> Image) -> [Image] -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Image] -> Image
Vty.horizCat ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$ ((Text, Bool) -> Image) -> [(Text, Bool)] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Bool) -> Image
render [(Text, Bool)]
ts
where
render :: (Text, Bool) -> Image
render (Text
text, Bool
inFocus) = Attr -> Text -> Image
Vty.text' (Bool -> Attr
tabAttr Bool
inFocus) (Text -> Text
tabTitle Text
text)
tabTitle :: Text -> Text
tabTitle Text
text = Char
' ' Char -> Text -> Text
`T.cons` Text
text Text -> Char -> Text
`T.snoc` Char
' '
tabAttr :: Bool -> Attr
tabAttr Bool
b = Bool -> Attributes -> Attr
baseAttr Bool
b (Attributes -> Attr) -> Attributes -> Attr
forall a b. (a -> b) -> a -> b
$ UIStyle -> Attributes
tabBarAttributes UIStyle
uiStyle
baseAttr :: Bool -> Attributes -> Attr
baseAttr Bool
True Attributes
sty =
Attributes -> Attr -> Attr
attributesToAttr (Endo Attributes -> Attributes -> Attributes
forall a. Endo a -> a -> a
appEndo (StyleName
tabInFocusStyle UIStyle
uiStyle) Attributes
sty) Attr
Vty.defAttr
baseAttr Bool
False Attributes
sty =
Attributes -> Attr -> Attr
attributesToAttr (Endo Attributes -> Attributes -> Attributes
forall a. Endo a -> a -> a
appEndo (StyleName
tabNotFocusedStyle UIStyle
uiStyle) Attributes
sty) Attr
Vty.defAttr
Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.underline
padding :: Image
padding = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill (Bool -> Attr
tabAttr Bool
False) Char
' ' (Rect -> Int
SL.sizeX Rect
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width') Int
1
width' :: Int
width' = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> ([(Text, Bool)] -> [Int]) -> [(Text, Bool)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Bool) -> Int) -> [(Text, Bool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (Int -> Int) -> ((Text, Bool) -> Int) -> (Text, Bool) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int) -> ((Text, Bool) -> Text) -> (Text, Bool) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Bool) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Bool)] -> Int) -> [(Text, Bool)] -> Int
forall a b. (a -> b) -> a -> b
$ [(Text, Bool)]
ts