diff options
Diffstat (limited to 'TextViewport.hs')
| -rw-r--r-- | TextViewport.hs | 25 |
1 files changed, 15 insertions, 10 deletions
diff --git a/TextViewport.hs b/TextViewport.hs index ae68668..f39ee84 100644 --- a/TextViewport.hs +++ b/TextViewport.hs @@ -24,6 +24,10 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Text.Hyphenation as H +import qualified Data.Sequence as Seq +import Data.Sequence (Seq) +import qualified Data.Foldable as F + -------------------------------------------------------------------------------- -- Logical model -------------------------------------------------------------------------------- @@ -38,11 +42,11 @@ data Item = Item , itemWrap :: WrapStrategy } -newtype Buffer = Buffer { unBuffer :: [Item] } +newtype Buffer = Buffer { unBuffer :: Seq Item } modifyItem :: Int -> (Item -> Item) -> Buffer -> Buffer modifyItem ix f (Buffer xs) = - Buffer (take ix xs ++ [f (xs !! ix)] ++ drop (ix+1) xs) + Buffer (Seq.adjust' f ix xs) -------------------------------------------------------------------------------- -- Rendering with provenance @@ -55,14 +59,16 @@ data RenderedLine = RenderedLine , rlCharStart :: !Int } deriving (Show) -type RenderedBuffer = [[RenderedLine]] +type RenderedBuffer = Seq [RenderedLine] flatten :: RenderedBuffer -> [RenderedLine] -flatten = concat +flatten = concat . F.toList renderBuffer :: Int -> Buffer -> RenderedBuffer renderBuffer width (Buffer items) = - zipWith (renderItem width) [0..] items + let itemsList = F.toList items + blocks = zipWith (renderItem width) [0..] itemsList + in Seq.fromList blocks renderItem :: Int -> Int -> Item -> [RenderedLine] renderItem width itemIx (Item txt strategy) = @@ -102,7 +108,7 @@ chunkFixed w t in c : go r -------------------------------------------------------------------------------- --- Hyphenation-aware wrapping +-- Hyphenation-aware wrapping (TeX-lite) -------------------------------------------------------------------------------- hyphenateWrapped :: H.Hyphenator -> Int -> Text -> [(Int, Text)] @@ -141,7 +147,6 @@ lineCandidates dict width = go [] [] go line acc (w:ws) = let space = if null line then "" else " " baseTxt = T.unwords line - baseLen = T.length baseTxt + T.length space -- whole word candidate (no hyphen) wholeTxt = baseTxt <> space <> w @@ -184,7 +189,6 @@ scoreCandidate :: Int -> Candidate -> Int scoreCandidate width (line, _, endsWithHyphen) = let len = T.length line remSpace = max 0 (width - len) - -- cubic badness like TeX, scaled down badness = remSpace * remSpace * remSpace hyphenPenalty = if endsWithHyphen then 50 else 0 @@ -198,8 +202,9 @@ scoreCandidate width (line, _, endsWithHyphen) = updateRenderedItem :: Int -> Int -> Buffer -> RenderedBuffer -> RenderedBuffer updateRenderedItem width itemIx (Buffer items) rb = - let newBlock = renderItem width itemIx (items !! itemIx) - in take itemIx rb ++ [newBlock] ++ drop (itemIx+1) rb + let item = Seq.index items itemIx + newBlock = renderItem width itemIx item + in Seq.update itemIx newBlock rb -------------------------------------------------------------------------------- -- Viewport |