summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/TextViewport/Buffer/Buffer.hs14
-rw-r--r--src/TextViewport/Buffer/Item.hs17
-rw-r--r--src/TextViewport/Render/CachedRender.hs5
-rw-r--r--src/TextViewport/Render/RenderBuffer.hs6
-rw-r--r--src/TextViewport/Render/RenderCache.hs8
-rw-r--r--src/TextViewport/Render/RenderItem.hs9
-rw-r--r--src/TextViewport/Render/RenderState.hs28
-rw-r--r--src/TextViewport/Render/Segmentation.hs22
-rw-r--r--src/TextViewport/Viewport/Instance.hs33
-rw-r--r--src/TextViewport/Viewport/Viewport.hs6
10 files changed, 80 insertions, 68 deletions
diff --git a/src/TextViewport/Buffer/Buffer.hs b/src/TextViewport/Buffer/Buffer.hs
index 62ce232..53eb103 100644
--- a/src/TextViewport/Buffer/Buffer.hs
+++ b/src/TextViewport/Buffer/Buffer.hs
@@ -3,33 +3,33 @@ module TextViewport.Buffer.Buffer where
import Data.Sequence qualified as Seq
import TextViewport.Buffer.Item (Item)
-newtype Buffer a = Buffer { unBuffer :: Seq.Seq (Item a) }
+newtype Buffer a seg = Buffer { unBuffer :: Seq.Seq (Item a seg) }
deriving (Eq, Show)
-- | Build a buffer from a list
-fromList :: [Item a] -> Buffer a
+fromList :: [Item a seg] -> Buffer a seg
fromList xs = Buffer (Seq.fromList xs)
-- | Modify an item at index
-modifyItem :: Int -> (Item a -> Item a) -> Buffer a -> Buffer a
+modifyItem :: Int -> (Item a seg -> Item a seg) -> Buffer a seg -> Buffer a seg
modifyItem ix f (Buffer xs) =
Buffer (Seq.adjust' f ix xs)
-- | Insert an item
-insertItem :: Int -> Item a -> Buffer a -> Buffer a
+insertItem :: Int -> Item a seg -> Buffer a seg -> Buffer a seg
insertItem ix x (Buffer xs) =
Buffer (Seq.insertAt ix x xs)
-- | Delete an item
-deleteItem :: Int -> Buffer a -> Buffer a
+deleteItem :: Int -> Buffer a seg -> Buffer a seg
deleteItem ix (Buffer xs) =
Buffer (Seq.deleteAt ix xs)
-- | Append an item
-appendItem :: Item a -> Buffer a -> Buffer a
+appendItem :: Item a seg -> Buffer a seg -> Buffer a seg
appendItem x (Buffer xs) =
Buffer (xs Seq.|> x)
-- | Extract underlying Seq (if needed)
-toSeq :: Buffer a -> Seq.Seq (Item a)
+toSeq :: Buffer a seg -> Seq.Seq (Item a seg)
toSeq (Buffer xs) = xs
diff --git a/src/TextViewport/Buffer/Item.hs b/src/TextViewport/Buffer/Item.hs
index b5ea743..00edf7b 100644
--- a/src/TextViewport/Buffer/Item.hs
+++ b/src/TextViewport/Buffer/Item.hs
@@ -1,21 +1,8 @@
module TextViewport.Buffer.Item where
-import Data.Text (Text)
-import Data.HashMap.Strict qualified as HM
-import Text.Hyphenation qualified as H
-
-data Item a = Item
+data Item a seg = Item
{ itemText :: a
- , itemSegments :: SegmentStrategy a
+ , itemSegments :: seg
}
deriving (Eq, Show)
-
-data SegmentStrategy a
- = NoSegments
- | FixedWidthSegments
- | HyphenateSegments
- { hsLang :: H.Language
- , hsCache :: HM.HashMap a [(a, a)]
- }
- deriving (Eq, Show)
diff --git a/src/TextViewport/Render/CachedRender.hs b/src/TextViewport/Render/CachedRender.hs
index b5af8d4..48be1eb 100644
--- a/src/TextViewport/Render/CachedRender.hs
+++ b/src/TextViewport/Render/CachedRender.hs
@@ -1,12 +1,11 @@
module TextViewport.Render.CachedRender where
-import TextViewport.Buffer.Item (SegmentStrategy)
import TextViewport.Render.RenderedItem (RenderedItem)
-data CachedRender a = CachedRender
+data CachedRender a seg = CachedRender
{ crWidth :: !Int
- , crStrategy :: !(SegmentStrategy a)
+ , crStrategy :: !seg
, crText :: !a
, crRendered :: !(RenderedItem a)
}
diff --git a/src/TextViewport/Render/RenderBuffer.hs b/src/TextViewport/Render/RenderBuffer.hs
index fb782f5..b6378ef 100644
--- a/src/TextViewport/Render/RenderBuffer.hs
+++ b/src/TextViewport/Render/RenderBuffer.hs
@@ -8,8 +8,10 @@ import TextViewport.Render.CachedRender
import TextViewport.Render.RenderCache
import TextViewport.Render.RenderItem (renderItem)
import TextViewport.Render.RenderedBuffer
+import TextViewport.Render.Segmentation (Segmenter)
-renderBuffer :: (Hashable t, Textual t, Index t ~ Int) => Int -> Buffer t -> RenderCache t -> (RenderCache t, RenderedBuffer t)
+
+renderBuffer :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a seg -> RenderCache a seg -> (RenderCache a seg, RenderedBuffer a)
renderBuffer width (Buffer items) (RenderCache cache) =
let n = Seq.length items
go i (cAcc, rAcc)
@@ -23,7 +25,7 @@ renderBuffer width (Buffer items) (RenderCache cache) =
in go (i + 1) (cAcc', rAcc')
in go 0 (cache, Seq.empty)
-updateRenderedItem :: (Hashable t, Textual t, Index t ~ Int) => Int -> Int -> Buffer t -> RenderCache t -> RenderedBuffer t -> (RenderCache t, RenderedBuffer t)
+updateRenderedItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a seg -> RenderCache a seg -> RenderedBuffer a -> (RenderCache a seg, RenderedBuffer a)
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 dcd65e0..29cd6fc 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 a = RenderCache { unRenderCache :: Seq (Maybe (CachedRender a)) }
+newtype RenderCache a seg = RenderCache { unRenderCache :: Seq (Maybe (CachedRender a seg)) }
deriving (Eq, Show)
-- | Create an empty cache matching the buffer size
-emptyRenderCacheFor :: Buffer a -> RenderCache a
+emptyRenderCacheFor :: Buffer a seg -> RenderCache a seg
emptyRenderCacheFor (Buffer xs) =
RenderCache (Seq.replicate (Seq.length xs) Nothing)
-- | Resize cache to match buffer length
-resizeCache :: Buffer a -> RenderCache a -> RenderCache a
+resizeCache :: Buffer a seg -> RenderCache a seg -> RenderCache a seg
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 a -> Int
+length :: RenderCache a seg -> Int
length (RenderCache xs) = Seq.length xs
diff --git a/src/TextViewport/Render/RenderItem.hs b/src/TextViewport/Render/RenderItem.hs
index 7e00cf1..0cddb83 100644
--- a/src/TextViewport/Render/RenderItem.hs
+++ b/src/TextViewport/Render/RenderItem.hs
@@ -5,10 +5,13 @@ import Data.Sequences (Index, Textual)
import TextViewport.Buffer.Item (Item(..))
import TextViewport.Render.CachedRender
import TextViewport.Render.RenderedItem
-import TextViewport.Render.Segmentation (applyStrategy)
+import TextViewport.Render.Segmentation (Segmenter(applySeg))
-renderItem :: (Hashable t, Textual t, Index t ~ Int) => Int -> Int -> Item t -> Maybe (CachedRender t) -> CachedRender t
+renderItem
+ :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int)
+ => Int -> Int -> Item a seg -> Maybe (CachedRender a seg)
+ -> CachedRender a seg
renderItem width itemIx (Item txt strategy) mOld =
case mOld of
Just old
@@ -16,7 +19,7 @@ renderItem width itemIx (Item txt strategy) mOld =
, crText old == txt
-> old
_ ->
- let linesV = applyStrategy strategy width itemIx txt
+ let linesV = applySeg strategy width itemIx txt
rendered = RenderedItem linesV
in CachedRender
{ crWidth = width
diff --git a/src/TextViewport/Render/RenderState.hs b/src/TextViewport/Render/RenderState.hs
index 8c0cdef..978ec31 100644
--- a/src/TextViewport/Render/RenderState.hs
+++ b/src/TextViewport/Render/RenderState.hs
@@ -11,16 +11,18 @@ 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
+import TextViewport.Render.Segmentation (Segmenter)
-data RenderState a = RenderState
- { rsBuffer :: Buffer a -- original items
- , rsCache :: RenderCache a -- per-item cached renders
+
+data RenderState a seg = RenderState
+ { rsBuffer :: Buffer a seg -- original items
+ , rsCache :: RenderCache a seg -- per-item cached renders
, rsRendered :: RenderedBuffer a -- fully segmented + hyphenated lines
, rsWidth :: Int -- segmenting width
, rsLineCount :: Int
} deriving (Eq, Show)
-mkRenderState :: (Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a -> RenderState a
+mkRenderState :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a seg -> RenderState a seg
mkRenderState width buf =
let (cache1, rendered) = renderBuffer width buf (emptyRenderCacheFor buf)
in RenderState
@@ -32,7 +34,7 @@ mkRenderState width buf =
}
-- RenderState has to be rebuilt whenever the buffer or the width changes.
-updateRenderState :: (Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a -> RenderState a -> RenderState a
+updateRenderState :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Buffer a seg -> RenderState a seg -> RenderState a seg
updateRenderState width buf rs =
let (cache1, rendered) = renderBuffer width buf (rsCache rs)
in rs
@@ -43,7 +45,7 @@ updateRenderState width buf rs =
, rsLineCount = length (RenderedBuffer.flatten rendered)
}
-modifyItemRS :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> RenderState a -> RenderState a
+modifyItemRS :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> (Item a seg -> Item a seg) -> RenderState a seg -> RenderState a seg
modifyItemRS ix f st =
let buf' = Buffer.modifyItem ix f (rsBuffer st)
cache' = resizeCache buf' (rsCache st)
@@ -54,7 +56,7 @@ modifyItemRS ix f st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-insertItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> Item a -> RenderState a -> RenderState a
+insertItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Item a seg -> RenderState a seg -> RenderState a seg
insertItem i newItem st =
let Buffer items = rsBuffer st
items' = Seq.insertAt i newItem items
@@ -67,7 +69,7 @@ insertItem i newItem st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-deleteItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> RenderState a -> RenderState a
+deleteItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> RenderState a seg -> RenderState a seg
deleteItem i st =
let Buffer items = rsBuffer st
items' = Seq.deleteAt i items
@@ -80,7 +82,7 @@ deleteItem i st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-replaceItem :: (Hashable a, Textual a, Index a ~ Int) => Int -> Item a -> RenderState a -> RenderState a
+replaceItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Item a seg -> RenderState a seg -> RenderState a seg
replaceItem i newItem st =
let Buffer items = rsBuffer st
items' = Seq.update i newItem items
@@ -93,11 +95,11 @@ replaceItem i newItem st =
, rsLineCount = length (RenderedBuffer.flatten rendered1)
}
-appendItem :: (Hashable a, Textual a, Index a ~ Int) => Item a -> RenderState a -> RenderState a
+appendItem :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Item a seg -> RenderState a seg -> RenderState a seg
appendItem newItem st =
insertItem (Seq.length (let Buffer xs = rsBuffer st in xs)) newItem st
-clearBuffer :: RenderState a -> RenderState a
+clearBuffer :: RenderState a seg -> RenderState a seg
clearBuffer st =
let buf' = Buffer Seq.empty
cache' = RenderCache Seq.empty
@@ -107,7 +109,7 @@ clearBuffer st =
, rsLineCount = 0
}
-fromList :: (Hashable a, Textual a, Index a ~ Int) => Int -> [Item a] -> RenderState a
+fromList :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> [Item a seg] -> RenderState a seg
fromList width xs =
let buf = Buffer (Seq.fromList xs)
cache0 = RenderCache (Seq.replicate (length xs) Nothing)
@@ -120,7 +122,7 @@ fromList width xs =
, rsLineCount = length (RenderedBuffer.flatten rendered)
}
-fromSeq :: (Hashable a, Textual a, Index a ~ Int) => Int -> Seq (Item a) -> RenderState a
+fromSeq :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Seq (Item a seg) -> RenderState a seg
fromSeq width items =
let buf = Buffer items
cache0 = RenderCache (Seq.replicate (Seq.length items) Nothing)
diff --git a/src/TextViewport/Render/Segmentation.hs b/src/TextViewport/Render/Segmentation.hs
index 3d64748..2ec530a 100644
--- a/src/TextViewport/Render/Segmentation.hs
+++ b/src/TextViewport/Render/Segmentation.hs
@@ -13,11 +13,29 @@ 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 :: (Hashable t, Textual t, Index t ~ Int) => SegmentStrategy t -> Int -> Int -> t -> Vector (RenderedLine t)
+-- | User-pluggable segmentation interface
+class Segmenter seg a where
+ applySeg :: seg -> Int -> Int -> a -> Vector (RenderedLine a)
+
+-- | Built-in segmentation strategies (backwards compatible)
+data BuiltinSeg a
+ = NoSegments
+ | FixedWidthSegments
+ | HyphenateSegments
+ { hsLang :: H.Language
+ , hsCache :: HM.HashMap a [(a, a)]
+ }
+ deriving (Eq, Show)
+
+-- | Built-in instance
+instance (Hashable a, Textual a, Index a ~ Int) => Segmenter (BuiltinSeg a) a where
+ applySeg = applyStrategy
+
+
+applyStrategy :: (Hashable a, Textual a, Index a ~ Int) => BuiltinSeg a -> Int -> Int -> a -> Vector (RenderedLine a)
applyStrategy NoSegments width itemIx txt =
let rawLines = S.splitWhen (=='\n') txt
diff --git a/src/TextViewport/Viewport/Instance.hs b/src/TextViewport/Viewport/Instance.hs
index c3ce338..e1cc560 100644
--- a/src/TextViewport/Viewport/Instance.hs
+++ b/src/TextViewport/Viewport/Instance.hs
@@ -9,69 +9,70 @@ 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.Render.Segmentation (Segmenter)
import TextViewport.Viewport.Position (lookupPosition)
import TextViewport.Viewport.Viewport (Viewport, clampViewport, mkViewport)
import TextViewport.Viewport.Viewport qualified as Viewport
-data Instance a = Instance
- { viRender :: RenderState a
+data Instance a seg = Instance
+ { viRender :: RenderState a seg
, viView :: Viewport
} deriving (Show)
-mkInstance :: (Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a -> Instance a
+mkInstance :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> Int -> Buffer a seg -> Instance a seg
mkInstance width height buf =
let rs = mkRenderState width buf
vp = mkViewport width height rs
in Instance rs vp
-visibleLines :: Instance a -> [RenderedLine a]
+visibleLines :: Instance a seg -> [RenderedLine a]
visibleLines (Instance rs vp) =
take (Viewport.vpHeight vp) . drop (Viewport.vpOffset vp) . RenderedBuffer.flatten $ RenderState.rsRendered rs
-applyToInstance :: (Viewport -> Viewport) -> Instance a -> Instance a
+applyToInstance :: (Viewport -> Viewport) -> Instance a seg -> Instance a seg
applyToInstance f (Instance rs vp) =
let vp' = f vp
in Instance rs (clampViewport rs vp')
-applyToInstanceRS :: (RenderState a -> Viewport -> Viewport) -> Instance a -> Instance a
+applyToInstanceRS :: (RenderState a seg -> Viewport -> Viewport) -> Instance a seg -> Instance a seg
applyToInstanceRS f (Instance rs vp) =
let vp' = f rs vp
in Instance rs (clampViewport rs vp')
-scrollByI :: Int -> Instance a -> Instance a
+scrollByI :: Int -> Instance a seg -> Instance a seg
scrollByI delta = applyToInstance (Viewport.scrollBy delta)
-scrollUpI :: Int -> Instance a -> Instance a
+scrollUpI :: Int -> Instance a seg -> Instance a seg
scrollUpI delta = applyToInstance (Viewport.scrollUp delta)
-scrollDownI :: Int -> Instance a -> Instance a
+scrollDownI :: Int -> Instance a seg -> Instance a seg
scrollDownI delta = applyToInstance (Viewport.scrollDown delta)
-pageUpI :: Instance a -> Instance a
+pageUpI :: Instance a seg -> Instance a seg
pageUpI = applyToInstance Viewport.pageUp
-pageDownI :: Instance a -> Instance a
+pageDownI :: Instance a seg -> Instance a seg
pageDownI = applyToInstance Viewport.pageDown
-alignTopI :: Instance a -> Instance a
+alignTopI :: Instance a seg -> Instance a seg
alignTopI = applyToInstance Viewport.alignTop
-alignBottomI :: Instance a -> Instance a
+alignBottomI :: Instance a seg -> Instance a seg
alignBottomI = applyToInstanceRS Viewport.alignBottom
-modifyItemI :: (Hashable a, Textual a, Index a ~ Int) => Int -> (Item a -> Item a) -> Instance a -> Instance a
+modifyItemI :: (Segmenter seg a, Hashable a, Textual a, Index a ~ Int) => Int -> (Item a seg -> Item a seg) -> Instance a seg -> Instance a seg
modifyItemI ix f (Instance rs vp) =
let buf' = Buffer.modifyItem ix f (RenderState.rsBuffer rs)
rs' = mkRenderState (RenderState.rsWidth rs) buf'
vp' = clampViewport rs' vp
in Instance rs' vp'
-lookupPositionI :: Int -> Int -> Instance a -> Maybe (Int, Int)
+lookupPositionI :: Int -> Int -> Instance a seg -> Maybe (Int, Int)
lookupPositionI x y (Instance rs vp) =
lookupPosition x y vp (RenderState.rsRendered rs)
---debugVI :: Instance a -> IO ()
+--debugVI :: Instance a seg -> IO ()
--debugVI (Instance rs vp) = do
-- putStrLn ("offset = " ++ show (Viewport.vpOffset vp))
-- putStrLn ("height = " ++ show (Viewport.vpHeight vp))
diff --git a/src/TextViewport/Viewport/Viewport.hs b/src/TextViewport/Viewport/Viewport.hs
index 65f48e4..36392c7 100644
--- a/src/TextViewport/Viewport/Viewport.hs
+++ b/src/TextViewport/Viewport/Viewport.hs
@@ -10,7 +10,7 @@ data Viewport = Viewport
, vpOffset :: !Int
} deriving (Show)
-mkViewport :: Int -> Int -> RenderState a -> Viewport
+mkViewport :: Int -> Int -> RenderState a seg -> Viewport
mkViewport width height rs =
alignBottom rs Viewport
{ vpWidth = width
@@ -19,7 +19,7 @@ mkViewport width height rs =
}
-- any function that sets vpOffset and can overshoot should use clampViewport
-clampViewport :: RenderState a -> Viewport -> Viewport
+clampViewport :: RenderState a seg -> Viewport -> Viewport
clampViewport rs vp =
let total = RenderState.rsLineCount rs
maxOff = max 0 (total - vpHeight vp)
@@ -48,7 +48,7 @@ alignTop :: Viewport -> Viewport
alignTop vp =
vp { vpOffset = 0 }
-alignBottom :: RenderState a -> Viewport -> Viewport
+alignBottom :: RenderState a seg -> Viewport -> Viewport
alignBottom rs vp =
let total = RenderState.rsLineCount rs
off = max 0 (total - vpHeight vp)
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-13 12:04:05 +0000