TitledContainer.hs

module UI.Widgets.TitledContainer where

import Common
import UI.Widgets.Common

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

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

setVertical :: TitledContainer -> TitledContainer
setVertical tc = tc { ttcwVertical = True }

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
     case (ttcwVertical w) of
       True -> drawTitleLineVertical (ttcwPos w) (diH $ ttcwDim w) 3 (Just $ ttcwTitle w)
       _ -> drawTitleLine (ttcwPos w) (diW $ ttcwDim w) 3 (Just $ ttcwTitle w)
     case (ttcwContent w) of
      SomeWidgetRef cw -> do
        withCapability (MoveableCap cw) $ do
          case (ttcwVertical w) of
            True -> do
              move cw (moveRight 1 (ttcwPos w))
              resize cw (\_ -> amendWidth (\x -> x - 1) (ttcwDim w))
            _ -> do
              move cw (moveDown 1 (ttcwPos w))
              resize cw (\_ -> amendHeight (\x -> x - 1) (ttcwDim w))
          withCapability (DrawableCap cw) $
            draw cw

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