summaryrefslogtreecommitdiffstats
path: root/src/TextViewport/Render
diff options
context:
space:
mode:
Diffstat (limited to 'src/TextViewport/Render')
-rw-r--r--src/TextViewport/Render/CachedRender.hs9
-rw-r--r--src/TextViewport/Render/RenderBuffer.hs6
-rw-r--r--src/TextViewport/Render/RenderCache.hs8
-rw-r--r--src/TextViewport/Render/RenderItem.hs5
-rw-r--r--src/TextViewport/Render/RenderState.hs32
-rw-r--r--src/TextViewport/Render/RenderedBuffer.hs6
-rw-r--r--src/TextViewport/Render/RenderedItem.hs4
-rw-r--r--src/TextViewport/Render/RenderedLine.hs4
-rw-r--r--src/TextViewport/Render/Segmentation.hs109
9 files changed, 100 insertions, 83 deletions
diff --git a/src/TextViewport/Render/CachedRender.hs b/src/TextViewport/Render/CachedRender.hs
index c4b6cf2..b5af8d4 100644
--- a/src/TextViewport/Render/CachedRender.hs
+++ b/src/TextViewport/Render/CachedRender.hs
@@ -1,15 +1,14 @@
module TextViewport.Render.CachedRender where
-import Data.Text (Text)
import TextViewport.Buffer.Item (SegmentStrategy)
import TextViewport.Render.RenderedItem (RenderedItem)
-data CachedRender = CachedRender
+data CachedRender a = CachedRender
{ crWidth :: !Int
- , crStrategy :: !SegmentStrategy
- , crText :: !Text
- , crRendered :: !RenderedItem
+ , crStrategy :: !(SegmentStrategy a)
+ , crText :: !a
+ , crRendered :: !(RenderedItem a)
}
deriving (Eq, Show)
diff --git a/src/TextViewport/Render/RenderBuffer.hs b/src/TextViewport/Render/RenderBuffer.hs
index a1122a4..fb782f5 100644
--- a/src/TextViewport/Render/RenderBuffer.hs
+++ b/src/TextViewport/Render/RenderBuffer.hs
@@ -1,13 +1,15 @@
module TextViewport.Render.RenderBuffer where
+import Data.Hashable (Hashable)
import Data.Sequence qualified as Seq
+import Data.Sequences (Index, Textual)
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 :: (Hashable t, Textual t, Index t ~ Int) => Int -> Buffer t -> RenderCache t -> (RenderCache t, RenderedBuffer t)
renderBuffer width (Buffer items) (RenderCache cache) =
let n = Seq.length items
go i (cAcc, rAcc)
@@ -21,7 +23,7 @@ renderBuffer width (Buffer items) (RenderCache cache) =
in go (i + 1) (cAcc', rAcc')
in go 0 (cache, Seq.empty)
-updateRenderedItem :: Int -> Int -> Buffer -> RenderCache -> RenderedBuffer -> (RenderCache, RenderedBuffer)
+updateRenderedItem :: (Hashable t, Textual t, Index t ~ Int) => Int -> Int -> Buffer t -> RenderCache t -> RenderedBuffer t -> (RenderCache t, RenderedBuffer t)
updateRenderedItem width itemIx (Buffer items) (RenderCache cache) (RenderedBuffer rb) =
let item = Seq.index items itemIx
mOld = Seq.index cache itemIx
diff --git a/src/TextViewport/Render/RenderCache.hs b/src/TextViewport/Render/RenderCache.hs
index 1db32fe..dcd65e0 100644
--- a/src/TextViewport/Render/RenderCache.hs
+++ b/src/TextViewport/Render/RenderCache.hs
@@ -6,16 +6,16 @@ import TextViewport.Buffer.Buffer (Buffer(Buffer))
import TextViewport.Render.CachedRender (CachedRender)
-newtype RenderCache = RenderCache { unRenderCache :: Seq (Maybe CachedRender) }
+newtype RenderCache a = RenderCache { unRenderCache :: Seq (Maybe (CachedRender a)) }
deriving (Eq, Show)
-- | Create an empty cache matching the buffer size
-emptyRenderCacheFor :: Buffer -> RenderCache
+emptyRenderCacheFor :: Buffer a -> RenderCache a
emptyRenderCacheFor (Buffer xs) =
RenderCache (Seq.replicate (Seq.length xs) Nothing)
-- | Resize cache to match buffer length
-resizeCache :: Buffer -> RenderCache -> RenderCache
+resizeCache :: Buffer a -> RenderCache a -> RenderCache a
resizeCache (Buffer xs) (RenderCache cache) =
let n = Seq.length xs
m = Seq.length cache
@@ -24,5 +24,5 @@ resizeCache (Buffer xs) (RenderCache cache) =
else Seq.take n cache
-- | Number of cached items
-length :: RenderCache -> Int
+length :: RenderCache a -> Int
length (RenderCache xs) = Seq.length xs
diff --git a/src/TextViewport/Render/RenderItem.hs b/src/TextViewport/Render/RenderItem.hs
index 6c9cbc3..7e00cf1 100644
--- a/src/TextViewport/Render/RenderItem.hs
+++ b/src/TextViewport/Render/RenderItem.hs
@@ -1,11 +1,14 @@
module TextViewport.Render.RenderItem where
+import Data.Hashable (Hashable)
+import Data.Sequences (Index, Textual)
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 :: (Hashable t, Textual t, Index t ~ Int) => Int -> Int -> Item t -> Maybe (CachedRender t) -> CachedRender t
renderItem width itemIx (Item txt strategy) mOld =
case mOld of
Just old
diff --git a/src/TextViewport/Render/RenderState.hs b/src/TextViewport/Render/RenderState.hs
index 26e92e1..8c0cdef 100644
--- a/src/TextViewport/Render/RenderState.hs
+++ b/src/TextViewport/Render/RenderState.hs
@@ -1,24 +1,26 @@
module TextViewport.Render.RenderState where
+import Data.Hashable (Hashable)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
-import TextViewport.Buffer.Item
+import Data.Sequences (Index, Textual)
import TextViewport.Buffer.Buffer (Buffer(Buffer))
import TextViewport.Buffer.Buffer qualified as Buffer
+import TextViewport.Buffer.Item
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
+data RenderState a = RenderState
+ { rsBuffer :: Buffer a -- original items
+ , rsCache :: RenderCache a -- per-item cached renders
+ , rsRendered :: RenderedBuffer a -- fully segmented + hyphenated lines
, rsWidth :: Int -- segmenting width
, rsLineCount :: Int
} deriving (Eq, Show)
-mkRenderState :: Int -> Buffer -> RenderState
+mkRenderState :: (Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a -> RenderState a
mkRenderState width buf =
let (cache1, rendered) = renderBuffer width buf (emptyRenderCacheFor buf)
in RenderState
@@ -30,7 +32,7 @@ mkRenderState width buf =
}
-- RenderState has to be rebuilt whenever the buffer or the width changes.
-updateRenderState :: Int -> Buffer -> RenderState -> RenderState
+updateRenderState :: (Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a -> RenderState a -> RenderState a
updateRenderState width buf rs =
let (cache1, rendered) = renderBuffer width buf (rsCache rs)
in rs
@@ -41,7 +43,7 @@ updateRenderState width buf rs =
, rsLineCount = length (RenderedBuffer.flatten rendered)
}
-modifyItemRS :: Int -> (Item -> Item) -> RenderState -> RenderState
+modifyItemRS :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> RenderState a -> RenderState a
modifyItemRS ix f st =
let buf' = Buffer.modifyItem ix f (rsBuffer st)
cache' = resizeCache buf' (rsCache st)
@@ -52,7 +54,7 @@ modifyItemRS ix f st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-insertItem :: Int -> Item -> RenderState -> RenderState
+insertItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> Item a -> RenderState a -> RenderState a
insertItem i newItem st =
let Buffer items = rsBuffer st
items' = Seq.insertAt i newItem items
@@ -65,7 +67,7 @@ insertItem i newItem st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-deleteItem :: Int -> RenderState -> RenderState
+deleteItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> RenderState a -> RenderState a
deleteItem i st =
let Buffer items = rsBuffer st
items' = Seq.deleteAt i items
@@ -78,7 +80,7 @@ deleteItem i st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-replaceItem :: Int -> Item -> RenderState -> RenderState
+replaceItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> Item a -> RenderState a -> RenderState a
replaceItem i newItem st =
let Buffer items = rsBuffer st
items' = Seq.update i newItem items
@@ -91,11 +93,11 @@ replaceItem i newItem st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-appendItem :: Item -> RenderState -> RenderState
+appendItem :: (Hashable a, Textual a, Index a ~ Int) => Item a -> RenderState a -> RenderState a
appendItem newItem st =
insertItem (Seq.length (let Buffer xs = rsBuffer st in xs)) newItem st
-clearBuffer :: RenderState -> RenderState
+clearBuffer :: RenderState a -> RenderState a
clearBuffer st =
let buf' = Buffer Seq.empty
cache' = RenderCache Seq.empty
@@ -105,7 +107,7 @@ clearBuffer st =
, rsLineCount = 0
}
-fromList :: Int -> [Item] -> RenderState
+fromList :: (Hashable a, Textual a, Index a ~ Int) => Int -> [Item a] -> RenderState a
fromList width xs =
let buf = Buffer (Seq.fromList xs)
cache0 = RenderCache (Seq.replicate (length xs) Nothing)
@@ -118,7 +120,7 @@ fromList width xs =
, rsLineCount = length (RenderedBuffer.flatten rendered)
}
-fromSeq :: Int -> Seq Item -> RenderState
+fromSeq :: (Hashable a, Textual a, Index a ~ Int) => Int -> Seq (Item a) -> RenderState a
fromSeq width items =
let buf = Buffer items
cache0 = RenderCache (Seq.replicate (Seq.length items) Nothing)
diff --git a/src/TextViewport/Render/RenderedBuffer.hs b/src/TextViewport/Render/RenderedBuffer.hs
index cbff8ca..9b8fa61 100644
--- a/src/TextViewport/Render/RenderedBuffer.hs
+++ b/src/TextViewport/Render/RenderedBuffer.hs
@@ -8,12 +8,12 @@ import TextViewport.Render.RenderedItem qualified as RenderedItem
import TextViewport.Render.RenderedLine (RenderedLine)
-newtype RenderedBuffer = RenderedBuffer { unRenderedBuffer :: Seq RenderedItem }
+newtype RenderedBuffer a = RenderedBuffer { unRenderedBuffer :: Seq (RenderedItem a) }
deriving (Eq, Show)
-flatten :: RenderedBuffer -> [RenderedLine]
+flatten :: RenderedBuffer a -> [RenderedLine a]
flatten = concatMap (F.toList . RenderedItem.riLines) . F.toList . unRenderedBuffer
-fromList :: [RenderedItem] -> RenderedBuffer
+fromList :: [RenderedItem a] -> RenderedBuffer a
fromList =
RenderedBuffer . Seq.fromList
diff --git a/src/TextViewport/Render/RenderedItem.hs b/src/TextViewport/Render/RenderedItem.hs
index b32bd6d..f043e96 100644
--- a/src/TextViewport/Render/RenderedItem.hs
+++ b/src/TextViewport/Render/RenderedItem.hs
@@ -4,6 +4,6 @@ import Data.Vector (Vector)
import TextViewport.Render.RenderedLine
-data RenderedItem = RenderedItem
- { riLines :: !(Vector RenderedLine)
+data RenderedItem a = RenderedItem
+ { riLines :: !(Vector (RenderedLine a))
} deriving (Eq, Show)
diff --git a/src/TextViewport/Render/RenderedLine.hs b/src/TextViewport/Render/RenderedLine.hs
index 579d28e..ffc2be2 100644
--- a/src/TextViewport/Render/RenderedLine.hs
+++ b/src/TextViewport/Render/RenderedLine.hs
@@ -3,8 +3,8 @@ module TextViewport.Render.RenderedLine where
import Data.Text (Text)
-data RenderedLine = RenderedLine
- { rlText :: !Text
+data RenderedLine a = RenderedLine
+ { rlText :: !a
, rlItemIx :: !Int
, rlLineIx :: !Int
, rlCharStart :: !Int
diff --git a/src/TextViewport/Render/Segmentation.hs b/src/TextViewport/Render/Segmentation.hs
index 55971ce..3d64748 100644
--- a/src/TextViewport/Render/Segmentation.hs
+++ b/src/TextViewport/Render/Segmentation.hs
@@ -2,8 +2,12 @@ module TextViewport.Render.Segmentation where
import Data.DList qualified as DL
import Data.HashMap.Strict qualified as HM
+import Data.Hashable (Hashable)
import Data.List (minimumBy)
+import Data.MonoTraversable.Unprefixed qualified as O
import Data.Ord (comparing)
+import Data.Sequences (Index, IsSequence, Textual)
+import Data.Sequences qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector (Vector)
@@ -12,11 +16,12 @@ 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 :: (Hashable t, Textual t, Index t ~ Int) => SegmentStrategy t -> Int -> Int -> t -> Vector (RenderedLine t)
applyStrategy NoSegments width itemIx txt =
- let rawLines = T.splitOn "\n" txt
- chunks = map (T.take width) rawLines -- crop
+ let rawLines = S.splitWhen (=='\n') txt
+ chunks = map (S.take width) rawLines -- crop
offsets = scanOffsetsWithNewlines chunks
in V.fromList
[ RenderedLine { rlText = chunk, rlItemIx = itemIx, rlLineIx = lineIx, rlCharStart = off }
@@ -24,12 +29,12 @@ applyStrategy NoSegments width itemIx txt =
]
applyStrategy FixedWidthSegments width itemIx txt =
- let rawLines = T.splitOn "\n" txt
+ let rawLines = S.splitWhen (=='\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
+ offNext = off0 + O.length line + 1
acc' = acc `DL.append` DL.fromList (zip offsets chunks)
in (acc', offNext)
allChunks = DL.toList dl
@@ -39,14 +44,14 @@ applyStrategy FixedWidthSegments width itemIx txt =
]
applyStrategy (HyphenateSegments lang cache0) width itemIx txt =
- let rawLines = T.splitOn "\n" txt
+ let rawLines = S.splitWhen (=='\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
+ foldl (segmentOneLine lang width) (DL.empty, cache0, 0) rawLines
allChunks = DL.toList dl
in V.fromList
[ RenderedLine { rlText = chunk, rlItemIx = itemIx, rlLineIx = lineIx, rlCharStart = off }
@@ -54,61 +59,65 @@ applyStrategy (HyphenateSegments lang cache0) width itemIx txt =
]
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 =
+ segmentOneLine
+ :: (Hashable t, Textual t, Index t ~ Int)
+ => H.Language
+ -> Int
+ -> (DL.DList (Int, t), HM.HashMap t [(t, t)], Int)
+ -> t
+ -> (DL.DList (Int, t), HM.HashMap t [(t, t)], Int)
+ segmentOneLine lang width (acc, cache, off0) line =
let (chunks, cache1) = segmentWithHyphenationTeXLite lang width line cache
offsets = scanOffsetsFrom off0 chunks
- offNext = off0 + T.length line + 1
+ offNext = off0 + O.length line + 1
acc' = acc `DL.append` DL.fromList (zip offsets chunks)
in (acc', cache1, offNext)
--segmentOneLine (acc, cache, off0) line =
-- let chunks = segmentWithHyphenationTeXLite lang width line
-- offsets = scanOffsetsFrom off0 chunks
- -- offNext = off0 + T.length line + 1 -- +1 for newline
+ -- offNext = off0 + O.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 :: IsSequence t => [t] -> [Int]
scanOffsetsWithNewlines = go 0
where
go !_ [] = []
go !o (l:ls) =
let off = o
- o' = o + T.length l + 1 -- +1 for newline
+ o' = o + O.length l + 1 -- +1 for newline
in off : go o' ls
-- | Chunk a single line into fixed-width pieces.
-chunkFixed :: Int -> Text -> [Text]
+chunkFixed :: (IsSequence t, Index t ~ Int) => Int -> t -> [t]
chunkFixed w t
| w <= 0 = []
- | T.null t = [""]
+ | O.null t = [mempty]
| otherwise =
- let (h, rest) = T.splitAt w t
- in h : if T.null rest then [] else chunkFixed w rest
+ let (h, rest) = S.splitAt w t
+ in h : if O.null rest then [] else chunkFixed w rest
--------------------------------------------------------------------------------
-- Hyphenation-aware segmenting (TeX-lite)
--------------------------------------------------------------------------------
-- Compute offsets starting from a base offset
-scanOffsetsFrom :: Int -> [Text] -> [Int]
+scanOffsetsFrom :: IsSequence t => Int -> [t] -> [Int]
scanOffsetsFrom start = go start
where
go !_ [] = []
- go !o (t:ts) = o : go (o + T.length t) ts
+ go !o (t:ts) = o : go (o + O.length t) ts
segmentWithHyphenationTeXLite
- :: H.Language
+ :: (Hashable t, Textual t, Index t ~ Int)
+ => H.Language
-> Int
- -> Text
- -> HM.HashMap Text [(Text, Text)]
- -> ([Text], HM.HashMap Text [(Text, Text)])
+ -> t
+ -> HM.HashMap t [(t, t)]
+ -> ([t], HM.HashMap t [(t, t)])
segmentWithHyphenationTeXLite lang width txt cache0 =
- go cache0 (T.words txt)
+ go cache0 (S.words txt)
where
go cache [] = ([], cache)
go cache ws =
@@ -124,37 +133,38 @@ segmentWithHyphenationTeXLite lang width txt cache0 =
-- | 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 :: (Textual t, Index t ~ Int) => Int -> [t] -> [t]
breakWordSafe width ws =
- chunk (T.unwords ws)
+ chunk (S.unwords ws)
where
chunk t
- | T.null t = []
- | T.length t <= width = [t]
+ | O.null t = []
+ | O.length t <= width = [t]
| otherwise =
- let (c, r) = T.splitAt width t
+ let (c, r) = S.splitAt width t
in c : chunk r
-type Candidate = (Text, [Text], Bool)
+type Candidate a = (a, [a], Bool)
lineCandidates
- :: H.Language
+ :: (Hashable t, Textual t, Index t ~ Int)
+ => H.Language
-> Int
- -> HM.HashMap Text [(Text, Text)]
- -> [Text]
- -> ([(Text, [Text], Bool)], HM.HashMap Text [(Text, Text)])
+ -> HM.HashMap t [(t, t)]
+ -> [t]
+ -> ([(t, [t], Bool)], HM.HashMap t [(t, t)])
lineCandidates lang width cache0 ws0 =
- go [] [] cache0 ws0
+ go mempty [] 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
+ let space = if O.null line then mempty else S.singleton ' '
+ baseTxt = S.unwords line
wholeTxt = baseTxt <> space <> w
- wholeLen = T.length wholeTxt
+ wholeLen = O.length wholeTxt
acc1 =
- if wholeLen <= width && not (T.null wholeTxt)
+ if wholeLen <= width && not (O.null wholeTxt)
then (wholeTxt, ws, False) : acc
else acc
@@ -162,15 +172,16 @@ lineCandidates lang width cache0 ws0 =
case HM.lookup w cache of
Just hs -> (hs, cache)
Nothing ->
- let hs = hyphenateWord lang w
- in (hs, HM.insert w hs cache)
+ let hs = hyphenateWord lang (T.pack $ S.unpack w)
+ hs' = [ (S.pack $ T.unpack pre, S.pack $ T.unpack suf) | (pre, suf) <- hs ]
+ 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
+ , not (O.null pre)
+ , let preTxt = baseTxt <> space <> pre <> S.singleton '-'
+ , O.length preTxt <= width
]
acc2 = hyphCands ++ acc1
@@ -187,9 +198,9 @@ hyphenateWord lang word =
| i <- [1 .. length parts - 1]
]
-scoreCandidate :: Int -> Candidate -> Int
+scoreCandidate :: IsSequence t => Int -> Candidate t -> Int
scoreCandidate width (line, _, endsWithHyphen) =
- let len = T.length line
+ let len = O.length line
remSpace = max 0 (width - len)
badness = remSpace * remSpace * remSpace
hyphenPenalty =
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-13 12:25:13 +0000