Skip to content
Browse files

Merge pull request #799 from mmn80/vty-layout

Implement LayoutManager for the vty frontend
  • Loading branch information...
2 parents b43a7e8 + 0e4dabd commit 038d7eb3228892e7b4ca3d9785d8f194182cf1da @ethercrow ethercrow committed May 22, 2016
Showing with 128 additions and 80 deletions.
  1. +3 −1 .gitignore
  2. +14 −4 src/library/Yi/Editor.hs
  3. +45 −19 src/library/Yi/Layout.hs
  4. +41 −39 src/library/Yi/UI/SimpleLayout.hs
  5. +25 −17 src/library/Yi/UI/Vty.hs
View
4 .gitignore
@@ -21,4 +21,6 @@ hsenv.log
cabal.sandbox.config
.cabal-sandbox
tags
-TAGS
+TAGS
+.stack-work/
+stack.yaml
View
18 src/library/Yi/Editor.hs
@@ -51,6 +51,7 @@ module Yi.Editor ( Editor(..), EditorM, MonadEditor(..)
, layoutManagerPreviousVariantE
, layoutManagersNextE
, layoutManagersPreviousE
+ , layoutManagersPrintMsgE
, maxStatusHeightA
, moveTabE
, moveWinNextE
@@ -625,15 +626,21 @@ splitE = do
w <- gets currentBuffer >>= newWindowE False
windowsA %= PL.insertRight w
+-- | Prints the description of the current layout manager in the status bar
+layoutManagersPrintMsgE :: EditorM ()
+layoutManagersPrintMsgE = do
+ lm <- use $ currentTabA . tabLayoutManagerA
+ printMsg . T.pack $ describeLayout lm
+
-- | Cycle to the next layout manager, or the first one if the current
-- one is nonstandard.
layoutManagersNextE :: EditorM ()
-layoutManagersNextE = withLMStackE PL.next
+layoutManagersNextE = withLMStackE PL.next >> layoutManagersPrintMsgE
-- | Cycle to the previous layout manager, or the first one if the
-- current one is nonstandard.
layoutManagersPreviousE :: EditorM ()
-layoutManagersPreviousE = withLMStackE PL.previous
+layoutManagersPreviousE = withLMStackE PL.previous >> layoutManagersPrintMsgE
-- | Helper function for 'layoutManagersNext' and 'layoutManagersPrevious'
withLMStackE :: (PL.PointedList AnyLayoutManager
@@ -650,13 +657,16 @@ withLMStackE f = askCfg >>= \cfg ->
-- | Next variant of the current layout manager, as given by 'nextVariant'
layoutManagerNextVariantE :: EditorM ()
-layoutManagerNextVariantE = currentTabA . tabLayoutManagerA %= nextVariant
+layoutManagerNextVariantE = do
+ currentTabA . tabLayoutManagerA %= nextVariant
+ layoutManagersPrintMsgE
-- | Previous variant of the current layout manager, as given by
-- 'previousVariant'
layoutManagerPreviousVariantE :: EditorM ()
-layoutManagerPreviousVariantE =
+layoutManagerPreviousVariantE = do
currentTabA . tabLayoutManagerA %= previousVariant
+ layoutManagersPrintMsgE
-- | Sets the given divider position on the current tab
setDividerPosE :: DividerRef -> DividerPosition -> EditorM ()
View
64 src/library/Yi/Layout.hs
@@ -16,6 +16,7 @@ module Yi.Layout
DividerRef,
RelativeSize,
dividerPositionA,
+ findDivider,
-- * Layout managers
-- ** The interface
@@ -32,6 +33,7 @@ module Yi.Layout
-- * Utility functions
-- ** Layouts as rectangles
Rectangle(..),
+ HasNeighborWest,
layoutToRectangles,
-- ** Transposing things
Transposable(..),
@@ -53,7 +55,7 @@ import Control.Lens (Lens', lens)
import qualified Control.Monad.State.Strict as Monad (State, evalState, get, put)
import Data.Default (Default, def)
import Data.List (foldl', mapAccumL)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isNothing)
import Data.Typeable (Typeable, cast, typeOf)
-------------------------------- Some design notes ----------------------
@@ -122,6 +124,18 @@ dividerPositionA ref = lens getter (flip setter) where
invalidRef = error "Yi.Layout.dividerPositionA: invalid DividerRef"
+-- | Find the divider nearest to a given window, or just the first one
+-- in case the argument is 'Nothing'
+findDivider :: Eq a => Maybe a -> Layout a -> Maybe DividerRef
+findDivider mbw = go [] where
+ go path (SingleWindow w) = maybe Nothing (\w' ->
+ if w == w' && not (null path)
+ then Just (head path) else Nothing) mbw
+ go path (Pair _ _ ref l1 l2) = if isNothing mbw then Just ref
+ else let p' = ref : path
+ in go p' l1 <|> go p' l2
+ go path (Stack _ ws) = foldr (<|>) Nothing $ map (go path . fst) ws
+
instance Show a => Show (Layout a) where
show (SingleWindow a) = show a
show (Stack o s) = show o ++ " stack " ++ show s
@@ -296,24 +310,36 @@ instance LayoutManager VPairNStack where
data Rectangle = Rectangle { rectX, rectY, rectWidth, rectHeight :: !Double }
deriving(Eq, Show)
-layoutToRectangles :: Rectangle -> Layout a -> [(a, Rectangle)]
-layoutToRectangles bounds (SingleWindow a) = [(a, bounds)]
-layoutToRectangles bounds (Stack o ts) = handleStack o bounds ts
-layoutToRectangles bounds (Pair o p _ a b) = handleStack o bounds [(a,p), (b,1-p)]
-
-handleStack :: Orientation -> Rectangle -> [(Layout a, RelativeSize)] -> [(a, Rectangle)]
-handleStack o bounds tiles =
- let (totalSpace, startPos, mkBounds) = case o of
- Vertical -> (rectHeight bounds, rectY bounds, \pos size -> bounds{rectY = pos, rectHeight=size})
- Horizontal -> (rectWidth bounds, rectX bounds, \pos size -> bounds{rectX = pos, rectWidth=size})
-
- totalWeight' = sum (fmap snd tiles)
- totalWeight = if totalWeight' > 0 then totalWeight' else error "Yi.Layout: Stacks must have positive weights"
- spacePerWeight = totalSpace / totalWeight
- doTile pos (t, wt) = (pos + wt * spacePerWeight,
- layoutToRectangles (mkBounds pos (wt * spacePerWeight)) t)
- in
- concat . snd . mapAccumL doTile startPos $ tiles
+-- | Used by the vty frontend to draw vertical separators
+type HasNeighborWest = Bool
+
+layoutToRectangles :: HasNeighborWest -> Rectangle -> Layout a -> [(a, Rectangle, HasNeighborWest)]
+layoutToRectangles nb bounds (SingleWindow a) = [(a, bounds, nb)]
+layoutToRectangles nb bounds (Stack o ts) = handleStack o bounds ts'
+ where ts' = if o == Vertical then setNbs nb ts
+ else case ts of
+ (l, s) : xs -> (l, s, nb) : setNbs True xs
+ [] -> []
+ setNbs val = map (\(l, s) -> (l, s, val))
+layoutToRectangles nb bounds (Pair o p _ a b) = handleStack o bounds [(a,p,nb), (b,1-p,nb')]
+ where nb' = if o == Horizontal then True else nb
+
+handleStack :: Orientation -> Rectangle
+ -> [(Layout a, RelativeSize, HasNeighborWest)]
+ -> [(a, Rectangle, HasNeighborWest)]
+handleStack o bounds tiles = concat . snd . mapAccumL doTile startPos $ tiles
+ where
+ (totalSpace, startPos, mkBounds) = case o of
+ Vertical -> (rectHeight bounds, rectY bounds,
+ \pos size -> bounds { rectY = pos, rectHeight = size })
+ Horizontal -> (rectWidth bounds, rectX bounds,
+ \pos size -> bounds { rectX = pos, rectWidth = size })
+ totalWeight' = sum . fmap (\(_, s, _) -> s) $ tiles
+ totalWeight = if totalWeight' > 0 then totalWeight'
+ else error "Yi.Layout: Stacks must have positive weights"
+ spacePerWeight = totalSpace / totalWeight
+ doTile pos (t, wt, nb) = (pos + wt * spacePerWeight,
+ layoutToRectangles nb (mkBounds pos (wt * spacePerWeight)) t)
----------- Flipping things
-- | Things with orientations which can be flipped
View
80 src/library/Yi/UI/SimpleLayout.hs
@@ -15,13 +15,13 @@ module Yi.UI.SimpleLayout
import Prelude hiding (concatMap, mapM)
-import Control.Lens (use, (.~))
+import Control.Lens (use, (.~), (&), (^.), to, _1)
import Control.Monad.State (evalState, get, put)
import Data.Foldable (find, toList)
import Data.List (partition)
-import qualified Data.List.PointedList.Circular as PL (PointedList)
+import qualified Data.List.PointedList.Circular as PL (PointedList, focus)
import qualified Data.Map.Strict as M (Map, fromList)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T (uncons)
import Data.Traversable (mapM)
@@ -30,10 +30,14 @@ import Yi.Editor
import qualified Yi.Rope as R (take, toString, toText)
import Yi.UI.Utils (arrangeItems)
import Yi.Window
+import Yi.Tab (tabLayout)
+import qualified Yi.Layout as L (Layout)
+import Yi.Layout (Rectangle(..), HasNeighborWest,
+ layoutToRectangles)
data Layout = Layout
{ tabbarRect :: !Rect
- , windowRects :: !(M.Map WindowRef Rect)
+ , windowRects :: !(M.Map WindowRef (Rect, HasNeighborWest))
, promptRect :: !Rect
}
@@ -56,43 +60,41 @@ data Size2D = Size2D
layout :: Int -> Int -> Editor -> (Editor, Layout)
layout colCount rowCount e =
- ( (windowsA .~ newWindows) e
- , Layout (Rect 0 0 colCount 1) winRects cmdRect
+ ( e & windowsA .~ newWs
+ , Layout tabRect winRects cmdRect
)
where
- (miniWs, ws) = partition isMini (toList (windows e))
- (cmd, _) = statusLineInfo e
- niceCmd = arrangeItems cmd colCount (maxStatusHeight e)
- cmdRect = Rect 0 (rowCount - cmdHeight - if null miniWs then 0 else 1) colCount cmdHeight
- cmdHeight = length niceCmd
- tabbarHeight = 1
- (heightQuot, heightRem) =
- quotRem
- (rowCount - tabbarHeight - if null miniWs then max 1 cmdHeight else 1 + cmdHeight)
- (length ws)
- heights = heightQuot + heightRem : repeat heightQuot
- offsets = scanl (+) 0 heights
- bigWindowsWithHeights =
- zipWith (\win h -> layoutWindow win e colCount h)
- ws
- heights
- miniWindowsWithHeights =
- fmap (\win -> layoutWindow win e colCount 1) miniWs
- newWindows =
- merge (miniWindowsWithHeights <> bigWindowsWithHeights) (windows e)
- winRects = M.fromList (bigWindowsWithRects <> miniWindowsWithRects)
- bigWindowsWithRects =
- zipWith (\w offset -> (wkey w, Rect 0 (offset + tabbarHeight) colCount (height w)))
- bigWindowsWithHeights
- offsets
- miniWindowsWithRects =
- map (\w -> (wkey w, Rect 0 (rowCount - 1) colCount 1))
- miniWindowsWithHeights
- merge :: [Window] -> PL.PointedList Window -> PL.PointedList Window
- merge updates =
- let replace (Window { wkey = k }) = fromJust (find ((== k) . wkey) updates)
- in fmap replace
-
+ lt = e ^. tabsA . PL.focus . to tabLayout
+ miniWs = filter isMini . toList $ windows e
+ tabHeight = 1
+ tabRect = Rect 0 0 colCount tabHeight
+ cmdHeight = length $ arrangeItems (fst $ statusLineInfo e) colCount (maxStatusHeight e)
+ miniHeight = if null miniWs then 0 else 1
+ cmdRect = Rect 0 (rowCount - cmdHeight - miniHeight) colCount cmdHeight
+ bounds = rectToRectangle $ Rect 0 tabHeight colCount $
+ rowCount - (max 1 $ cmdHeight + miniHeight) - tabHeight
+ bigRects = layoutToRectangles False bounds lt & map (\(wr, r, nb) ->
+ let r' = rectangleToRect r
+ sx = sizeX r' - if nb then 1 else 0
+ w' = layoutWindow (findWindowWith wr e) e sx (sizeY r')
+ in (w', r', nb))
+ miniRects = miniWs & map (\w ->
+ let r' = Rect 0 (rowCount - 1) colCount 1
+ w' = layoutWindow w e (sizeX r') (sizeY r')
+ in (w', r', False))
+ rects = bigRects <> miniRects
+ winRects = rects & M.fromList . map (\(w, r, nb) -> (wkey w, (r, nb)))
+ updWs = rects & map (^. _1)
+ newWs = windows e & fmap (\w -> fromMaybe w $ find ((== wkey w) . wkey) updWs)
+
+rectToRectangle :: Rect -> Rectangle
+rectToRectangle (Rect x y sx sy) = Rectangle (fromIntegral x) (fromIntegral y)
+ (fromIntegral sx) (fromIntegral sy)
+
+rectangleToRect :: Rectangle -> Rect
+rectangleToRect (Rectangle x y sx sy) = Rect (truncate x) (truncate y)
+ (truncate (x + sx) - truncate x)
+ (truncate (y + sy) - truncate y)
layoutWindow :: Window -> Editor -> Int -> Int -> Window
layoutWindow win e w h = win
View
42 src/library/Yi/UI/Vty.hs
@@ -61,6 +61,7 @@ import Yi.Event (Event)
import Yi.Style
import qualified Yi.UI.Common as Common
import qualified Yi.UI.SimpleLayout as SL
+import Yi.Layout (HasNeighborWest)
import Yi.UI.TabBar (TabDescr (TabDescr), tabBarDescr)
import Yi.UI.Utils (arrangeItems, attributesPictureAndSelB)
import Yi.UI.Vty.Conversions (colorToAttr, fromVtyEvent)
@@ -169,15 +170,15 @@ requestRefresh fs e = do
refresh :: FrontendState -> Editor -> IO ()
refresh fs e = do
(colCount, rowCount) <- Vty.displayBounds (Vty.outputIface (fsVty fs))
- let (_e, SL.Layout _tabbarRect winRects promptRect) = SL.layout colCount rowCount e
+ let (_e, SL.Layout tabbarRect winRects promptRect) = SL.layout colCount rowCount e
ws = windows e
(cmd, cmdSty) = statusLineInfo e
niceCmd = arrangeItems cmd (SL.sizeX promptRect) (maxStatusHeight e)
mkLine = T.justifyLeft colCount ' ' . T.take colCount
formatCmdLine text = withAttributes statusBarStyle (mkLine text)
winImage (win, hasFocus) =
- let rect = winRects M.! wkey win
- in renderWindow (configUI $ fsConfig fs) e rect (win, hasFocus)
+ let (rect, nb) = winRects M.! wkey win
+ in renderWindow (configUI $ fsConfig fs) e rect nb (win, hasFocus)
windowsAndImages =
fmap (\(w, f) -> (w, winImage (w, f))) (PL.withFocus ws)
bigImages =
@@ -190,7 +191,7 @@ refresh fs e = do
((appEndo <$> cmdSty) <*> baseAttributes)
(configStyle (configUI (fsConfig fs)))
tabBarImage =
- renderTabBar (configStyle (configUI (fsConfig fs)))
+ renderTabBar tabbarRect (configStyle (configUI (fsConfig fs)))
(map (\(TabDescr t f) -> (t, f)) (toList (tabBarDescr e)))
cmdImage = if null cmd
then Vty.emptyImage
@@ -210,11 +211,13 @@ refresh fs e = do
(Vty.picForLayers ([tabBarImage, cmdImage] ++ bigImages ++ miniImages))
{ Vty.picCursor = cursorPos }
-renderWindow :: UIConfig -> Editor -> SL.Rect -> (Window, Bool) -> Rendered
-renderWindow cfg e (SL.Rect x y w h) (win, focused) =
- Rendered (Vty.translate x y pict)
- (fmap (\(i, j) -> (i + y, j + x)) cur)
+renderWindow :: UIConfig -> Editor -> SL.Rect -> HasNeighborWest -> (Window, Bool) -> Rendered
+renderWindow cfg e (SL.Rect x y w h) nb (win, focused) =
+ Rendered (Vty.translate x y $ if nb then vertSep Vty.<|> pict else pict)
+ (fmap (\(i, j) -> (i + y, j + x')) cur)
where
+ x' = x + if nb then 1 else 0
+ w' = w - if nb then 1 else 0
b = findBufferWith (bufkey win) e
sty = configStyle cfg
@@ -226,7 +229,7 @@ renderWindow cfg e (SL.Rect x y w h) (win, focused) =
wsty = attributesToAttr ground Vty.defAttr
eofsty = appEndo (eofStyle sty) ground
(point, _) = runBuffer win b pointB
- region = mkSizeRegion fromMarkPoint (Size (w*h'))
+ region = mkSizeRegion fromMarkPoint $ Size (w' * h')
-- Work around a problem with the mini window never displaying it's contents due to a
-- fromMark that is always equal to the end of the buffer contents.
(Just (MarkSet fromM _ _), _) = runBuffer win b (getMarks win)
@@ -247,28 +250,31 @@ renderWindow cfg e (SL.Rect x y w h) (win, focused) =
cur = (fmap (\(SL.Point2D curx cury) -> (cury, T.length prompt + curx)) . fst)
(runBuffer win b
(SL.coordsOfCharacterB
- (SL.Size2D w h)
+ (SL.Size2D w' h)
fromMarkPoint
point))
rendered =
- drawText wsty h' w
+ drawText wsty h' w'
tabWidth
([(c, wsty) | c <- T.unpack prompt] ++ bufData ++ [(' ', wsty)])
-- we always add one character which can be used to position the cursor at the end of file
commonPref = T.pack <$> commonNamePrefix e
(modeLine0, _) = runBuffer win b $ getModeLine commonPref
modeLine = if notMini then Just modeLine0 else Nothing
- prepare = withAttributes modeStyle . T.justifyLeft w ' ' . T.take w
+ prepare = withAttributes modeStyle . T.justifyLeft w' ' ' . T.take w'
modeLines = map prepare $ maybeToList modeLine
modeStyle = (if focused then appEndo (modelineFocusStyle sty) else id) (modelineAttributes sty)
filler :: T.Text
- filler = if w == 0 -- justify would return a single char at w = 0
+ filler = if w' == 0 -- justify would return a single char at w = 0
then T.empty
- else T.justifyLeft w ' ' $ T.singleton (configWindowFill cfg)
+ else T.justifyLeft w' ' ' $ T.singleton (configWindowFill cfg)
- pict = Vty.vertCat (take h' (rendered <> repeat (withAttributes eofsty filler)) <> modeLines)
+ pict = Vty.vertCat $ take h' (rendered <> repeat (withAttributes eofsty filler)) <> modeLines
+
+ sepStyle = attributesToAttr (modelineAttributes sty) Vty.defAttr
+ vertSep = Vty.charFill sepStyle ' ' 1 h
withAttributes :: Attributes -> T.Text -> Vty.Image
withAttributes sty = Vty.text' (attributesToAttr sty Vty.defAttr)
@@ -350,8 +356,8 @@ drawText wsty h w tabWidth bufData
| otherwise = [(c, p)]
where numeric = ord c
-renderTabBar :: UIStyle -> [(T.Text, Bool)] -> Vty.Image
-renderTabBar uiStyle = Vty.horizCat . fmap render
+renderTabBar :: SL.Rect -> UIStyle -> [(T.Text, Bool)] -> Vty.Image
+renderTabBar r uiStyle ts = (Vty.<|> padding) . Vty.horizCat $ fmap render ts
where
render (text, inFocus) = Vty.text' (tabAttr inFocus) (tabTitle text)
tabTitle text = ' ' `T.cons` text `T.snoc` ' '
@@ -361,3 +367,5 @@ renderTabBar uiStyle = Vty.horizCat . fmap render
baseAttr False sty =
attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.defAttr
`Vty.withStyle` Vty.underline
+ padding = Vty.charFill (tabAttr False) ' ' (SL.sizeX r - width) 1
+ width = sum . map ((+2) . T.length . fst) $ ts

0 comments on commit 038d7eb

Please sign in to comment.
Something went wrong with that request. Please try again.