diff options
| -rw-r--r-- | TextViewport.hs | 84 |
1 files changed, 75 insertions, 9 deletions
diff --git a/TextViewport.hs b/TextViewport.hs index ea075f4..e5322c9 100644 --- a/TextViewport.hs +++ b/TextViewport.hs @@ -11,6 +11,7 @@ module TextViewport , scrollUp , scrollDown , visibleLines + , lookupPosition ) where import Data.Text (Text) @@ -33,23 +34,58 @@ data WrapMode | Wrap -- ^ Soft line breaks inserted at viewport width. deriving (Eq, Show) -newtype RenderedLine = RenderedLine { unRenderedLine :: Text } - deriving (Eq, Show) +-- | A physical line with provenance. +data RenderedLine = RenderedLine + { rlText :: !Text + , rlItemIx :: !Int -- ^ index of the item in the Buffer + , rlLineIx :: !Int -- ^ index of the logical line within the item + , rlCharStart :: !Int -- ^ starting character offset within the logical line + } deriving (Eq, Show) -- | Render the buffer into a flat list of physical lines. -- Wrapping expands logical lines; truncation keeps one line per logical line. renderBuffer :: WrapMode -> Int -> Buffer -> [RenderedLine] renderBuffer mode w (Buffer items) = - concatMap renderItem items + concat $ zipWith renderItem [0..] items where - renderItem (Item t) = - concatMap renderLogicalLine (T.splitOn "\n" t) + renderItem :: Int -> Item -> [RenderedLine] + renderItem itemIx (Item t) = + concat $ zipWith (renderLogicalLine itemIx) [0..] (T.splitOn "\n" t) - renderLogicalLine :: Text -> [RenderedLine] - renderLogicalLine line = + renderLogicalLine :: Int -> Int -> Text -> [RenderedLine] + renderLogicalLine itemIx lineIx txt = case mode of - NoWrap -> [RenderedLine (T.take w line)] - Wrap -> map RenderedLine (wrapText w line) + NoWrap -> + [ RenderedLine + { rlText = T.take w txt + , rlItemIx = itemIx + , rlLineIx = lineIx + , rlCharStart = 0 + } + ] + + Wrap -> + let chunks = chunk w txt + in zipWith mkChunk [0, w ..] chunks + where + mkChunk off chunkTxt = + RenderedLine + { rlText = chunkTxt + , rlItemIx = itemIx + , rlLineIx = lineIx + , rlCharStart = off + } + + chunk :: Int -> Text -> [Text] + chunk width s + | T.null s = [""] + | otherwise = go s + where + go t + | T.null t = [] + | otherwise = + let (c, r) = T.splitAt width t + in c : go r -- | Split a line into chunks of at most width characters. -- This is soft wrapping: no hyphenation, no word-boundary logic. @@ -94,3 +130,33 @@ scrollDown k rendered vp = visibleLines :: [RenderedLine] -> Viewport -> [RenderedLine] visibleLines rendered vp = take (vpHeight vp) . drop (vpOffset vp) $ rendered + + +-------------------------------------------------------------------------------- +-- Lookup +-------------------------------------------------------------------------------- + +-- | Given viewport coordinates (x,y), return: +-- (item index, character offset within that item), if visible. +lookupPosition + :: Int -- ^ x coordinate in viewport + -> Int -- ^ y coordinate in viewport + -> Viewport + -> [RenderedLine] + -> Maybe (Int, Int) -- ^ (itemIx, charOffsetInItem) +lookupPosition x y vp rendered = do + let lineIx = vpOffset vp + y + rl <- renderedAt lineIx rendered + let charInLogical = rlCharStart rl + x + pure (rlItemIx rl, charInLogical) + where + renderedAt ix rs + | ix < 0 || ix >= length rs = Nothing + | otherwise = Just (rs !! ix) + +-- | Convert (lineIx, charOffset) into a single absolute offset inside the item. +absoluteCharOffset :: Item -> Int -> Int -> Int +absoluteCharOffset (Item t) lineIx charOff = + let ls = T.splitOn "\n" t + prefix = sum (map T.length (take lineIx ls)) + lineIx -- +lineIx for '\n' + in prefix + charOff |