module UI.Widgets.Spade.Button where import qualified Data.Text as T import Data.Typeable import qualified System.Console.ANSI as A 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 @(StateT 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