diff options
Diffstat (limited to 'src/TextViewport/Viewport')
| -rw-r--r-- | src/TextViewport/Viewport/Instance.hs | 76 | ||||
| -rw-r--r-- | src/TextViewport/Viewport/Position.hs | 23 | ||||
| -rw-r--r-- | src/TextViewport/Viewport/Viewport.hs | 57 |
3 files changed, 156 insertions, 0 deletions
diff --git a/src/TextViewport/Viewport/Instance.hs b/src/TextViewport/Viewport/Instance.hs new file mode 100644 index 0000000..3d0568e --- /dev/null +++ b/src/TextViewport/Viewport/Instance.hs @@ -0,0 +1,76 @@ +module TextViewport.Viewport.Instance where + +import TextViewport.Buffer.Item +import TextViewport.Buffer.Buffer (Buffer) +import TextViewport.Buffer.Buffer qualified as Buffer +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.Viewport.Position (lookupPosition) +import TextViewport.Viewport.Viewport (Viewport, clampViewport, mkViewport) +import TextViewport.Viewport.Viewport qualified as Viewport + + +data ViewportInstance = ViewportInstance + { viRender :: RenderState + , viView :: Viewport + } deriving (Show) + +mkViewportInstance :: Int -> Int -> Buffer -> ViewportInstance +mkViewportInstance width height buf = + let rs = mkRenderState width buf + vp = mkViewport width height rs + in ViewportInstance rs vp + +visibleLines :: ViewportInstance -> [RenderedLine] +visibleLines (ViewportInstance rs vp) = + take (Viewport.vpHeight vp) . drop (Viewport.vpOffset vp) . RenderedBuffer.flatten $ RenderState.rsRendered rs + +applyToInstance :: (Viewport -> Viewport) -> ViewportInstance -> ViewportInstance +applyToInstance f (ViewportInstance rs vp) = + let vp' = f vp + in ViewportInstance rs (clampViewport rs vp') + +applyToInstanceRS :: (RenderState -> Viewport -> Viewport) -> ViewportInstance -> ViewportInstance +applyToInstanceRS f (ViewportInstance rs vp) = + let vp' = f rs vp + in ViewportInstance rs (clampViewport rs vp') + +scrollByI :: Int -> ViewportInstance -> ViewportInstance +scrollByI delta = applyToInstance (Viewport.scrollBy delta) + +scrollUpI :: Int -> ViewportInstance -> ViewportInstance +scrollUpI delta = applyToInstance (Viewport.scrollUp delta) + +scrollDownI :: Int -> ViewportInstance -> ViewportInstance +scrollDownI delta = applyToInstance (Viewport.scrollDown delta) + +pageUpI :: ViewportInstance -> ViewportInstance +pageUpI = applyToInstance Viewport.pageUp + +pageDownI :: ViewportInstance -> ViewportInstance +pageDownI = applyToInstance Viewport.pageDown + +alignTopI :: ViewportInstance -> ViewportInstance +alignTopI = applyToInstance Viewport.alignTop + +alignBottomI :: ViewportInstance -> ViewportInstance +alignBottomI = applyToInstanceRS Viewport.alignBottom + +modifyItemI :: Int -> (Item -> Item) -> ViewportInstance -> ViewportInstance +modifyItemI ix f (ViewportInstance rs vp) = + let buf' = Buffer.modifyItem ix f (RenderState.rsBuffer rs) + rs' = mkRenderState (RenderState.rsWidth rs) buf' + vp' = clampViewport rs' vp + in ViewportInstance rs' vp' + +lookupPositionI :: Int -> Int -> ViewportInstance -> Maybe (Int, Int) +lookupPositionI x y (ViewportInstance rs vp) = + lookupPosition x y vp (RenderState.rsRendered rs) + +--debugVI :: ViewportInstance -> IO () +--debugVI (ViewportInstance rs vp) = do +-- putStrLn ("offset = " ++ show (Viewport.vpOffset vp)) +-- putStrLn ("height = " ++ show (Viewport.vpHeight vp)) +-- putStrLn ("lineCount = " ++ show (RenderState.rsLineCount rs)) diff --git a/src/TextViewport/Viewport/Position.hs b/src/TextViewport/Viewport/Position.hs new file mode 100644 index 0000000..149fc9e --- /dev/null +++ b/src/TextViewport/Viewport/Position.hs @@ -0,0 +1,23 @@ +module TextViewport.Viewport.Position where + +import TextViewport.Render.RenderedBuffer (RenderedBuffer) +import TextViewport.Render.RenderedBuffer qualified as RenderedBuffer +import TextViewport.Render.RenderedLine qualified as RenderedLine +import TextViewport.Viewport.Viewport (Viewport) +import TextViewport.Viewport.Viewport qualified as Viewport + +lookupPosition + :: Int + -> Int + -> Viewport + -> RenderedBuffer + -> Maybe (Int, Int) +lookupPosition x y vp rb = + let allLines = RenderedBuffer.flatten rb + idx = Viewport.vpOffset vp + y + in case drop idx allLines of + (rl:_) -> + let charIx = RenderedLine.rlCharStart rl + x + in Just (RenderedLine.rlItemIx rl, charIx) + [] -> Nothing + diff --git a/src/TextViewport/Viewport/Viewport.hs b/src/TextViewport/Viewport/Viewport.hs new file mode 100644 index 0000000..e6fdaab --- /dev/null +++ b/src/TextViewport/Viewport/Viewport.hs @@ -0,0 +1,57 @@ +module TextViewport.Viewport.Viewport where + +import TextViewport.Render.RenderState (RenderState) +import TextViewport.Render.RenderState qualified as RenderState + + +data Viewport = Viewport + { vpWidth :: !Int + , vpHeight :: !Int + , vpOffset :: !Int + } deriving (Show) + +mkViewport :: Int -> Int -> RenderState -> Viewport +mkViewport width height rs = + alignBottom rs Viewport + { vpWidth = width + , vpHeight = height + , vpOffset = 0 + } + +-- any function that sets vpOffset and can overshoot should use clampViewport +clampViewport :: RenderState -> Viewport -> Viewport +clampViewport rs vp = + let total = RenderState.rsLineCount rs + maxOff = max 0 (total - vpHeight vp) + off = vpOffset vp + in vp { vpOffset = max 0 (min maxOff off) } + +scrollBy :: Int -> Viewport -> Viewport +scrollBy delta vp = + vp { vpOffset = vpOffset vp + delta } + +scrollUp :: Int -> Viewport -> Viewport +scrollUp n = scrollBy (-n) + +scrollDown :: Int -> Viewport -> Viewport +scrollDown n = scrollBy n + +pageUp :: Viewport -> Viewport +pageUp vp = + scrollBy (-(vpHeight vp)) vp + +pageDown :: Viewport -> Viewport +pageDown vp = + scrollBy (vpHeight vp) vp + +alignTop :: Viewport -> Viewport +alignTop vp = + vp { vpOffset = 0 } + +alignBottom :: RenderState -> Viewport -> Viewport +alignBottom rs vp = + let total = RenderState.rsLineCount rs + off = max 0 (total - vpHeight vp) + in vp { vpOffset = off } + + |
