module UI.Widgets.Spade.TextContainer where import qualified Data.Text as T import Data.Typeable import qualified System.Console.ANSI as A import Common import UI.Chars import DiffRender.DiffRender import UI.Widgets.Common data TextContainerWidget = TextContainerWidget { tcwContent :: Text , tcwDim :: Dimensions , tcwPos :: ScreenPos , tcwVisibility :: Bool , tcwFocused :: Bool , tcwScrollOffset :: Int } instance Container TextContainerWidget Text where setContent ref t = do modifyWRef ref (\tcw -> tcw { tcwContent = t }) getContent ref = tcwContent <$> readWRef ref instance Widget TextContainerWidget 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 KeyInput TextContainerWidget where getCursorInfo _ = pure Nothing handleInput ref ev = case ev of KeyCtrl _ _ _ ArrowUp -> modifyWRef ref (scroll -1) KeyCtrl _ _ _ ArrowDown -> modifyWRef ref (scroll 1) _ -> pass scroll :: Int -> TextContainerWidget -> TextContainerWidget scroll d w = let contentWidth = (diW $ tcwDim w) - 2 contentHeight = (diH $ tcwDim w) contentLines' = Prelude.concat $ (chunksOf contentWidth <$> (splitOn "\n" (tcwContent w))) contentLinesSize = Prelude.length contentLines' maxScrollOffset = max 0 (contentLinesSize - contentHeight) newScrollOffset = tcwScrollOffset w + d in w { tcwScrollOffset = min maxScrollOffset (max 0 newScrollOffset) } instance Moveable TextContainerWidget where getPos ref = tcwPos <$> readWRef ref move ref pos = modifyWRef ref (\tcw -> tcw { tcwPos = pos }) getDim ref = tcwDim <$> readWRef ref resize ref cb = modifyWRef ref (\tcw -> tcw { tcwDim = cb $ tcwDim tcw }) instance Focusable TextContainerWidget where setFocus ref b = modifyWRef ref (\w -> w { tcwFocused = b }) getFocus ref = tcwFocused <$> (readWRef ref) instance Drawable TextContainerWidget where setVisibility ref v = modifyWRef ref (\b -> b { tcwVisibility = v }) getVisibility ref = tcwVisibility <$> readWRef ref draw :: forall m. WidgetC m => WRef TextContainerWidget -> m () draw ref = do w <- readWRef ref let styleFn = if tcwFocused w then (\x -> StyledText (Fg A.Red) [Plain x]) else Plain -- drawBorderBox' (tcwPos w) (tcwDim w) styleFn forM_ [0..(diH $ tcwDim w)] (\r -> do wSetCursor $ moveDown r (tcwPos w) csPutText $ styleFn $ T.singleton verticalLine ) let contentWidth = (diW $ tcwDim w) - 2 contentHeight = (diH $ tcwDim w) contentLines = Prelude.concat (chunksOf contentWidth <$> (splitOn "\n" (tcwContent w))) contentLinesSize = Prelude.length contentLines visibleContentLines = Prelude.take contentHeight $ Prelude.drop (tcwScrollOffset w) contentLines maxScrollOffset = max 0 (contentLinesSize - contentHeight) maxScrollbarPos = contentHeight - 1 -- Top most position of scroll bar is zero. This is converted to relative location later. mScrollbarPos = if maxScrollOffset > 0 then Just $ max 0 $ min maxScrollbarPos (div (maxScrollbarPos * (div (tcwScrollOffset w * 100) maxScrollOffset)) 100) else Nothing let printLine :: (Int, Text) -> m () printLine (ln, c) = do wSetCursor $ moveDown ln (moveRight 1 $ tcwPos w) csPutText $ Plain c let emp = T.replicate ((diW $ tcwDim w) - 2) " " mapM_ printLine (Prelude.zip [0..] (Prelude.take ((diH $ tcwDim w) - 2) $ Prelude.repeat emp)) mapM_ printLine (Prelude.zip [0..] visibleContentLines) if (tcwFocused w) then case mScrollbarPos of Just scrollbarPos -> do wSetCursor $ moveDown scrollbarPos (moveRight ((diW $ tcwDim w) - 1) $ tcwPos w) csPutText $ Plain (T.singleton block) Nothing -> pass else pass where textContainer :: WidgetC m => ScreenPos -> Dimensions -> m (WRef TextContainerWidget) textContainer sp dim = newWRef $ TextContainerWidget "" dim sp True False 0