rasa-ext-slate 0.1.2 → 0.1.3
raw patch · 5 files changed
+82/−53 lines, 5 filesdep +mtldep +rasa-ext-viewsdep +recursion-schemesdep −rasa-ext-bufsdep ~rasadep ~rasa-ext-style
Dependencies added: mtl, rasa-ext-views, recursion-schemes
Dependencies removed: rasa-ext-bufs
Dependency ranges changed: rasa, rasa-ext-style
Files
- rasa-ext-slate.cabal +10/−9
- src/Rasa/Ext/Slate.hs +5/−4
- src/Rasa/Ext/Slate/Internal/Attributes.hs +1/−1
- src/Rasa/Ext/Slate/Internal/Event.hs +9/−5
- src/Rasa/Ext/Slate/Internal/Render.hs +57/−34
rasa-ext-slate.cabal view
@@ -1,5 +1,5 @@ name: rasa-ext-slate-version: 0.1.2+version: 0.1.3 cabal-version: >=1.10 build-type: Simple license: MIT@@ -20,23 +20,24 @@ library exposed-modules: Rasa.Ext.Slate+ Rasa.Ext.Slate.Internal.Render+ Rasa.Ext.Slate.Internal.Event+ Rasa.Ext.Slate.Internal.State+ Rasa.Ext.Slate.Internal.Attributes build-depends: base >=4.8 && <5,- rasa >=0.1.4 && <0.2,- rasa-ext-bufs >=0.1.1 && <0.2,- rasa-ext-style >=0.1.1 && <0.2,+ rasa >=0.1.6 && <0.2,+ rasa-ext-style >=0.1.2 && <0.2, rasa-ext-status-bar >=0.1.1 && <0.2,+ rasa-ext-views >=0.1.1 && <0.2,+ recursion-schemes >=5.0.1 && <5.1, text >=1.2.2.1 && <1.3,+ mtl >=2.2.1 && <2.3, yi-rope >=0.7.0.2 && <0.8, lens ==4.14.*, vty ==5.14.*, rasa-ext-logger >=0.1.1 && <0.2 default-language: Haskell2010 hs-source-dirs: src- other-modules:- Rasa.Ext.Slate.Internal.Render- Rasa.Ext.Slate.Internal.Event- Rasa.Ext.Slate.Internal.State- Rasa.Ext.Slate.Internal.Attributes ghc-options: -Wall
src/Rasa/Ext/Slate.hs view
@@ -6,6 +6,7 @@ import Rasa.Ext.Slate.Internal.State (getVty) import qualified Graphics.Vty as V+import Control.Monad import Control.Monad.IO.Class -- | The main export for this extension. Add this to your user config.@@ -15,11 +16,11 @@ -- > rasa $ do -- > slate -- > ...-slate :: Scheduler ()+slate :: Action () slate = do- onInit terminalEvents- onRender render- onExit shutdown+ void $ onInit terminalEvents+ void $ onRender render+ void $ onExit shutdown -- | Call vty shutdown procedure (if this doesn't happen the terminal ends up in strange states) shutdown :: Action ()
src/Rasa/Ext/Slate/Internal/Attributes.hs view
@@ -57,7 +57,7 @@ converted = combined & traverse._2 %~ attr' applyAttrs' :: [(Coord, V.Attr)] -> [Y.YiString] -> V.Image-applyAttrs' atts lines' = vertCat $ uncurry attrLine <$> pairLines atts lines'+applyAttrs' atts lines' = vertCat $ (reset V.<|>) . uncurry attrLine <$> pairLines atts lines' where vertCat = foldr ((V.<->) . (V.<|> reset)) V.emptyImage
src/Rasa/Ext/Slate/Internal/Event.hs view
@@ -15,15 +15,19 @@ -- | Converts a 'V.Event' into a keypress if possible. convertEvent :: V.Event -> Keypress convertEvent (V.EvKey e mods) = convertKeypress e mods-convertEvent _ = Unknown+convertEvent _ = KUnknown -- | Converts a 'V.Event' into a keypress if possible. convertKeypress :: V.Key -> [V.Modifier] -> Keypress-convertKeypress V.KEnter _ = Enter-convertKeypress V.KBS _ = BS-convertKeypress V.KEsc _ = Esc+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 _ _ = Unknown+convertKeypress _ _ = KUnknown -- | Converts a 'V.Modifier' into a 'Mod'. convertMod :: V.Modifier -> Mod
src/Rasa/Ext/Slate/Internal/Render.hs view
@@ -2,32 +2,22 @@ module Rasa.Ext.Slate.Internal.Render (render) where import Rasa.Ext-import Rasa.Ext.Bufs+import Rasa.Ext.Views import Rasa.Ext.Style-import Rasa.Ext.StatusBar (left, center, right)+-- import Rasa.Ext.StatusBar (left, center, right) import Rasa.Ext.Slate.Internal.State import Rasa.Ext.Slate.Internal.Attributes-+import Data.Functor.Foldable import qualified Graphics.Vty as V import Control.Lens import Control.Monad.IO.Class -import Data.Monoid-import Data.Foldable--import qualified Yi.Rope as Y---- | Given a window size, creates a 'BufAction' which will return an image representing the buffer it's run in.-renderBuf :: (Int, Int) -> BufAction V.Image-renderBuf (width, height) = do- txt <- use text- atts <- fmap (fmap convertStyle) <$> use styles- let img = applyAttrs atts txt- return $ V.resize width height img+type Width = Int+type Height = Int -- | Get the current terminal size.-getSize :: Action (Int, Int)+getSize :: Action (Width, Height) getSize = do v <- getVty liftIO $ V.displayBounds $ V.outputIface v@@ -36,24 +26,57 @@ render :: Action () render = do (width, height) <- getSize- mBufImg <- focusDo $ renderBuf (width, height - 1)- case mBufImg of+ mBufViews <- getBufferViews+ liftIO $ appendFile "bufs.log" (show mBufViews)+ case mBufViews of Nothing -> return ()- Just bufImg -> do- statusBar <- renderStatus width- let img = bufImg V.<-> statusBar+ Just win -> + let img = renderWindow (width, height) win pic = V.picForImage img- v <- getVty- liftIO $ V.update v pic+ in getVty >>= liftIO . flip V.update pic --- | Render the status bar.-renderStatus :: Int -> Action V.Image-renderStatus width = fmap fold . focusDo $ do- statuses <- use bufExt- let spacer = Y.replicate spacerSize " "- spacerSize = (width - Y.length (Y.concat joinedParts)) `div` 2- barParts = [ statuses^.left, statuses^.center, statuses^.right ]- addSpacer = (<> spacer)- joinedParts = Y.intercalate " | " <$> barParts- fullLine = foldMap addSpacer joinedParts- return $ V.text' V.defAttr (Y.toText fullLine)+splitByRule :: SplitRule -> Int -> (Int, Int)+splitByRule (Ratio p) sz = (start, end)+ where+ start = ceiling $ fromIntegral sz * p+ end = floor $ fromIntegral sz * (1 - p)++splitByRule (FromStart amt) sz = (start, end)+ where+ start = min sz amt+ end = sz - start++splitByRule (FromEnd amt) sz = (start, end)+ where+ start = sz - end+ end = min sz amt++renderWindow :: (Width, Height) -> BiTree Split (View, Buffer) -> V.Image+renderWindow sz win = cata alg win sz+ where+ alg (BranchF (Split Vert spRule) left right) = \(width, height) ->+ let availWidth = 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)++ alg (BranchF (Split Hor spRule) top bottom) = \(width, height) ->+ let availHeight = 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)++ alg (LeafF bufInfo) = \(width, height) -> renderView (width, height) bufInfo++renderView :: (Width, Height) -> (View, Buffer) -> V.Image+renderView (width, height) (vw, buf) = appendActiveBar $ V.resize width availHeight $ applyAttrs atts txt+ where+ appendActiveBar img =+ if isActive+ then img V.<-> V.charFill (V.defAttr `V.withForeColor` V.magenta) '-' width 1+ else img+ availHeight = if isActive then height - 1+ else height+ txt = buf^.text+ atts = buf^.styles & fmap (fmap convertStyle)+ isActive = vw ^. active