modularize

9 files changed, 468 insertions, 0 deletions

diff --git a/src/TextViewport/Render/CachedRender.hs b/src/TextViewport/Render/CachedRender.hs
new file mode 100644
index 0000000..c4b6cf2
--- /dev/null
+++ b/src/TextViewport/Render/CachedRender.hs
@@ -0,0 +1,15 @@
+module TextViewport.Render.CachedRender where
+
+import Data.Text (Text)
+import TextViewport.Buffer.Item (SegmentStrategy)
+import TextViewport.Render.RenderedItem (RenderedItem)
+
+
+data CachedRender = CachedRender
+  { crWidth    :: !Int
+  , crStrategy :: !SegmentStrategy
+  , crText     :: !Text
+  , crRendered :: !RenderedItem
+  }
+  deriving (Eq, Show)
+
diff --git a/src/TextViewport/Render/RenderBuffer.hs b/src/TextViewport/Render/RenderBuffer.hs
new file mode 100644
index 0000000..a1122a4
--- /dev/null
+++ b/src/TextViewport/Render/RenderBuffer.hs
@@ -0,0 +1,31 @@
+module TextViewport.Render.RenderBuffer where
+
+import Data.Sequence qualified as Seq
+import TextViewport.Buffer.Buffer (Buffer(..))
+import TextViewport.Render.CachedRender
+import TextViewport.Render.RenderCache
+import TextViewport.Render.RenderItem (renderItem)
+import TextViewport.Render.RenderedBuffer
+
+renderBuffer :: Int -> Buffer -> RenderCache -> (RenderCache, RenderedBuffer)
+renderBuffer width (Buffer items) (RenderCache cache) =
+  let n = Seq.length items
+      go i (cAcc, rAcc)
+        | i >= n    = (RenderCache cAcc, RenderedBuffer rAcc)
+        | otherwise =
+            let item     = Seq.index items i
+                mOld     = Seq.index cache i
+                newEntry = renderItem width i item mOld
+                cAcc'    = Seq.update i (Just newEntry) cAcc
+                rAcc'    = rAcc Seq.|> crRendered newEntry
+            in go (i + 1) (cAcc', rAcc')
+  in go 0 (cache, Seq.empty)
+
+updateRenderedItem :: Int -> Int -> Buffer -> RenderCache -> RenderedBuffer -> (RenderCache, RenderedBuffer)
+updateRenderedItem width itemIx (Buffer items) (RenderCache cache) (RenderedBuffer rb) =
+    let item    = Seq.index items itemIx
+        mOld     = Seq.index cache itemIx
+        newEntry = renderItem width itemIx item mOld
+        newCache = Seq.update itemIx (Just newEntry) cache
+        newRB    = Seq.update itemIx (crRendered newEntry) rb
+    in (RenderCache newCache, RenderedBuffer newRB)
diff --git a/src/TextViewport/Render/RenderCache.hs b/src/TextViewport/Render/RenderCache.hs
new file mode 100644
index 0000000..1db32fe
--- /dev/null
+++ b/src/TextViewport/Render/RenderCache.hs
@@ -0,0 +1,28 @@
+module TextViewport.Render.RenderCache where
+
+import Data.Sequence (Seq)
+import Data.Sequence qualified as Seq
+import TextViewport.Buffer.Buffer (Buffer(Buffer))
+import TextViewport.Render.CachedRender (CachedRender)
+
+
+newtype RenderCache = RenderCache { unRenderCache :: Seq (Maybe CachedRender) }
+  deriving (Eq, Show)
+
+-- | Create an empty cache matching the buffer size
+emptyRenderCacheFor :: Buffer -> RenderCache
+emptyRenderCacheFor (Buffer xs) =
+    RenderCache (Seq.replicate (Seq.length xs) Nothing)
+
+-- | Resize cache to match buffer length
+resizeCache :: Buffer -> RenderCache -> RenderCache
+resizeCache (Buffer xs) (RenderCache cache) =
+    let n = Seq.length xs
+        m = Seq.length cache
+    in RenderCache $
+         if m < n then cache <> Seq.replicate (n - m) Nothing
+         else Seq.take n cache
+
+-- | Number of cached items
+length :: RenderCache -> Int
+length (RenderCache xs) = Seq.length xs
diff --git a/src/TextViewport/Render/RenderItem.hs b/src/TextViewport/Render/RenderItem.hs
new file mode 100644
index 0000000..6c9cbc3
--- /dev/null
+++ b/src/TextViewport/Render/RenderItem.hs
@@ -0,0 +1,23 @@
+module TextViewport.Render.RenderItem where
+
+import TextViewport.Buffer.Item (Item(..))
+import TextViewport.Render.CachedRender
+import TextViewport.Render.RenderedItem
+import TextViewport.Render.Segmentation (applyStrategy)
+
+renderItem :: Int -> Int -> Item -> Maybe CachedRender -> CachedRender
+renderItem width itemIx (Item txt strategy) mOld =
+  case mOld of
+    Just old
+      | crWidth old == width
+      , crText old  == txt
+      -> old
+    _ ->
+      let linesV   = applyStrategy strategy width itemIx txt
+          rendered = RenderedItem linesV
+      in CachedRender
+           { crWidth    = width
+           , crStrategy = strategy
+           , crText     = txt
+           , crRendered = rendered
+           }
diff --git a/src/TextViewport/Render/RenderState.hs b/src/TextViewport/Render/RenderState.hs
new file mode 100644
index 0000000..26e92e1
--- /dev/null
+++ b/src/TextViewport/Render/RenderState.hs
@@ -0,0 +1,132 @@
+module TextViewport.Render.RenderState where
+
+import Data.Sequence (Seq)
+import Data.Sequence qualified as Seq
+import TextViewport.Buffer.Item
+import TextViewport.Buffer.Buffer (Buffer(Buffer))
+import TextViewport.Buffer.Buffer qualified as Buffer
+import TextViewport.Render.RenderBuffer (renderBuffer)
+import TextViewport.Render.RenderCache (RenderCache(..), emptyRenderCacheFor, resizeCache)
+import TextViewport.Render.RenderedBuffer (RenderedBuffer(RenderedBuffer))
+import TextViewport.Render.RenderedBuffer qualified as RenderedBuffer
+
+data RenderState = RenderState
+  { rsBuffer    :: Buffer             -- original items
+  , rsCache     :: RenderCache        -- per-item cached renders
+  , rsRendered  :: RenderedBuffer     -- fully segmented + hyphenated lines
+  , rsWidth     :: Int                -- segmenting width
+  , rsLineCount :: Int                
+  } deriving (Eq, Show)
+
+mkRenderState :: Int -> Buffer -> RenderState
+mkRenderState width buf =
+  let (cache1, rendered) = renderBuffer width buf (emptyRenderCacheFor buf)
+  in RenderState
+       { rsBuffer    = buf
+       , rsCache     = cache1
+       , rsRendered  = rendered
+       , rsWidth     = width
+       , rsLineCount = length (RenderedBuffer.flatten rendered)
+       }
+
+-- RenderState has to be rebuilt whenever the buffer or the width changes.
+updateRenderState :: Int -> Buffer -> RenderState -> RenderState
+updateRenderState width buf rs =
+  let (cache1, rendered) = renderBuffer width buf (rsCache rs)
+  in rs
+      { rsBuffer    = buf
+      , rsCache     = cache1
+      , rsRendered  = rendered
+      , rsWidth     = width
+      , rsLineCount = length (RenderedBuffer.flatten rendered)
+      }
+
+modifyItemRS :: Int -> (Item -> Item) -> RenderState -> RenderState
+modifyItemRS ix f st =
+  let buf'    = Buffer.modifyItem ix f (rsBuffer st)
+      cache'  = resizeCache buf' (rsCache st)
+      (cache1, rendered1) = renderBuffer (rsWidth st) buf' cache'
+  in st { rsBuffer    = buf'
+        , rsCache     = cache1
+        , rsRendered  = rendered1
+        , rsLineCount = length (RenderedBuffer.flatten rendered1)
+        }
+
+insertItem :: Int -> Item -> RenderState -> RenderState
+insertItem i newItem st =
+  let Buffer items = rsBuffer st
+      items'       = Seq.insertAt i newItem items
+      buf'         = Buffer items'
+      cache'       = resizeCache buf' (rsCache st)
+      (cache1, rendered1) = renderBuffer (rsWidth st) buf' cache'
+  in st { rsBuffer = buf'
+        , rsCache = cache1
+        , rsRendered = rendered1
+        , rsLineCount = length (RenderedBuffer.flatten rendered1)
+        }
+
+deleteItem :: Int -> RenderState -> RenderState
+deleteItem i st =
+  let Buffer items = rsBuffer st
+      items'       = Seq.deleteAt i items
+      buf'         = Buffer items'
+      cache'       = resizeCache buf' (rsCache st)
+      (cache1, rendered1) = renderBuffer (rsWidth st) buf' cache'
+  in st { rsBuffer = buf'
+        , rsCache = cache1
+        , rsRendered = rendered1
+        , rsLineCount = length (RenderedBuffer.flatten rendered1)
+        }
+
+replaceItem :: Int -> Item -> RenderState -> RenderState
+replaceItem i newItem st =
+  let Buffer items = rsBuffer st
+      items'       = Seq.update i newItem items
+      buf'         = Buffer items'
+      cache'       = resizeCache buf' (rsCache st)
+      (cache1, rendered1) = renderBuffer (rsWidth st) buf' cache'
+  in st { rsBuffer = buf'
+        , rsCache = cache1
+        , rsRendered = rendered1
+        , rsLineCount = length (RenderedBuffer.flatten rendered1)
+        }
+
+appendItem :: Item -> RenderState -> RenderState
+appendItem newItem st =
+  insertItem (Seq.length (let Buffer xs = rsBuffer st in xs)) newItem st
+
+clearBuffer :: RenderState -> RenderState
+clearBuffer st =
+  let buf' = Buffer Seq.empty
+      cache' = RenderCache Seq.empty
+  in st { rsBuffer = buf'
+        , rsCache = cache'
+        , rsRendered = RenderedBuffer Seq.empty
+        , rsLineCount = 0
+        }
+
+fromList :: Int -> [Item] -> RenderState
+fromList width xs =
+  let buf     = Buffer (Seq.fromList xs)
+      cache0  = RenderCache (Seq.replicate (length xs) Nothing)
+      (cache1, rendered) = renderBuffer width buf cache0
+  in RenderState
+       { rsBuffer    = buf
+       , rsCache     = cache1
+       , rsRendered  = rendered
+       , rsWidth     = width
+       , rsLineCount = length (RenderedBuffer.flatten rendered)
+       }
+
+fromSeq :: Int -> Seq Item -> RenderState
+fromSeq width items =
+  let buf     = Buffer items
+      cache0  = RenderCache (Seq.replicate (Seq.length items) Nothing)
+      (cache1, rendered) = renderBuffer width buf cache0
+  in RenderState
+       { rsBuffer    = buf
+       , rsCache     = cache1
+       , rsRendered  = rendered
+       , rsWidth     = width
+       , rsLineCount = length (RenderedBuffer.flatten rendered)
+       }
diff --git a/src/TextViewport/Render/RenderedBuffer.hs b/src/TextViewport/Render/RenderedBuffer.hs
new file mode 100644
index 0000000..cbff8ca
--- /dev/null
+++ b/src/TextViewport/Render/RenderedBuffer.hs
@@ -0,0 +1,19 @@
+module TextViewport.Render.RenderedBuffer where
+
+import Data.Foldable qualified as F
+import Data.Sequence (Seq)
+import Data.Sequence qualified as Seq
+import TextViewport.Render.RenderedItem (RenderedItem)
+import TextViewport.Render.RenderedItem qualified as RenderedItem
+import TextViewport.Render.RenderedLine (RenderedLine)
+
+
+newtype RenderedBuffer = RenderedBuffer { unRenderedBuffer :: Seq RenderedItem }
+  deriving (Eq, Show)
+
+flatten :: RenderedBuffer -> [RenderedLine]
+flatten = concatMap (F.toList . RenderedItem.riLines) . F.toList . unRenderedBuffer
+
+fromList :: [RenderedItem] -> RenderedBuffer
+fromList =
+    RenderedBuffer . Seq.fromList
diff --git a/src/TextViewport/Render/RenderedItem.hs b/src/TextViewport/Render/RenderedItem.hs
new file mode 100644
index 0000000..b32bd6d
--- /dev/null
+++ b/src/TextViewport/Render/RenderedItem.hs
@@ -0,0 +1,9 @@
+module TextViewport.Render.RenderedItem where
+
+import Data.Vector (Vector)
+import TextViewport.Render.RenderedLine
+
+
+data RenderedItem = RenderedItem
+  { riLines :: !(Vector RenderedLine)
+  } deriving (Eq, Show)
diff --git a/src/TextViewport/Render/RenderedLine.hs b/src/TextViewport/Render/RenderedLine.hs
new file mode 100644
index 0000000..579d28e
--- /dev/null
+++ b/src/TextViewport/Render/RenderedLine.hs
@@ -0,0 +1,11 @@
+module TextViewport.Render.RenderedLine where
+
+import Data.Text (Text)
+
+
+data RenderedLine = RenderedLine
+  { rlText      :: !Text
+  , rlItemIx    :: !Int
+  , rlLineIx    :: !Int
+  , rlCharStart :: !Int
+  } deriving (Eq, Show)
diff --git a/src/TextViewport/Render/Segmentation.hs b/src/TextViewport/Render/Segmentation.hs
new file mode 100644
index 0000000..584798e
--- /dev/null
+++ b/src/TextViewport/Render/Segmentation.hs
@@ -0,0 +1,200 @@
+module TextViewport.Render.Segmentation where
+
+import Data.DList qualified as DL
+import Data.HashMap.Strict qualified as HM
+import Data.List (minimumBy)
+import Data.Ord (comparing)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Vector (Vector)
+import Data.Vector qualified as V
+import Text.Hyphenation qualified as H
+import TextViewport.Buffer.Item
+import TextViewport.Render.RenderedLine (RenderedLine(..)) -- TODO qualified
+
+applyStrategy :: SegmentStrategy -> Int -> Int -> Text -> Vector RenderedLine
+
+applyStrategy NoSegments width itemIx txt =
+  let rawLines = T.splitOn "\n" txt
+      chunks  = map (T.take width) rawLines -- crop
+      offsets = scanOffsetsWithNewlines chunks
+  in V.fromList
+       [ RenderedLine { rlText = chunk, rlItemIx = itemIx, rlLineIx = lineIx, rlCharStart = off }
+       | (lineIx, (off, chunk)) <- zip [0..] (zip offsets chunks)
+       ]
+
+applyStrategy FixedWidthSegments width itemIx txt =
+  let rawLines = T.splitOn "\n" txt
+      (dl, _) = foldl step (DL.empty, 0) rawLines
+      step (acc, off0) line =
+        let chunks   = chunkFixed width line
+            offsets  = scanOffsetsFrom off0 chunks
+            offNext  = off0 + T.length line + 1
+            acc'     = acc `DL.append` DL.fromList (zip offsets chunks)
+        in (acc', offNext)
+      allChunks = DL.toList dl
+  in V.fromList
+       [ RenderedLine { rlText = chunk, rlItemIx = itemIx, rlLineIx = lineIx, rlCharStart = off }
+       | (lineIx, (off, chunk)) <- zip [0..] allChunks
+       ]
+
+applyStrategy (HyphenateSegments dict cache0) width itemIx txt =
+  let rawLines = T.splitOn "\n" txt
+
+      -- fold over each physical line, accumulating:
+      --   * all rendered (offset, chunk) pairs
+      --   * updated hyphenation cache (unused for now)
+      --   * running character offset across lines
+      (dl, _cache1, _) =
+        foldl segmentOneLine (DL.empty, cache0, 0) rawLines
+      allChunks = DL.toList dl
+  in V.fromList
+       [ RenderedLine { rlText = chunk, rlItemIx = itemIx, rlLineIx = lineIx, rlCharStart = off }
+       | (lineIx, (off, chunk)) <- zip [0..] allChunks
+       ]
+  where
+    -- Segment a single physical line using TeX‑lite hyphenation
+    --segmentOneLine
+    --  :: ([(Int, Text)], HM.HashMap Text [(Text, Text)], Int)
+    --  -> Text
+    --  -> ([(Int, Text)], HM.HashMap Text [(Text, Text)], Int)
+    segmentOneLine (acc, cache, off0) line =
+      let (chunks, cache1) = segmentWithHyphenationTeXLite dict width line cache
+          offsets          = scanOffsetsFrom off0 chunks
+          offNext          = off0 + T.length line + 1
+          acc'             = acc `DL.append` DL.fromList (zip offsets chunks)
+      in (acc', cache1, offNext)
+    --segmentOneLine (acc, cache, off0) line =
+    --  let chunks  = segmentWithHyphenationTeXLite dict width line
+    --      offsets = scanOffsetsFrom off0 chunks
+    --      offNext = off0 + T.length line + 1   -- +1 for newline
+    --      acc'    = acc ++ zip offsets chunks
+    --  in (acc', cache, offNext)
+
+-- | Compute running character offsets for a list of chunks.
+scanOffsetsWithNewlines :: [Text] -> [Int]
+scanOffsetsWithNewlines = go 0
+  where
+    go !_ []     = []
+    go !o (l:ls) =
+      let off = o
+          o'  = o + T.length l + 1   -- +1 for newline
+      in off : go o' ls
+
+-- | Chunk a single line into fixed-width pieces.
+chunkFixed :: Int -> Text -> [Text]
+chunkFixed w t
+  | w <= 0    = []
+  | T.null t  = [""]
+  | otherwise =
+      let (h, rest) = T.splitAt w t
+      in h : if T.null rest then [] else chunkFixed w rest
+
+--------------------------------------------------------------------------------
+-- Hyphenation-aware segmenting (TeX-lite)
+--------------------------------------------------------------------------------
+
+-- Compute offsets starting from a base offset
+scanOffsetsFrom :: Int -> [Text] -> [Int]
+scanOffsetsFrom start = go start
+  where
+    go !_ []     = []
+    go !o (t:ts) = o : go (o + T.length t) ts
+
+segmentWithHyphenationTeXLite
+  :: H.Hyphenator
+  -> Int
+  -> Text
+  -> HM.HashMap Text [(Text, Text)]
+  -> ([Text], HM.HashMap Text [(Text, Text)])
+segmentWithHyphenationTeXLite dict width txt cache0 =
+    go cache0 (T.words txt)
+  where
+    go cache [] = ([], cache)
+    go cache ws =
+      case lineCandidates dict width cache ws of
+        ([], cache1) ->
+          let chunks = breakWordSafe width ws
+          in (chunks, cache1)
+        (cs, cache1) ->
+          let (line, rest, _) =
+                minimumBy (comparing (scoreCandidate width)) cs
+              (more, cache2) = go cache1 rest
+          in (line : more, cache2)
+
+-- | Lossless fallback: treat remaining words as one long text and
+--   chunk it into width-sized pieces. Never truncates, never drops text.
+breakWordSafe :: Int -> [Text] -> [Text]
+breakWordSafe width ws =
+  chunk (T.unwords ws)
+  where
+    chunk t
+      | T.null t            = []
+      | T.length t <= width = [t]
+      | otherwise =
+          let (c, r) = T.splitAt width t
+          in c : chunk r
+
+type Candidate = (Text, [Text], Bool)
+
+lineCandidates
+  :: H.Hyphenator
+  -> Int
+  -> HM.HashMap Text [(Text, Text)]
+  -> [Text]
+  -> ([(Text, [Text], Bool)], HM.HashMap Text [(Text, Text)])
+lineCandidates dict width cache0 ws0 =
+  go [] [] cache0 ws0
+  where
+    go _    acc cache [] = (acc, cache)
+    go line acc cache (w:ws) =
+      let space   = if null line then "" else " "
+          baseTxt = T.unwords line
+          wholeTxt = baseTxt <> space <> w
+          wholeLen = T.length wholeTxt
+
+          acc1 =
+            if wholeLen <= width && not (T.null wholeTxt)
+              then (wholeTxt, ws, False) : acc
+              else acc
+
+          (hyphs, cache1) =
+            case HM.lookup w cache of
+              Just hs -> (hs, cache)
+              Nothing ->
+                let hs = hyphenateWord dict w
+                in (hs, HM.insert w hs cache)
+
+          hyphCands =
+            [ (preTxt, suf : ws, True)
+            | (pre, suf) <- hyphs
+            , not (T.null pre)
+            , let preTxt = baseTxt <> space <> pre <> "-"
+            , T.length preTxt <= width
+            ]
+
+          acc2 = hyphCands ++ acc1
+      in if wholeLen <= width
+           then go (line ++ [w]) acc2 cache1 ws
+           else (acc2, cache1)
+
+hyphenateWord :: H.Hyphenator -> Text -> [(Text, Text)]
+hyphenateWord dict word =
+    let parts = H.hyphenate dict (T.unpack word)
+    in [ ( T.pack (concat (take i parts))
+         , T.pack (concat (drop i parts))
+         )
+       | i <- [1 .. length parts - 1]
+       ]
+
+scoreCandidate :: Int -> Candidate -> Int
+scoreCandidate width (line, _, endsWithHyphen) =
+    let len      = T.length line
+        remSpace = max 0 (width - len)
+        badness  = remSpace * remSpace * remSpace
+        hyphenPenalty =
+          if endsWithHyphen then 50 else 0
+        shortPenalty =
+          if len < width `div` 2 then 200 else 0
+    in badness + hyphenPenalty + shortPenalty
+