content: {-# LANGUAGE ExistentialQuantification, FlexibleInstances, TypeSynonymInstances #-}
  -- |This module provides a ''padding'' mechanism for adding padding to
  -- a widget on one or more sides.
  module Graphics.Vty.Widgets.Padding
      ( Padded
      , Padding
      , Paddable(..)
      , (+++)
      , padded
      , withPadding
      , padNone
      , padLeft
      , padRight
      , padTop
      , padBottom
      , padLeftRight
      , padTopBottom
      , padAll
      )
  where
  
  import Data.Monoid
  import Graphics.Vty hiding (regionWidth, regionHeight)
  import Graphics.Vty.Widgets.Core
  import Graphics.Vty.Widgets.Util
  
  -- |The type of padding on widgets.
  data Padding = Padding Int Int Int Int
                 deriving (Show)
  
  data Padded = forall a. (Show a) => Padded (Widget a) Padding
  
  instance Show Padded where
      show (Padded _ p) = concat [ "Padded { "
                                 , "padding = "
                                 , show p
                                 , ", ... }"
                                 ]
  
  instance Semigroup Padding where
      (<>) (Padding a1 a2 a3 a4) (Padding b1 b2 b3 b4) =
          Padding (a1 + b1) (a2 + b2) (a3 + b3) (a4 + b4)
  
  instance Monoid Padding where
      mempty = Padding 0 0 0 0
      mappend = (<>)
  
  (+++) :: (Monoid a) => a -> a -> a
  (+++) = mappend
  
  -- |The class of types to which we can add padding.
  class Paddable a where
      pad :: a -> Padding -> a
  
  instance Paddable Padding where
      pad p1 p2 = p1 +++ p2
  
  leftPadding :: Padding -> Int
  leftPadding (Padding _ _ _ l) = toEnum l
  
  rightPadding :: Padding -> Int
  rightPadding (Padding _ r _ _) = toEnum r
  
  bottomPadding :: Padding -> Int
  bottomPadding (Padding _ _ b _) = toEnum b
  
  topPadding :: Padding -> Int
  topPadding (Padding t _ _ _) = toEnum t
  
  -- |Padding constructor with no padding.
  padNone :: Padding
  padNone = Padding 0 0 0 0
  
  -- |Padding constructor with left padding in columns.
  padLeft :: Int -> Padding
  padLeft v = Padding 0 0 0 v
  
  -- |Padding constructor with right padding in columns.
  padRight :: Int -> Padding
  padRight v = Padding 0 v 0 0
  
  -- |Padding constructor with top padding in rows.
  padTop :: Int -> Padding
  padTop v = Padding v 0 0 0
  
  -- |Padding constructor with bottom padding in rows.
  padBottom :: Int -> Padding
  padBottom v = Padding 0 0 v 0
  
  -- |Padding constructor with padding on all sides in rows and
  -- columns.
  padAll :: Int -> Padding
  padAll v = Padding v v v v
  
  -- |Padding constructor with padding on top and bottom in rows.
  padTopBottom :: Int -> Padding
  padTopBottom v = Padding v 0 v 0
  
  -- |Padding constructor with padding on left and right in columns.
  padLeftRight :: Int -> Padding
  padLeftRight v = Padding 0 v 0 v
  
  -- |Monadic combinator to construct a 'Padded' wrapper.
  withPadding :: (Show a) => Padding -> Widget a -> IO (Widget Padded)
  withPadding = flip padded
  
  -- |Create a 'Padded' wrapper to add padding.
  padded :: (Show a) => Widget a -> Padding -> IO (Widget Padded)
  padded ch padding = do
    let initSt = Padded ch padding
    wRef <- newWidget initSt $ \w ->
        w { growVertical_ = const $ growVertical ch
          , growHorizontal_ = const $ growHorizontal ch
  
          , render_ =
              \this sz ctx -> do
                  Padded child p <- getState this
  
                  if (regionWidth sz < leftPadding p + rightPadding p) ||
                     (regionHeight sz < bottomPadding p + topPadding p) then
                    return emptyImage else
                   do
                    f <- focused <~ this
  
                    -- Compute constrained space based on padding
                    -- settings.
                    let constrained = sz `withWidth` (toEnum $ max 0 newWidth)
                                      `withHeight` (toEnum $ max 0 newHeight)
                        newWidth = (fromEnum $ regionWidth sz) - fromEnum (leftPadding p + rightPadding p)
                        newHeight = (fromEnum $ regionHeight sz) - fromEnum (topPadding p + bottomPadding p)
                        attr = mergeAttrs [ if f then focusAttr ctx else overrideAttr ctx
                                          , normalAttr ctx
                                          ]
  
                    -- Render child.
                    img <- render child constrained ctx
  
                    -- Create padding images.
                    let leftImg = charFill attr ' ' (leftPadding p) (imageHeight img)
                        rightImg = charFill attr ' ' (rightPadding p) (imageHeight img)
                        topImg = charFill attr ' ' (imageWidth img + leftPadding p + rightPadding p)
                                 (topPadding p)
                        bottomImg = charFill attr ' ' (imageWidth img + leftPadding p + rightPadding p)
                                    (bottomPadding p)
  
                    return $ topImg <-> (leftImg <|> img <|> rightImg) <-> bottomImg
  
          , setCurrentPosition_ =
              \this pos -> do
                Padded child p <- getState this
  
                -- Considering left and top padding, adjust position and
                -- set on child.
                let newPos = pos
                             `plusWidth` (leftPadding p)
                             `plusHeight` (topPadding p)
  
                setCurrentPosition child newPos
  
          , getCursorPosition_ = \this -> do
                Padded child _ <- getState this
                getCursorPosition child
          }
  
    wRef `relayKeyEvents` ch
    wRef `relayFocusEvents` ch
    return wRef
  