BorderBox.hs

module UI.Widgets.BorderBox where

import UI.Widgets.Common as C
import Common

data BorderBoxWidget = BorderBoxWidget
  { bbwDim     :: Dimensions
  , bbwContent :: SomeWidgetRef
  , bbwPos     :: ScreenPos
  , bbwVisible :: Bool
  }

instance Container BorderBoxWidget SomeWidgetRef where
  setContent ref c =
    modifyWRef ref (\bbw -> bbw { bbwContent = c })
  getContent ref = bbwContent <$> readWRef ref

instance Moveable BorderBoxWidget where
  getPos ref = bbwPos <$> readWRef ref
  move ref sp =
    modifyWRef ref (\bbw -> bbw { bbwPos = sp })
  getDim ref =
    bbwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\low -> low { bbwDim = cb $ bbwDim low })

instance Widget BorderBoxWidget where
  hasCapability (DrawableCap _)  = Just Dict
  hasCapability _            = Nothing

instance Drawable BorderBoxWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { bbwVisible = v })
  getVisibility ref = bbwVisible <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    drawBorderBox (bbwPos w) (bbwDim w)
    case bbwContent w of
      SomeWidgetRef a -> do
        withCapability (DrawableCap a) $ do
          withCapability (MoveableCap a) $ do
            move a (moveDown 1 $ moveRight 1 $ bbwPos w)
            draw a

borderBox
  :: forall m. ScreenPos
  -> Dimensions
  -> SomeWidgetRef
  -> WidgetM m (WRef BorderBoxWidget)
borderBox pos dim child = do
  newWRef $
    BorderBoxWidget
    { bbwDim = dim
    , bbwContent = child
    , bbwPos = pos
    , bbwVisible = True
    }