modularize

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 }
+
+