diff options
Diffstat (limited to 'src/TextViewport/Viewport/Instance.hs')
| -rw-r--r-- | src/TextViewport/Viewport/Instance.hs | 33 |
1 files changed, 17 insertions, 16 deletions
diff --git a/src/TextViewport/Viewport/Instance.hs b/src/TextViewport/Viewport/Instance.hs index c3ce338..e1cc560 100644 --- a/src/TextViewport/Viewport/Instance.hs +++ b/src/TextViewport/Viewport/Instance.hs @@ -9,69 +9,70 @@ import TextViewport.Render.RenderState qualified as RenderState import TextViewport.Render.RenderState (RenderState, mkRenderState) import TextViewport.Render.RenderedBuffer qualified as RenderedBuffer import TextViewport.Render.RenderedLine (RenderedLine(..)) -- TODO qualified +import TextViewport.Render.Segmentation (Segmenter) import TextViewport.Viewport.Position (lookupPosition) import TextViewport.Viewport.Viewport (Viewport, clampViewport, mkViewport) import TextViewport.Viewport.Viewport qualified as Viewport -data Instance a = Instance - { viRender :: RenderState a +data Instance a seg = Instance + { viRender :: RenderState a seg , viView :: Viewport } deriving (Show) -mkInstance :: (Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a -> Instance a +mkInstance :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a seg -> Instance a seg mkInstance width height buf = let rs = mkRenderState width buf vp = mkViewport width height rs in Instance rs vp -visibleLines :: Instance a -> [RenderedLine a] +visibleLines :: Instance a seg -> [RenderedLine a] visibleLines (Instance rs vp) = take (Viewport.vpHeight vp) . drop (Viewport.vpOffset vp) . RenderedBuffer.flatten $ RenderState.rsRendered rs -applyToInstance :: (Viewport -> Viewport) -> Instance a -> Instance a +applyToInstance :: (Viewport -> Viewport) -> Instance a seg -> Instance a seg applyToInstance f (Instance rs vp) = let vp' = f vp in Instance rs (clampViewport rs vp') -applyToInstanceRS :: (RenderState a -> Viewport -> Viewport) -> Instance a -> Instance a +applyToInstanceRS :: (RenderState a seg -> Viewport -> Viewport) -> Instance a seg -> Instance a seg applyToInstanceRS f (Instance rs vp) = let vp' = f rs vp in Instance rs (clampViewport rs vp') -scrollByI :: Int -> Instance a -> Instance a +scrollByI :: Int -> Instance a seg -> Instance a seg scrollByI delta = applyToInstance (Viewport.scrollBy delta) -scrollUpI :: Int -> Instance a -> Instance a +scrollUpI :: Int -> Instance a seg -> Instance a seg scrollUpI delta = applyToInstance (Viewport.scrollUp delta) -scrollDownI :: Int -> Instance a -> Instance a +scrollDownI :: Int -> Instance a seg -> Instance a seg scrollDownI delta = applyToInstance (Viewport.scrollDown delta) -pageUpI :: Instance a -> Instance a +pageUpI :: Instance a seg -> Instance a seg pageUpI = applyToInstance Viewport.pageUp -pageDownI :: Instance a -> Instance a +pageDownI :: Instance a seg -> Instance a seg pageDownI = applyToInstance Viewport.pageDown -alignTopI :: Instance a -> Instance a +alignTopI :: Instance a seg -> Instance a seg alignTopI = applyToInstance Viewport.alignTop -alignBottomI :: Instance a -> Instance a +alignBottomI :: Instance a seg -> Instance a seg alignBottomI = applyToInstanceRS Viewport.alignBottom -modifyItemI :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> Instance a -> Instance a +modifyItemI :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> (Item a seg -> Item a seg) -> Instance a seg -> Instance a seg modifyItemI ix f (Instance rs vp) = let buf' = Buffer.modifyItem ix f (RenderState.rsBuffer rs) rs' = mkRenderState (RenderState.rsWidth rs) buf' vp' = clampViewport rs' vp in Instance rs' vp' -lookupPositionI :: Int -> Int -> Instance a -> Maybe (Int, Int) +lookupPositionI :: Int -> Int -> Instance a seg -> Maybe (Int, Int) lookupPositionI x y (Instance rs vp) = lookupPosition x y vp (RenderState.rsRendered rs) ---debugVI :: Instance a -> IO () +--debugVI :: Instance a seg -> IO () --debugVI (Instance rs vp) = do -- putStrLn ("offset = " ++ show (Viewport.vpOffset vp)) -- putStrLn ("height = " ++ show (Viewport.vpHeight vp)) |
