MenuContainer.hs

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
  }

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
    case mcwMenu w of
      Menu mi _ -> foldM_ (\x (n, _) -> do
        csSetCursorPosition x 0
        csPutText (colorText White Black (" "<> n <> " "))
        pure (x + (T.length n + 2))
        ) 1 mi
    case mcwContent w of
      SomeWidgetRef a -> do
        withCapability (DrawableCap a) $ do
          withCapability (MoveableCap a) $ do
            move a (ScreenPos 0 1)
            resize a (\_ -> amendHeight (mcwDim w) (\x -> x-2))
            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, 1) 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
    }