@@ -24,6 +24,7 @@ import Data.Array.ST
2424import qualified Data.ByteString as B
2525import qualified Data.ByteString.Internal as BInt
2626import qualified Data.Foldable as Foldable
27+import Data.List
2728import Data.Word
2829import qualified Data.ByteString.UTF8 as BSUTF8
2930import qualified Data.String.UTF8 as UTF8
@@ -110,7 +111,7 @@ build_spans pic region = do
110111 -- The ops builder recursively descends the image and outputs span ops that would
111112 -- display that image. The number of columns remaining in this row before exceeding the
112113 -- bounds is also provided. This is used to clip the span ops produced.
113− ops_for_row mrow_ops (pic_background pic) region (pic_image pic) 0 (region_width region)
114+ ops_for_row mrow_ops (pic_background pic) region (pic_image pic) 0 0 0 (region_width region)
114115 -- Fill in any unspecified columns with the background pattern.
115116 forM_ [0 .. region_height region - 1] $ \row -> do
116117 end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns
@@ -122,8 +123,8 @@ build_spans pic region = do
122123
123124type MRowOps s = STArray s Word SpanOps
124125
125−ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> Word -> Word -> ST s ()
126−ops_for_row mrow_ops bg region image y remaining_columns
126+ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> Word -> Word -> Word -> Word -> ST s ()
127+ops_for_row mrow_ops bg region image skip_row skip_col y remaining_columns
127128 | remaining_columns == 0 = return ()
128129 | y >= region_height region = return ()
129130 | otherwise = case image of
@@ -131,17 +132,19 @@ ops_for_row mrow_ops bg region image y remaining_columns
131132 -- The width provided is the number of columns this text span will occupy when displayed.
132133 -- if this is greater than the number of remaining columsn the output has to be produced a
133134 -- character at a time.
134− HorizText a text_str ow cw -> do
135− snoc_text_span a text_str ow cw mrow_ops y remaining_columns
135+ HorizText a text_str _ _ -> do
136+ if y < skip_row
137+ then return ()
138+ else snoc_text_span a text_str mrow_ops skip_col y remaining_columns
136139 VertJoin t b _ _ -> do
137− ops_for_row mrow_ops bg region t y remaining_columns
138− ops_for_row mrow_ops bg region b (y + image_height t) remaining_columns
140+ ops_for_row mrow_ops bg region t skip_row skip_col y remaining_columns
141+ ops_for_row mrow_ops bg region b skip_row skip_col (y + image_height t) remaining_columns
139142 HorizJoin l r _ _ -> do
140− ops_for_row mrow_ops bg region l y remaining_columns
143+ ops_for_row mrow_ops bg region l skip_row skip_col y remaining_columns
141144 -- Don't output the right part unless there is at least a single column left after
142145 -- outputting the left part.
143146 if image_width l < remaining_columns
144− then ops_for_row mrow_ops bg region r y (remaining_columns - image_width l)
147+ then ops_for_row mrow_ops bg region r skip_row skip_col y (remaining_columns - image_width l)
145148 else return ()
146149 BGFill width height -> do
147150 let actual_height = if y + height > region_height region
@@ -150,33 +153,45 @@ ops_for_row mrow_ops bg region image y remaining_columns
150153 actual_width = if width > remaining_columns
151154 then remaining_columns
152155 else width
156+ -- XXX: Do we need to notify this of skip_rows or skip_cols?
153157 forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'
154− Translation _offset i -> ops_for_row mrow_ops bg region i y remaining_columns
158+ Translation (dx,dy) i ->
159+ if dx < 0
160+ -- Translation left
161+ -- Extract the delta and add it to skip_col.
162+ then ops_for_row mrow_ops bg region (translate (0, dy) i) skip_row (skip_col + dw) y remaining_columns
163+ -- Translation right
164+ else if dy < 0
165+ -- Translation up
166+ -- Extract the delta and add it to skip_row.
167+ then ops_for_row mrow_ops bg region (translate (dx, 0) i) (skip_row + dh) skip_col y remaining_columns
168+ -- Translation down
169+ -- Pad the start of lines and above the image with a
170+ -- background_fill image.
171+ else ops_for_row mrow_ops bg region (background_fill ow dh <-> (background_fill dw ih <|> i)) skip_row skip_col y remaining_columns
172+ where
173+ dw = toEnum $ abs dx
174+ dh = toEnum $ abs dy
175+ ow = image_width image
176+ ih = image_height i
155177
156178snoc_text_span :: (Foldable.Foldable t)
157179 => Attr
158180 -> t Char
159− -> Word -- width of text span in output display columns
160− -> Word -- width of text span in characters
161181 -> MRowOps s
162182 -> Word
163183 -> Word
184+ -> Word
164185 -> ST s ()
165−snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do
166− if ow > remaining_columns
167− then do
168− snoc_op mrow_ops y $ AttributeChange a
169− let (ow', cw', txt) = Foldable.foldl'
170− build_cropped_txt
171− ( 0, 0, B.empty )
172− text_str
173− snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)
174− else do
175− snoc_op mrow_ops y $ AttributeChange a
176− let utf8_bs = ({-# SCC "BSUTF8.fromString" #-} BSUTF8.fromString) $ Foldable.foldMap (\c -> [c]) text_str
177− snoc_op mrow_ops y $ TextSpan ow cw (UTF8.fromRep utf8_bs)
186+snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do
187+ snoc_op mrow_ops y $ AttributeChange a
188+ let (ow', _, cw', txt) = Foldable.foldl'
189+ build_cropped_txt
190+ ( 0, 0, 0, B.empty )
191+ text_str
192+ snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)
178193 where
179− build_cropped_txt (ow', char_count', b0) c = {-# SCC "build_cropped_txt" #-}
194+ build_cropped_txt (ow', dw', char_count', b0) c = {-# SCC "build_cropped_txt" #-}
180195 let w = wcwidth c
181196 -- Characters with unknown widths occupy 1 column.
182197 --
@@ -185,9 +200,18 @@ snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do
185200 -- the character. If so then this replacement process may need to be implemented
186201 -- manually for consistent behavior across terminals.
187202 w' = toEnum $ if w < 0 then 1 else w
188− in if (w' + ow') > remaining_columns
189− then ( ow', char_count', b0 )
190− else ( ow' + w', char_count' + 1, B.append b0 $ B.pack $ encode [c] )
203+ in if dw' == skip_col
204+ then if ow' == remaining_columns
205+ then ( ow', dw', char_count', b0 )
206+ else if (w' + ow') > remaining_columns
207+ then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )
208+ else ( ow' + w', dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )
209+ else if (w' + dw') > skip_col
210+ then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )
211+ else ( ow', w' + dw', char_count', b0 )
212+ where
213+ doverflow = skip_col - dw'
214+ ooverflow = remaining_columns - ow'
191215
192216snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()
193217snoc_bg_fill _row_ops _bg 0 _row