TitledContainer.hs

module UI.Widgets.TitledContainer where

import UI.Widgets.Common
import Common

data TitledContainer = TitledContainer
  { ttcwTitle    :: Text
  , ttcwContent    :: SomeWidgetRef
  , ttcwDim        :: Dimensions
  , ttcwPos        :: ScreenPos
  , ttcwVisibility :: Bool
  }

setTitle :: TitledContainer -> Text -> TitledContainer
setTitle tc t = tc { ttcwTitle = t }

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

instance Moveable TitledContainer where
  getPos ref = ttcwPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\tcw -> tcw { ttcwPos = pos })
  getDim ref = ttcwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\tcw -> tcw { ttcwDim = cb $ ttcwDim tcw })

instance Drawable TitledContainer where
  setVisibility ref v = modifyWRef ref (\b -> b { ttcwVisibility = v })
  getVisibility ref = ttcwVisibility <$> readWRef ref
  draw ref = do
     w <- readWRef ref
     drawTitleLine (ttcwPos w) (diW $ ttcwDim w) 3 (Just $ ttcwTitle w)
     case (ttcwContent w) of
      SomeWidgetRef cw -> do
        withCapability (MoveableCap cw) $ do
          move cw (moveDown 1 (ttcwPos w))
          resize cw (\_ -> amendHeight (\x -> x - 1) (ttcwDim w))
          withCapability (DrawableCap cw) $
            draw cw

titledContainer
  :: ScreenPos
  -> Dimensions
  -> SomeWidgetRef
  -> Text
  -> WidgetM m (WRef TitledContainer)
titledContainer sp dim cont title = newWRef $ TitledContainer title cont dim sp True