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 :: WidgetC m => SomeWidgetRef -> Text -> m (WRef TitledContainer) titledContainer cont title = newWRef $ TitledContainer title cont (Dimensions 0 0) (ScreenPos 0 0) True False