content: {-# language
     FlexibleInstances
    , MultiParamTypeClasses
    , OverloadedStrings
    , ExistentialQuantification
  #-}
  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
  
  -- | Get the current terminal size.
  getSize :: App (Width, Height)
  getSize = do
    v <- getVty
    liftIO $ V.displayBounds $ V.outputIface v
  
  -- | Render the Editor
  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
  
  -- | Divides up available space according to the given 'SplitRule'.
  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
  
  -- | Recursively render components of a Window to a 'V.Image' combining the results in the proper locations.
  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
  
  -- | Renders widgets to images
  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
  
  -- | 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 -> 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
  