@@ -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,61 +123,105 @@ 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
127− | remaining_columns == 0 = return ()
128− | y >= region_height region = return ()
126+ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> (Word, Word) -> Word -> Word -> ST s (Word, Word)
127+ops_for_row mrow_ops bg region image skip_dim@(skip_row,skip_col) y remaining_columns
128+ | remaining_columns == 0 = return skip_dim
129+ | y >= region_height region = return skip_dim
129130 | otherwise = case image of
130− EmptyImage -> return ()
131+ EmptyImage -> return skip_dim
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 skip_row > 0
137+ then return (skip_row - 1, skip_col)
138+ else do
139+ skip_col' <- snoc_text_span a text_str mrow_ops skip_col y remaining_columns
140+ return (skip_row, skip_col')
136141 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
142+ (skip_row',skip_col') <- ops_for_row mrow_ops bg region t skip_dim y remaining_columns
143+ (skip_row'',skip_col'') <- ops_for_row mrow_ops bg region b (skip_row', skip_col) (y + image_height t - (skip_row - skip_row')) remaining_columns
144+ return (skip_row'', min skip_col' skip_col'')
139145 HorizJoin l r _ _ -> do
140− ops_for_row mrow_ops bg region l y remaining_columns
146+ (skip_row',skip_col') <- ops_for_row mrow_ops bg region l skip_dim y remaining_columns
141147 -- Don't output the right part unless there is at least a single column left after
142148 -- outputting the left part.
143− if image_width l < remaining_columns
144− then ops_for_row mrow_ops bg region r y (remaining_columns - image_width l)
145− else return ()
149+ if image_width l - (skip_col - skip_col') > remaining_columns
150+ then return (skip_row,skip_col')
151+ else do
152+ (skip_row'',skip_col'') <- ops_for_row mrow_ops bg region r (skip_row, skip_col') y (remaining_columns - image_width l + (skip_col - skip_col'))
153+ return (min skip_row' skip_row'', skip_col'')
146154 BGFill width height -> do
147− let actual_height = if y + height > region_height region
148− then region_height region - y
149− else height
150− actual_width = if width > remaining_columns
151− then remaining_columns
152− else width
155+ let min_height = if y + height > region_height region
156+ then region_height region - y
157+ else height
158+ min_width = if width > remaining_columns
159+ then remaining_columns
160+ else width
161+ actual_height = if skip_row > min_height
162+ then 0
163+ else min_height - skip_row
164+ actual_width = if skip_col > min_width
165+ then 0
166+ else min_width - skip_col
153167 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
168+ let skip_row' = if actual_height > skip_row
169+ then 0
170+ else skip_row - min_height
171+ skip_col' = if actual_width > skip_col
172+ then 0
173+ else skip_col - min_width
174+ return (skip_row',skip_col')
175+ Translation (dx,dy) i -> do
176+ if dx < 0
177+ -- Translation left
178+ -- Extract the delta and add it to skip_col.
179+ then ops_for_row mrow_ops bg region (translate (0, dy) i) (skip_row, skip_col + dw) y remaining_columns
180+ -- Translation right
181+ else if dy < 0
182+ -- Translation up
183+ -- Extract the delta and add it to skip_row.
184+ then ops_for_row mrow_ops bg region (translate (dx, 0) i) (skip_row + dh, skip_col) y remaining_columns
185+ -- Translation down
186+ -- Pad the start of lines and above the image with a
187+ -- background_fill image.
188+ else ops_for_row mrow_ops bg region (background_fill ow dh <-> (background_fill dw ih <|> i)) skip_dim y remaining_columns
189+ where
190+ dw = toEnum $ abs dx
191+ dh = toEnum $ abs dy
192+ ow = image_width image
193+ ih = image_height i
194+ ImageCrop (max_w,max_h) i ->
195+ if y >= max_h
196+ then return skip_dim
197+ else ops_for_row mrow_ops bg region i skip_dim y (min remaining_columns max_w)
198+ ImagePad (min_w,min_h) i -> do
199+ let hpad = if image_width i < min_w
200+ then background_fill (min_w - image_width i) (image_height i)
201+ else empty_image
202+ let vpad = if image_height i < min_h
203+ then background_fill (image_width i) (min_h - image_height i)
204+ else empty_image
205+ ops_for_row mrow_ops bg region ((i <|> hpad) <-> vpad) skip_dim y remaining_columns
155206
156207snoc_text_span :: (Foldable.Foldable t)
157208 => Attr
158209 -> t Char
159− -> Word -- width of text span in output display columns
160− -> Word -- width of text span in characters
161210 -> MRowOps s
162211 -> Word
163212 -> Word
164− -> 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)
213+ -> Word
214+ -> ST s Word
215+snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do
216+ snoc_op mrow_ops y $ AttributeChange a
217+ let (ow', dw', cw', txt) = Foldable.foldl'
218+ build_cropped_txt
219+ ( 0, 0, 0, B.empty )
220+ text_str
221+ snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)
222+ return $ skip_col - dw'
178223 where
179− build_cropped_txt (ow', char_count', b0) c = {-# SCC "build_cropped_txt" #-}
224+ build_cropped_txt (ow', dw', char_count', b0) c = {-# SCC "build_cropped_txt" #-}
180225 let w = wcwidth c
181226 -- Characters with unknown widths occupy 1 column.
182227 --
@@ -185,9 +230,18 @@ snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do
185230 -- the character. If so then this replacement process may need to be implemented
186231 -- manually for consistent behavior across terminals.
187232 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] )
233+ in if dw' == skip_col
234+ then if ow' == remaining_columns
235+ then ( ow', dw', char_count', b0 )
236+ else if (w' + ow') > remaining_columns
237+ then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )
238+ else ( ow' + w', dw', char_count' + 1, B.append b0 $ B.pack $ encode [c] )
239+ else if (w' + dw') > skip_col
240+ then ( doverflow, skip_col, doverflow, B.append b0 $ B.pack $ encode $ genericReplicate doverflow '…' )
241+ else ( ow', w' + dw', char_count', b0 )
242+ where
243+ doverflow = skip_col - dw'
244+ ooverflow = remaining_columns - ow'
191245
192246snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()
193247snoc_bg_fill _row_ops _bg 0 _row