summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/TextViewport/Buffer/Buffer.hs35
-rw-r--r--src/TextViewport/Buffer/Item.hs27
-rw-r--r--src/TextViewport/Render/CachedRender.hs15
-rw-r--r--src/TextViewport/Render/RenderBuffer.hs31
-rw-r--r--src/TextViewport/Render/RenderCache.hs28
-rw-r--r--src/TextViewport/Render/RenderItem.hs23
-rw-r--r--src/TextViewport/Render/RenderState.hs132
-rw-r--r--src/TextViewport/Render/RenderedBuffer.hs19
-rw-r--r--src/TextViewport/Render/RenderedItem.hs9
-rw-r--r--src/TextViewport/Render/RenderedLine.hs11
-rw-r--r--src/TextViewport/Render/Segmentation.hs200
-rw-r--r--src/TextViewport/Viewport/Instance.hs76
-rw-r--r--src/TextViewport/Viewport/Position.hs23
-rw-r--r--src/TextViewport/Viewport/Viewport.hs57
14 files changed, 686 insertions, 0 deletions
diff --git a/src/TextViewport/Buffer/Buffer.hs b/src/TextViewport/Buffer/Buffer.hs
new file mode 100644
index 0000000..7b9582f
--- /dev/null
+++ b/src/TextViewport/Buffer/Buffer.hs
@@ -0,0 +1,35 @@
+module TextViewport.Buffer.Buffer where
+
+import Data.Sequence qualified as Seq
+import TextViewport.Buffer.Item (Item)
+
+newtype Buffer = Buffer { unBuffer :: Seq.Seq Item }
+ deriving (Eq, Show)
+
+-- | Build a buffer from a list
+fromList :: [Item] -> Buffer
+fromList xs = Buffer (Seq.fromList xs)
+
+-- | Modify an item at index
+modifyItem :: Int -> (Item -> Item) -> Buffer -> Buffer
+modifyItem ix f (Buffer xs) =
+ Buffer (Seq.adjust' f ix xs)
+
+-- | Insert an item
+insertItem :: Int -> Item -> Buffer -> Buffer
+insertItem ix x (Buffer xs) =
+ Buffer (Seq.insertAt ix x xs)
+
+-- | Delete an item
+deleteItem :: Int -> Buffer -> Buffer
+deleteItem ix (Buffer xs) =
+ Buffer (Seq.deleteAt ix xs)
+
+-- | Append an item
+appendItem :: Item -> Buffer -> Buffer
+appendItem x (Buffer xs) =
+ Buffer (xs Seq.|> x)
+
+-- | Extract underlying Seq (if needed)
+toSeq :: Buffer -> Seq.Seq Item
+toSeq (Buffer xs) = xs
diff --git a/src/TextViewport/Buffer/Item.hs b/src/TextViewport/Buffer/Item.hs
new file mode 100644
index 0000000..b08aaf4
--- /dev/null
+++ b/src/TextViewport/Buffer/Item.hs
@@ -0,0 +1,27 @@
+module TextViewport.Buffer.Item where
+
+import Data.Text (Text)
+import Data.HashMap.Strict qualified as HM
+import Text.Hyphenation qualified as H
+
+
+data Item = Item
+ { itemText :: Text
+ , itemSegments :: SegmentStrategy
+ }
+ deriving (Eq, Show)
+
+data SegmentStrategy
+ = NoSegments
+ | FixedWidthSegments
+ | HyphenateSegments
+ { hsDict :: H.Hyphenator
+ , hsCache :: HM.HashMap Text [(Text, Text)]
+ }
+ deriving (Eq, Show)
+
+instance Show H.Hyphenator where
+ show _ = "<Hyphenator>"
+
+instance Eq H.Hyphenator where
+ a == b = False
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
+
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 }
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-07 12:53:55 +0000