module UI.Widgets.Spade.Selector where import qualified Data.Text as T import Data.Typeable import qualified System.Console.ANSI as A import Common import DiffRender.DiffRender import UI.Chars import UI.Widgets.Common import Interpreter.Common import Interpreter.Interpreter setOptions :: WidgetC m => WRef SelectorWidget -> [(Value, Text)] -> m () setOptions ref options = modifyWRef ref (\s -> s { selHiglighted = Nothing, selSelected = Nothing, selContent = options }) getOptions :: WidgetC m => WRef SelectorWidget -> m [(Value, Text)] getOptions ref = selContent <$> readWRef ref getSelection :: WidgetC m => WRef SelectorWidget -> m (Maybe Value) getSelection ref = do w <- readWRef ref let a = selSelected w let options = selContent w case a of Just x -> do case safeIndex options x of Just (y, _) -> do pure $ Just y Nothing -> error "Invalid selection index" Nothing -> pure Nothing data SelectorWidget = SelectorWidget { selContent :: [(Value, Text)] , selLabel :: Text , selSelected :: Maybe Int , selHiglighted :: Maybe Int , selOpen :: Bool , selOptionsBoxLength :: Int , selDim :: Dimensions , selPos :: ScreenPos , selVisibility :: Bool , selFocused :: Bool , selOptionsScrollOffset :: Int , selAction :: Maybe Callback } instance Widget SelectorWidget where hasCapability (DrawableCap _) = Just Dict hasCapability (MoveableCap _) = Just Dict hasCapability (FocusableCap _) = Just Dict hasCapability (KeyInputCap _) = Just Dict hasCapability _ = Nothing instance Moveable SelectorWidget where getPos ref = selPos <$> readWRef ref move ref pos = modifyWRef ref (\tcw -> tcw { selPos = pos }) getDim ref = selDim <$> readWRef ref resize ref cb = modifyWRef ref (\tcw -> tcw { selDim = cb $ selDim tcw }) instance Drawable SelectorWidget where setVisibility ref v = modifyWRef ref (\b -> b { selVisibility = v }) getVisibility ref = selVisibility <$> readWRef ref draw ref = do w <- readWRef ref let maxOptionWidth = case selContent w of [] -> 0 x -> Prelude.maximum (T.length . snd <$> x) let styleFn = if selFocused w then (\x -> StyledText (Fg A.Red) [Plain x]) else Plain let displayLabel = case selSelected w of Just idx -> case safeIndex (selContent w) idx of Just t -> snd t Nothing -> selLabel w Nothing -> selLabel w wSetCursor (selPos w) csPutText $ styleFn $ T.singleton verticalLine let dropBoxWidth = max (diW $ selDim w) maxOptionWidth cropWidth t = T.take (dropBoxWidth - 3) t wSetCursor (moveRight 1 $ selPos w) csPutText (Plain $ (T.singleton downarrow) <> " " <> cropWidth displayLabel) if selOpen w then do let printOption (idx, (_, txt)) = do wSetCursor (moveRight 1 $ moveDown (idx+1) $ selPos w) csPutText $ StyledText (FgBg A.White A.Black) [Plain $ T.replicate dropBoxWidth " "] case selHiglighted w of Just x -> if x == idx + (selOptionsScrollOffset w) then csPutText (StyledText (FgBg A.Red A.Black) [Plain $ " " <> cropWidth txt]) else csPutText (StyledText (FgBg A.White A.Black) [Plain $ " " <> cropWidth txt]) Nothing -> csPutText (StyledText (FgBg A.White A.Black) [Plain $ " " <> cropWidth txt]) let itemsLength = Prelude.length (selContent w) let itemsBoxLength = min itemsLength (selOptionsBoxLength w) let maxScrollOffset = max 0 (itemsLength - itemsBoxLength) let maxScrollbarPos = itemsBoxLength - 1 let mScrollbarPos = if maxScrollOffset > 0 then Just $ max 0 $ min maxScrollbarPos (div (maxScrollbarPos * (div (selOptionsScrollOffset w * 100) maxScrollOffset)) 100) else Nothing mapM_ printOption $ Prelude.zip [0..] (Prelude.take itemsBoxLength $ Prelude.drop (selOptionsScrollOffset w) $ selContent w) case mScrollbarPos of Just scrollbarPos -> do wSetCursor $ moveDown (scrollbarPos + 1) (moveRight (diW $ selDim w) $ selPos w) csPutText $ Plain (T.singleton block) Nothing -> pass else pass instance KeyInput SelectorWidget where handleInput :: forall m. WidgetC m => WRef SelectorWidget -> KeyEvent -> m () handleInput ref ev = do case ev of KeyCtrl _ _ _ ArrowUp -> do w <- readWRef ref case selOpen w of True -> modifyWRef ref (moveSelection -1) False -> modifyWRef ref (\u -> u { selOpen = True }) KeyCtrl _ _ _ ArrowDown -> do w <- readWRef ref case selOpen w of True -> modifyWRef ref (moveSelection 1) False -> modifyWRef ref (\u -> u { selOpen = True }) KeyCtrl _ _ _ Return -> do w <- readWRef ref case selOpen w of True -> do modifyWRef ref (\u -> u { selSelected = selHiglighted w, selOpen = False }) case selHiglighted w of Just _ -> do case (selAction w) of Just cb -> case eqT @m @(StateT InterpreterState IO) of Just Refl -> void $ evaluateCallback cb [WidgetValue (SomeWidgetRef ref)] Nothing -> error "" Nothing -> pass Nothing -> pass False -> pass _ -> pass getCursorInfo _ = pure Nothing moveSelection :: Int -> SelectorWidget -> SelectorWidget moveSelection d w = let newHiglighted = case selHiglighted w of Just idx -> idx + d Nothing -> 0 newHiglighted' = max 0 (min newHiglighted ((Prelude.length (selContent w)) - 1)) newScrollOffset = max 0 (newHiglighted' - 4) in w { selOptionsScrollOffset = newScrollOffset, selHiglighted = Just newHiglighted' } instance Focusable SelectorWidget where setFocus ref b = modifyWRef ref (\w -> w { selFocused = b }) getFocus ref = selFocused <$> (readWRef ref) selector :: WidgetC m => Text -> ScreenPos -> Dimensions -> [(Value, Text)] -> Maybe Callback -> m (WRef SelectorWidget) selector label sp dim options action = newWRef $ SelectorWidget options label Nothing Nothing False 5 dim sp True False 0 action