Button.hs

module UI.Widgets.Spade.Button where

import qualified Data.Text as T
import Control.Concurrent.STM.TVar
import Data.Typeable
import qualified System.Console.ANSI as A
import Control.Monad.Reader

import Common
import DiffRender.DiffRender
import UI.Widgets.Common

import Interpreter.Common
import Interpreter.Interpreter

data ButtonWidget = ButtonWidget
  { bwContent    :: Text
  , bwDim        :: Dimensions
  , bwPos        :: ScreenPos
  , bwVisibility :: Bool
  , bwFocused    :: Bool
  , bwAction     :: Maybe Callback
  }

instance Container ButtonWidget Text where
  setContent ref t = modifyWRef ref (\w -> w { bwContent = t })
  getContent _ = error "undefined"

instance KeyInput ButtonWidget where
  handleInput :: forall m. WidgetC m => WRef ButtonWidget -> KeyEvent -> m ()
  handleInput ref ev = do
    case ev of
      KeyCtrl _ _ _ Return -> do
        w <- readWRef ref
        case (bwAction w) of
          Just cb -> case eqT @m @(ReaderT (TVar InterpreterState) IO) of
            Just Refl -> void $ evaluateCallback cb []
            Nothing -> error ""
          Nothing -> pure ()
      _ -> pass
  getCursorInfo _ = pure Nothing

instance Focusable ButtonWidget where
  setFocus ref b =
    modifyWRef ref (\w -> w { bwFocused = b })
  getFocus ref =
    bwFocused <$> (readWRef ref)

instance Widget ButtonWidget where
  hasCapability (ContainerCap _ (_ :: Proxy cnt)) = case eqT @cnt @Text of
    Just Refl -> Just Dict
    Nothing   -> Nothing
  hasCapability (DrawableCap _) = Just Dict
  hasCapability (MoveableCap _) = Just Dict
  hasCapability (FocusableCap _) = Just Dict
  hasCapability (KeyInputCap _) = Just Dict
  hasCapability _ = Nothing

instance Moveable ButtonWidget where
  getPos ref = bwPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\b -> b { bwPos = pos })
  getDim ref = bwDim <$> readWRef ref
  resize _ _ = pure ()

instance Drawable ButtonWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { bwVisibility = v })
  getVisibility ref = bwVisibility <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    if (bwFocused w)
      then drawBorderBox' (bwPos w) (bwDim w) (\x -> StyledText (Fg A.Red) [Plain x])
      else drawBorderBox' (bwPos w) (bwDim w) Plain
    wSetCursor (moveDown 1 $ moveRight 1 $ bwPos w)
    csPutText $ Plain $ T.replicate ((diW $ bwDim w) - 2) " "
    wSetCursor (moveDown 1 $ moveRight 2 $ bwPos w)
    csPutText $ Plain $ T.take (diW $ bwDim w) $ bwContent w

button
  :: WidgetC m
  => ScreenPos
  -> Dimensions
  -> Text
  -> Maybe Callback
  -> m (WRef ButtonWidget)
button sp dim label cb = newWRef $ ButtonWidget label dim sp True False cb