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