rasa-ext-slate 0.1.6 → 0.1.7
raw patch · 6 files changed
+101/−85 lines, 6 filesdep −rasa-ext-status-bardep −rasa-ext-styledep ~rasadep ~rasa-ext-views
Dependencies removed: rasa-ext-status-bar, rasa-ext-style
Dependency ranges changed: rasa, rasa-ext-views
Files
- rasa-ext-slate.cabal +3/−5
- src/Rasa/Ext/Slate.hs +4/−4
- src/Rasa/Ext/Slate/Internal/Attributes.hs +6/−6
- src/Rasa/Ext/Slate/Internal/Event.hs +17/−11
- src/Rasa/Ext/Slate/Internal/Render.hs +69/−56
- src/Rasa/Ext/Slate/Internal/State.hs +2/−3
rasa-ext-slate.cabal view
@@ -1,5 +1,5 @@ name: rasa-ext-slate-version: 0.1.6+version: 0.1.7 cabal-version: >=1.10 build-type: Simple license: GPL-3@@ -26,10 +26,8 @@ Rasa.Ext.Slate.Internal.Attributes build-depends: base >=4.8 && <5,- rasa >=0.1.9 && <0.2,- rasa-ext-style >=0.1.4 && <0.2,- rasa-ext-status-bar >=0.1.3 && <0.2,- rasa-ext-views >=0.1.3 && <0.2,+ rasa >=0.1.10 && <0.2,+ rasa-ext-views >=0.1.4 && <0.2, recursion-schemes >=5.0.1 && <5.1, text >=1.2.2.1 && <1.3, mtl >=2.2.1 && <2.3,
src/Rasa/Ext/Slate.hs view
@@ -1,9 +1,9 @@ module Rasa.Ext.Slate (slate) where import Rasa.Ext-import Rasa.Ext.Slate.Internal.Render (render)-import Rasa.Ext.Slate.Internal.Event (terminalEvents)-import Rasa.Ext.Slate.Internal.State (getVty)+import Rasa.Ext.Slate.Internal.Render+import Rasa.Ext.Slate.Internal.Event+import Rasa.Ext.Slate.Internal.State import qualified Graphics.Vty as V import Control.Monad.IO.Class@@ -18,7 +18,7 @@ slate :: Action () slate = do onInit terminalEvents- onEveryRender_ render+ onEveryRender_ renderAll onExit shutdown -- | Call vty shutdown procedure (if this doesn't happen the terminal ends up in strange states)
src/Rasa/Ext/Slate/Internal/Attributes.hs view
@@ -2,7 +2,6 @@ module Rasa.Ext.Slate.Internal.Attributes where import Rasa.Ext-import Rasa.Ext.Style import qualified Yi.Rope as Y import qualified Graphics.Vty as V import Data.Bifunctor@@ -51,17 +50,18 @@ AttrMonoid v `mappend` AttrMonoid v' = AttrMonoid $ v `mappend` v' -- | Apply a list of styles to the given text, resulting in a 'V.Image'.-applyAttrs :: [Span CrdRange V.Attr] -> Y.YiString -> V.Image-applyAttrs atts txt = textAndStylesToImage mergedSpans (padSpaces <$> Y.lines txt)+applyAttrs :: RenderInfo -> V.Image+applyAttrs (RenderInfo txt styles) = textAndStylesToImage mergedSpans (padSpaces <$> Y.lines txt) where mergedSpans = second getAttr <$> combineSpans (fmap AttrMonoid <$> atts) -- Newlines aren't rendered; so we replace them with spaces so they're selectable padSpaces = (`Y.append` " ")+ atts = second convertStyle <$> styles +-- | Makes and image from text and styles textAndStylesToImage :: [(Coord, V.Attr)] -> [Y.YiString] -> V.Image-textAndStylesToImage atts lines' = vertCat $ (reset V.<|>) . uncurry attrLine <$> pairLines atts lines'+textAndStylesToImage atts lines' = V.vertCat $ wrapResets . uncurry attrLine <$> pairLines atts lines' where- vertCat = foldr ((V.<->) . (V.<|> reset)) V.emptyImage-+ wrapResets img = reset V.<|> img V.<|> reset -- | Applies the list of attrs to the line and returns a 'V.Image'. It assumes that the list -- contains only 'Coord's on the same line (i.e. row == 0)
src/Rasa/Ext/Slate/Internal/Event.hs view
@@ -11,9 +11,9 @@ terminalEvents :: Action () terminalEvents = do v <- getVty- asyncEventProvider $ getEvents v+ asyncActionProvider $ getEvents v where- getEvents v dispatch = forever $ V.nextEvent v >>= dispatch . convertEvent+ getEvents v dispatch = forever $ V.nextEvent v >>= dispatch . dispatchKeypress . convertEvent -- | Converts a 'V.Event' into a keypress if possible. convertEvent :: V.Event -> Keypress@@ -22,14 +22,20 @@ -- | Converts a 'V.Event' into a keypress if possible. convertKeypress :: V.Key -> [V.Modifier] -> Keypress-convertKeypress V.KEnter _ = KEnter-convertKeypress V.KBS _ = KBS-convertKeypress V.KEsc _ = KEsc-convertKeypress V.KLeft _ = KLeft-convertKeypress V.KRight _ = KRight-convertKeypress V.KUp _ = KUp-convertKeypress V.KDown _ = KDown-convertKeypress (V.KChar c) mods = Keypress c (fmap convertMod mods)+convertKeypress V.KEsc mods = KEsc (fmap convertMod mods)+convertKeypress (V.KChar c) mods = Keypress c (fmap convertMod mods)+convertKeypress V.KBS mods = KBS (fmap convertMod mods)+convertKeypress V.KEnter mods = KEnter (fmap convertMod mods)+convertKeypress V.KLeft mods = KLeft (fmap convertMod mods)+convertKeypress V.KRight mods = KRight (fmap convertMod mods)+convertKeypress V.KUp mods = KUp (fmap convertMod mods)+convertKeypress V.KDown mods = KDown (fmap convertMod mods)+convertKeypress V.KPrtScr mods = KPrtScr (fmap convertMod mods)+convertKeypress V.KHome mods = KHome (fmap convertMod mods)+convertKeypress V.KPageUp mods = KPageUp (fmap convertMod mods)+convertKeypress V.KDel mods = KDel (fmap convertMod mods)+convertKeypress V.KEnd mods = KEnd (fmap convertMod mods)+convertKeypress V.KPageDown mods = KPageDown (fmap convertMod mods) convertKeypress _ _ = KUnknown -- | Converts a 'V.Modifier' into a 'Mod'.@@ -37,5 +43,5 @@ convertMod m = case m of V.MShift -> Shift V.MCtrl -> Ctrl- V.MMeta -> Alt+ V.MMeta -> Meta V.MAlt -> Alt
src/Rasa/Ext/Slate/Internal/Render.hs view
@@ -1,24 +1,24 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}-module Rasa.Ext.Slate.Internal.Render (render) where+{-# language+ FlexibleInstances+ , MultiParamTypeClasses+ , OverloadedStrings+ , ExistentialQuantification+#-}+module Rasa.Ext.Slate.Internal.Render+ ( renderAll+ , Renderable(..)+ ) where import Rasa.Ext import Rasa.Ext.Views-import Rasa.Ext.Style--- import Rasa.Ext.StatusBar (left, center, right) import Rasa.Ext.Slate.Internal.State import Rasa.Ext.Slate.Internal.Attributes import Data.Functor.Foldable-import Data.Bifunctor import qualified Graphics.Vty as V import Control.Lens import Control.Monad.IO.Class -import qualified Yi.Rope as Y--type Width = Int-type Height = Int- -- | Get the current terminal size. getSize :: Action (Width, Height) getSize = do@@ -26,17 +26,17 @@ liftIO $ V.displayBounds $ V.outputIface v -- | Render the Editor-render :: Action ()-render = do+renderAll :: Action ()+renderAll = do (width, height) <- getSize- mBufViews <- getBufferViews- liftIO $ appendFile "bufs.log" (show mBufViews)- case mBufViews of- Nothing -> return ()- Just win ->- let img = renderWindow (width, height) win- pic = V.picForImage img- in getVty >>= liftIO . flip V.update pic+ mViews <- getViews+ maybe (return ()) (vtyUpdate width height) mViews+ where+ vtyUpdate width height win = do+ img <- renderWindow win width height+ let pic = V.picForImage img+ v <- getVty+ liftIO $ V.update v pic -- | Divides up available space according to the given 'SplitRule'. splitByRule :: SplitRule -> Int -> (Int, Int)@@ -56,48 +56,61 @@ end = min sz amt -- | Recursively render components of a Window to a 'V.Image' combining the results in the proper locations.-renderWindow :: (Width, Height) -> BiTree Split (View, Buffer) -> V.Image-renderWindow sz win = cata alg win sz+renderWindow :: BiTree Split View -> Width -> Height -> Action V.Image+renderWindow = cata alg where- alg (BranchF (Split Vert spRule) left right) = \(width, height) ->- let availWidth = fromIntegral (width - 1)+ mkBorder = V.charFill (V.defAttr `V.withForeColor` V.green)+ vertBorder = mkBorder '|' 1+ horBorder w = mkBorder '-' w 1++ alg (BranchF (Split Vert spRule) left right) = \width height ->+ let availWidth = max 0 $ fromIntegral (width - 1) (leftWidth, rightWidth) = splitByRule spRule availWidth- border = V.charFill (V.defAttr `V.withForeColor` V.green) '|' 1 height- in left (leftWidth, height) V.<|> border V.<|> right (rightWidth, height)+ in do+ leftView <- left leftWidth height+ rightView <- right rightWidth height+ return $ leftView V.<|> vertBorder height V.<|> rightView - alg (BranchF (Split Hor spRule) top bottom) = \(width, height) ->- let availHeight = fromIntegral (height - 1)+ alg (BranchF (Split Hor spRule) top bottom) = \width height ->+ let availHeight = max 0 $ fromIntegral (height - 1) (topHeight, bottomHeight) = splitByRule spRule availHeight- border = V.charFill (V.defAttr `V.withForeColor` V.green) '-' width 1- in top (width, topHeight) V.<-> border V.<-> bottom (width, bottomHeight)+ in do+ topView <- top width topHeight+ bottomView <- bottom width bottomHeight+ return $ topView V.<-> horBorder width V.<-> bottomView - alg (LeafF bufInfo) = \(width, height) -> renderView (width, height) bufInfo+ alg (LeafF vw) = \width height -> renderView width height vw ++type Top = V.Image+type Bottom = V.Image+type Left = V.Image+type Right = V.Image++-- | Renders widgets to images+widgetsToImages :: Width -> Height -> ScrollPos -> Widgets -> Action (Top, Bottom, Left, Right)+widgetsToImages width height scrollAmt widgets = do+ top <- renderHorBar width (widgets^.topBar)+ bottom <- renderHorBar width (widgets^.bottomBar)+ let remainingHeight = max 0 $ height - (V.imageHeight top+ V.imageHeight bottom)+ left <- renderVertBar remainingHeight (widgets^.leftBar)+ right <- renderVertBar remainingHeight (widgets^.rightBar)+ return (top, bottom, left, right)+ where+ renderHorBar w rs = V.resizeWidth w . V.vertCat <$> traverse (renderToImage w 1 0) rs+ renderVertBar h rs = V.resizeHeight h . V.horizCat <$> traverse (renderToImage 1 h scrollAmt) rs+ -- | Render a given 'View' to a 'V.Image' given the context of the associated buffer and a size to render it in.-renderView :: (Width, Height) -> (View, Buffer) -> V.Image-renderView (width, height) (vw, buf) = appendActiveBar . resize . addEndBar $ textImage+renderView :: Width -> Height -> View -> Action V.Image+renderView width height vw = do+ widgets <- computeWidgets vw+ (top, bottom, left, right) <- widgetsToImages width height scrollAmt widgets+ let remainingHeight = max 0 $ height - (V.imageHeight top + V.imageHeight bottom)+ remainingWidth = max 0 $ width - (V.imageWidth left + V.imageWidth right)+ img <- V.resize remainingWidth remainingHeight <$> renderToImage remainingWidth remainingHeight scrollAmt (vw^.viewable)+ return $ top V.<-> (left V.<|> img V.<|> right) V.<-> bottom where- trimText :: Y.YiString -> Y.YiString- trimText = Y.concat . take height . drop (vw^.scrollPos) . Y.lines'- resize :: V.Image -> V.Image- resize = V.resize availWidth height- textImage :: V.Image- textImage = applyAttrs adjustedStyles txt- txt :: Y.YiString- txt = buf^.text & trimText- adjustedStyles :: [Span CrdRange V.Attr]- adjustedStyles = bimap adjustStylePositions convertStyle <$> buf^.styles- adjustStylePositions :: CrdRange -> CrdRange- adjustStylePositions = both.coordRow -~ vw^.scrollPos- sepBar :: V.Image- sepBar = V.charFill (V.defAttr `V.withStyle` V.underline) ' ' width 1- addEndBar :: V.Image -> V.Image- addEndBar = (V.<-> sepBar)- appendActiveBar :: V.Image -> V.Image- appendActiveBar i- | vw^.active = i V.<|> V.charFill (V.defAttr `V.withForeColor` V.magenta) '|' 1 height- | otherwise = i- availWidth :: Height- availWidth = if vw^.active then width - 1- else width+ scrollAmt = vw^.scrollPos +renderToImage :: Renderable r => Width -> Height -> ScrollPos -> r -> Action V.Image+renderToImage w h scroll r = maybe V.emptyImage applyAttrs <$> render w h scroll r
src/Rasa/Ext/Slate/Internal/State.hs view
@@ -1,7 +1,6 @@ module Rasa.Ext.Slate.Internal.State (getVty) where import Rasa.Ext-import Control.Lens import Control.Monad.IO.Class import qualified Graphics.Vty as V@@ -16,13 +15,13 @@ initUi = do cfg <- liftIO V.standardIOConfig v <- liftIO $ V.mkVty cfg- ext .= Just (Slate v)+ setExt $ Just (Slate v) return v -- | Gets vty by checking if it has been initialized yet, if not it runs the initialization. getVty :: Action V.Vty getVty = do- v <- use ext+ v <- getExt case v of Just (Slate v') -> return v' Nothing -> initUi