1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
{-# LANGUAGE OverloadedStrings #-}
module TextViewport
( Item(..)
, Buffer(..)
, WrapMode(..)
, Viewport(..)
, RenderedLine(..)
, renderBuffer
, defaultViewport
, scrollUp
, scrollDown
, visibleLines
, lookupPosition
) where
import Data.Text (Text)
import qualified Data.Text as T
--------------------------------------------------------------------------------
-- Logical model
--------------------------------------------------------------------------------
newtype Item = Item { unItem :: Text }
newtype Buffer = Buffer { unBuffer :: [Item] }
--------------------------------------------------------------------------------
-- Rendering
--------------------------------------------------------------------------------
-- | Rendering mode: either truncate long lines or wrap them.
data WrapMode
= NoWrap -- ^ Hard truncation at viewport width.
| Wrap -- ^ Soft line breaks inserted at viewport width.
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) =
concat $ zipWith renderItem [0..] items
where
renderItem :: Int -> Item -> [RenderedLine]
renderItem itemIx (Item t) =
concat $ zipWith (renderLogicalLine itemIx) [0..] (T.splitOn "\n" t)
renderLogicalLine :: Int -> Int -> Text -> [RenderedLine]
renderLogicalLine itemIx lineIx txt =
case mode of
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.
wrapText :: Int -> Text -> [Text]
wrapText w t
| T.null t = [""]
| otherwise = go t
where
go s
| T.null s = []
| otherwise =
let (chunk, rest) = T.splitAt w s
in chunk : go rest
--------------------------------------------------------------------------------
-- Viewport
--------------------------------------------------------------------------------
data Viewport = Viewport
{ vpWidth :: !Int
, vpHeight :: !Int
, vpOffset :: !Int
} deriving (Eq, Show)
defaultViewport :: Int -> Int -> [RenderedLine] -> Viewport
defaultViewport w h rendered =
let total = length rendered
off = max 0 (total - h)
in Viewport w h off
scrollUp :: Int -> Viewport -> Viewport
scrollUp k vp =
vp { vpOffset = max 0 (vpOffset vp - k) }
scrollDown :: Int -> [RenderedLine] -> Viewport -> Viewport
scrollDown k rendered vp =
let total = length rendered
maxOff = max 0 (total - vpHeight vp)
newOff = min maxOff (vpOffset vp + k)
in vp { vpOffset = newOff }
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
|
