{-# 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
config submitEvents :: [Event] -> IO ()
submitEvents submitActions :: [Action] -> IO ()
submitActions editor :: 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
Nothing -> IO Config
Vty.standardIOConfig
Just conf :: 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 evs :: 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 _ _) -> do
[Action] -> IO ()
submitActions []
IO Event
getEvent
_ -> 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 "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 "VtyInput"
ThreadId
renderThreadId <- IO () -> IO ThreadId
forkIO IO ()
renderLoop
ThreadId -> String -> IO ()
labelThread ThreadId
renderThreadId "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 fs :: FrontendState
fs = do
ThreadId
tid <- IO ThreadId
myThreadId
ThreadId -> String -> IO ()
labelThread ThreadId
tid "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 fs :: FrontendState
fs e :: Editor
e = do
(colCount :: Int
colCount, rowCount :: Int
rowCount) <- Output -> IO (Int, Int)
Vty.displayBounds (Vty -> Output
Vty.outputIface (FrontendState -> Vty
fsVty FrontendState
fs))
let (e' :: Editor
e', _layout :: 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 fs :: FrontendState
fs mExit :: 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
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just code :: 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 fs :: FrontendState
fs e :: 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 fs :: FrontendState
fs e :: Editor
e = do
(colCount :: Int
colCount, rowCount :: Int
rowCount) <- Output -> IO (Int, Int)
Vty.displayBounds (Vty -> Output
Vty.outputIface (FrontendState -> Vty
fsVty FrontendState
fs))
let (_e :: Editor
_e, SL.Layout tabbarRect :: Rect
tabbarRect winRects :: Map WindowRef (Rect, Bool)
winRects promptRect :: 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
(cmd :: [Text]
cmd, cmdSty :: 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 ' ' (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
text = Attributes -> Text -> Image
withAttributes Attributes
statusBarStyle (Text -> Text
mkLine Text
text)
winImage :: (Window, Bool) -> Rendered
winImage (win :: Window
win, hasFocus :: Bool
hasFocus) =
let (rect :: Rect
rect, nb :: 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 (\(w :: Window
w, f :: 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 t :: Text
t f :: 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 (w :: Window
w, image :: 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
(False, Just (y :: Int
y, x :: 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)
(True, Just (_, x :: 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
- 1))
(_, Nothing) -> Cursor
Vty.NoCursor
Text -> IO ()
forall (m :: * -> *). MonadBase IO m => Text -> m ()
logPutStrLn "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 cfg' :: Config
cfg' e :: Editor
e (SL.Rect x :: Int
x y :: Int
y _ _) nb :: Bool
nb (win :: Window
win, focused :: 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 (\(i :: Int
i, j :: 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 1 else 0
w' :: Int
w' = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- if Bool
nb then 1 else 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
(lineCount :: Int
lineCount, _) = Window -> FBuffer -> BufferM Int -> (Int, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM Int
lineCountB
(topLine :: Int
topLine, _) = 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
+ 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 0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd Maybe (Int, Int)
linesInfo
off :: Int
off = if Bool
notMini then 1 else 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
point, _) = Window -> FBuffer -> BufferM Point -> (Point, FBuffer)
forall a. Window -> FBuffer -> BufferM a -> (a, FBuffer)
runBuffer Window
win FBuffer
b BufferM Point
pointB
(text :: YiString
text, _) = 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 fromM :: Mark
fromM _ _), _) = 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 0
(attributes :: [(Point, Attributes)]
attributes, _) = 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 ""
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 curx :: Int
curx cury :: 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]
++ [(' ', 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
(modeLine0 :: Text
modeLine0, _) = 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' ' ' (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
== 0
then Text
T.empty
else Int -> Char -> Text -> Text
T.justifyLeft Int
w' ' ' (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 ' ' 1 Int
h
withAttributes :: Attributes -> T.Text -> Vty.Image
withAttributes :: Attributes -> Text -> Image
withAttributes sty :: 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 fg :: Color
fg bg :: Color
bg reverse :: Bool
reverse bd :: Bool
bd _itlc :: Bool
_itlc underline' :: 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 sty :: a
sty changes :: [(Point, a)]
changes cs :: [(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 sty :: a
sty [] cs :: [(Point, Char)]
cs = [ a
sty | (Point, Char)
_ <- [(Point, Char)]
cs ]
stys sty :: a
sty ((endPos :: Point
endPos, sty' :: a
sty') : xs :: [(Point, a)]
xs) cs :: [(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 (previous :: [(Point, Char)]
previous, later :: [(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 wsty :: Attr
wsty h :: Int
h w :: Int
w tabWidth :: Int
tabWidth linesInfo :: Maybe (Int, Int)
linesInfo bufData :: [(Char, Attr)]
bufData
| Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = []
| Bool
otherwise = case Maybe (Int, Int)
linesInfo of
Nothing -> [Image]
renderedLines
Just (firstLine :: Int
firstLine, lineNumberWidth :: Int
lineNumberWidth) -> Int -> Int -> [Image]
renderedLinesWithNumbers Int
firstLine Int
lineNumberWidth
where
wrapped :: Int -> [[[(Char, Attr)]]]
wrapped w' :: 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 firstLine :: Int
firstLine lineNumberWidth :: 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 (num :: Maybe Int
num, ln :: [(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 (c :: Char
c, a :: 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 _ [] = []
concatWithNumbers n :: Int
n ([]:ls :: [[[(Char, Attr)]]]
ls) = Int -> [[[(Char, Attr)]]] -> [(Maybe Int, [(Char, Attr)])]
concatWithNumbers Int
n [[[(Char, Attr)]]]
ls
concatWithNumbers n :: Int
n ((l0 :: [(Char, Attr)]
l0:ls0 :: [[(Char, Attr)]]
ls0):ls :: [[[(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 (\l :: [(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
+1) [[[(Char, Attr)]]]
ls
renderLineNumber :: Int -> Maybe Int -> Vty.Image
renderLineNumber :: Int -> Maybe Int -> Image
renderLineNumber w' :: Int
w' (Just n :: Int
n) = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
wsty ' ' (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
- 1) 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 ' '
renderLineNumber w' :: Int
w' Nothing = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
wsty ' ' Int
w' 1
fillColorLine :: Int -> [(Char, Vty.Attr)] -> Vty.Image
fillColorLine :: Int -> [(Char, Attr)] -> Image
fillColorLine w' :: Int
w' [] = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
Vty.defAttr ' ' Int
w' 1
fillColorLine w' :: Int
w' l :: [(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 ' ' (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) 1
where (_, a :: 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 [] = [(' ', Attr
wsty)]
addSpace l :: [(Char, Attr)]
l = case Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
lineLength Int
w of
0 -> [(Char, Attr)]
l
_ -> [(Char, Attr)]
l [(Char, Attr)] -> [(Char, Attr)] -> [(Char, Attr)]
forall a. [a] -> [a] -> [a]
++ [(' ', 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' s :: [(Char, a)]
s = case [(Char, a)]
s' of
[] -> [[(Char, a)]
l]
((_,_):s'' :: [(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
(l :: [(Char, a)]
l, s' :: [(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
== '\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 _ [] = []
wrapLine n :: Int
n l :: [x]
l = let (x :: [x]
x,rest :: [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 ('\t', p :: b
p) = Int -> (Char, b) -> [(Char, b)]
forall a. Int -> a -> [a]
replicate Int
tabWidth (' ', b
p)
expandGraphic (c :: Char
c, p :: b
p)
| Int
numeric Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 32 = [('^', b
p), (Int -> Char
chr (Int
numeric Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 r :: Rect
r uiStyle :: UIStyle
uiStyle ts :: [(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
text, inFocus :: Bool
inFocus) = Attr -> Text -> Image
Vty.text' (Bool -> Attr
tabAttr Bool
inFocus) (Text -> Text
tabTitle Text
text)
tabTitle :: Text -> Text
tabTitle text :: Text
text = ' ' Char -> Text -> Text
`T.cons` Text
text Text -> Char -> Text
`T.snoc` ' '
tabAttr :: Bool -> Attr
tabAttr b :: 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 True sty :: 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 False sty :: 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) ' ' (Rect -> Int
SL.sizeX Rect
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width') 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
+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