module Rasa.Ext.Slate.Internal.Render
( renderAll
, Renderable(..)
) where
import Rasa.Ext
import Rasa.Ext.Views
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
getSize :: App (Width, Height)
getSize = do
v <- getVty
liftIO $ V.displayBounds $ V.outputIface v
renderAll :: App ()
renderAll = do
(width, height) <- getSize
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
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 :: BiTree Split View -> Width -> Height -> App V.Image
renderWindow = cata alg
where
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
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 = max 0 $ fromIntegral (height 1)
(topHeight, bottomHeight) = splitByRule spRule availHeight
in do
topView <- top width topHeight
bottomView <- bottom width bottomHeight
return $ topView V.<-> horBorder width V.<-> bottomView
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
widgetsToImages :: Width -> Height -> ScrollPos -> Widgets -> App (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
renderView :: Width -> Height -> View -> App 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
scrollAmt = vw^.scrollPos
renderToImage :: Renderable r => Width -> Height -> ScrollPos -> r -> App V.Image
renderToImage w h scroll r = maybe V.emptyImage applyAttrs <$> render w h scroll r