module UI.Widgets.MenuContainer where import qualified Data.Text as T import System.Console.ANSI (Color(..)) import Text.Printf import Common import Highlighter.Highlighter import UI.Widgets.Common as C type KeyHandler = forall m. WidgetC m => KeyEvent -> WRef MenuContainerWidget -> m Bool type SelectionHandler = forall m. WidgetC m => WRef MenuContainerWidget -> (Int, Int) -> m () data SubMenu = SubMenu [Text] data Menu = Menu { menuItems :: [(Text, SubMenu)] , menuActive :: Maybe (Int, Int) -- Menu items and sub items are indexed from 0 , menuTitle :: Maybe Text } data MenuContainerWidget = MenuContainerWidget { mcwDim :: Dimensions , mcwContent :: SomeWidgetRef , mcwMenu :: Menu , mcwSelectionHandler :: SelectionHandler , mcwVisibility :: Bool } instance Container MenuContainerWidget SomeWidgetRef where setContent ref c = modifyWRef ref (\mcw -> mcw { mcwContent = c }) getContent ref = mcwContent <$> readWRef ref getSubmenuAt :: Menu -> Int -> Maybe SubMenu getSubmenuAt (Menu mis _ _) x = case safeIndex mis x of Just (_, sm) -> Just sm Nothing -> Nothing getMenuItem :: Menu -> (Int, Int) -> Maybe [Text] getMenuItem (Menu mis _ _) (x, y) = case safeIndex mis x of Just (mmName, SubMenu sm) -> case safeIndex sm y of Just sName -> Just [mmName, sName] Nothing -> Nothing Nothing -> Nothing instance Widget MenuContainerWidget where hasCapability (DrawableCap _) = Just Dict hasCapability _ = Nothing instance Drawable MenuContainerWidget where draw :: forall m. WidgetC m => WRef MenuContainerWidget -> m () setVisibility ref v = modifyWRef ref (\b -> b { mcwVisibility = v }) getVisibility ref = mcwVisibility <$> readWRef ref draw ref = do w <- readWRef ref drawBorderBox (ScreenPos 0 0) (mcwDim w) case mcwMenu w of Menu mi _ mtitle -> do co <- foldM (\x (n, _) -> do csSetCursorPosition x 0 csPutText (colorText White Black (" "<> n <> " ")) pure (x + (T.length n + 2)) ) 2 mi case mtitle of Just title -> do csSetCursorPosition co 0 csPutText $ colorText White Blue (" "<> title <> " ") Nothing -> pass case mcwContent w of SomeWidgetRef a -> do withCapability (DrawableCap a) $ do withCapability (MoveableCap a) $ do move a (ScreenPos 1 1) resize a (\_ -> amendWidth (\x -> x - 2) $ amendHeight (\x -> x-2) (mcwDim w) ) draw a case menuActive $ mcwMenu w of Just (m, s) -> do case mcwMenu w of Menu mi _ _ -> foldM_ (\(idx, x) (n, submenu) -> do if idx == m then do case submenu of SubMenu smi -> do let wi = max 30 (Prelude.maximum $ T.length <$> ("": smi)) csSetCursorPosition x 0 drawBorderBox (ScreenPos x 1) (Dimensions (wi + 2) (Prelude.length smi + 2)) foldM_ (\idy n' -> do csSetCursorPosition (x + 1) (idy + 2) let stx = "%-" <> (show wi) <> "s" let cnt = " "<> n' if idy == s then csPutText (colorText White Black (T.pack $ printf stx cnt)) else csPutText (colorTextFg White (T.pack $ printf stx cnt)) pure (idy+1)) 0 smi else pure () pure (idx + 1, x + T.length n + 2) ) (0, 2) mi Nothing -> pure () menuContainer :: SomeWidgetRef -> Menu -> SelectionHandler -> WidgetM m (WRef MenuContainerWidget) menuContainer child menu handler = do newWRef $ MenuContainerWidget { mcwDim = Dimensions 0 0 , mcwContent = child , mcwMenu = menu , mcwSelectionHandler = handler , mcwVisibility = True }