@@ -24,6 +24,7 @@ import Data.Array.ST
24import qualified Data.ByteString as B
24import qualified Data.ByteString as B
25import qualified Data.ByteString.Internal as BInt
25import qualified Data.ByteString.Internal as BInt
26import qualified Data.Foldable as Foldable
26import qualified Data.Foldable as Foldable
27import Data.Word
28import Data.Word
28import qualified Data.ByteString.UTF8 as BSUTF8
29import qualified Data.ByteString.UTF8 as BSUTF8
29import qualified Data.String.UTF8 as UTF8
30import qualified Data.String.UTF8 as UTF8
@@ -110,7 +111,7 @@ build_spans pic region = do
110 -- The ops builder recursively descends the image and outputs span ops that would
111 -- The ops builder recursively descends the image and outputs span ops that would
111 -- display that image. The number of columns remaining in this row before exceeding the
112 -- display that image. The number of columns remaining in this row before exceeding the
112 -- bounds is also provided. This is used to clip the span ops produced.
113 -- 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)
114 -- Fill in any unspecified columns with the background pattern.
115 -- Fill in any unspecified columns with the background pattern.
115 forM_ [0 .. region_height region - 1] $ \row -> do
116 forM_ [0 .. region_height region - 1] $ \row -> do
116 end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns
117 end_x <- readSTArray mrow_ops row >>= return . span_ops_effected_columns
@@ -122,61 +123,105 @@ build_spans pic region = do
123type MRowOps s = STArray s Word SpanOps
124type MRowOps s = STArray s Word SpanOps
125−ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> Word -> Word -> ST s ()
126+ops_for_row :: MRowOps s -> Background -> DisplayRegion -> Image -> (Word, Word) -> Word -> Word -> ST s (Word, Word)
126−ops_for_row mrow_ops bg region image y remaining_columns
127+ops_for_row mrow_ops bg region image skip_dim@(skip_row,skip_col) y remaining_columns
127− | remaining_columns == 0 = return ()
128+ | remaining_columns == 0 = return skip_dim
128− | y >= region_height region = return ()
129+ | y >= region_height region = return skip_dim
129 | otherwise = case image of
130 | otherwise = case image of
130− EmptyImage -> return ()
131+ EmptyImage -> return skip_dim
131 -- The width provided is the number of columns this text span will occupy when displayed.
132 -- The width provided is the number of columns this text span will occupy when displayed.
132 -- if this is greater than the number of remaining columsn the output has to be produced a
133 -- if this is greater than the number of remaining columsn the output has to be produced a
133 -- character at a time.
134 -- character at a time.
134− HorizText a text_str ow cw -> do
135+ HorizText a text_str _ _ -> do
137+ then return (skip_row - 1, skip_col)
135− snoc_text_span a text_str ow cw mrow_ops y remaining_columns
139+ skip_col' <- snoc_text_span a text_str mrow_ops skip_col y remaining_columns
140+ return (skip_row, skip_col')
136 VertJoin t b _ _ -> do
141 VertJoin t b _ _ -> do
137− ops_for_row mrow_ops bg region t y remaining_columns
142+ (skip_row',skip_col') <- ops_for_row mrow_ops bg region t skip_dim y remaining_columns
138− ops_for_row mrow_ops bg region b (y + image_height t) 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'')
139 HorizJoin l r _ _ -> do
145 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
141 -- Don't output the right part unless there is at least a single column left after
147 -- Don't output the right part unless there is at least a single column left after
142 -- outputting the left part.
148 -- outputting the left part.
143− if image_width l < remaining_columns
149+ if image_width l - (skip_col - skip_col') > remaining_columns
150+ then return (skip_row,skip_col')
144− then ops_for_row mrow_ops bg region r y (remaining_columns - image_width l)
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'))
145− else return ()
153+ return (min skip_row' skip_row'', skip_col'')
146 BGFill width height -> do
154 BGFill width height -> do
147− let actual_height = if y + height > region_height region
155+ let min_height = if y + height > region_height region
148− then region_height region - y
156+ then region_height region - y
149− else height
157+ else height
158+ min_width = if width > remaining_columns
159+ then remaining_columns
161+ actual_height = if skip_row > min_height
163+ else min_height - skip_row
150− actual_width = if width > remaining_columns
164+ actual_width = if skip_col > min_width
151− then remaining_columns
165+ then 0
152− else width
166+ else min_width - skip_col
153 forM_ [y .. y + actual_height - 1] $ \y' -> snoc_bg_fill mrow_ops bg actual_width y'
167 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
170+ else skip_row - min_height
171+ skip_col' = if actual_width > skip_col
173+ else skip_col - min_width
174+ return (skip_row',skip_col')
175+ Translation (dx,dy) i -> do
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
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
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
190+ dw = toEnum $ abs dx
191+ dh = toEnum $ abs dy
192+ ow = image_width image
194+ ImageCrop (max_w,max_h) i ->
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)
202+ let vpad = if image_height i < min_h
203+ then background_fill (image_width i) (min_h - image_height i)
205+ ops_for_row mrow_ops bg region ((i <|> hpad) <-> vpad) skip_dim y remaining_columns
156snoc_text_span :: (Foldable.Foldable t)
207snoc_text_span :: (Foldable.Foldable t)
158 -> t Char
209 -> t Char
159− -> Word -- width of text span in output display columns
160− -> Word -- width of text span in characters
161 -> MRowOps s
210 -> MRowOps s
164− -> ST s ()
214+ -> ST s Word
165−snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do
215+snoc_text_span a text_str mrow_ops skip_col y remaining_columns = do
166− if ow > remaining_columns
168− snoc_op mrow_ops y $ AttributeChange a
216+ snoc_op mrow_ops y $ AttributeChange a
169− let (ow', cw', txt) = Foldable.foldl'
217+ let (ow', dw', cw', txt) = Foldable.foldl'
170− build_cropped_txt
218+ build_cropped_txt
171− ( 0, 0, B.empty )
219+ ( 0, 0, 0, B.empty )
172− text_str
220+ text_str
173− snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)
221+ snoc_op mrow_ops y $ TextSpan ow' cw' (UTF8.fromRep txt)
174− else do
222+ return $ skip_col - dw'
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)
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" #-}
180 let w = wcwidth c
225 let w = wcwidth c
181 -- Characters with unknown widths occupy 1 column.
226 -- Characters with unknown widths occupy 1 column.
@@ -185,9 +230,18 @@ snoc_text_span a text_str ow cw mrow_ops y remaining_columns = do
185 -- the character. If so then this replacement process may need to be implemented
230 -- the character. If so then this replacement process may need to be implemented
186 -- manually for consistent behavior across terminals.
231 -- manually for consistent behavior across terminals.
187 w' = toEnum $ if w < 0 then 1 else w
232 w' = toEnum $ if w < 0 then 1 else w
233+ in if dw' == skip_col
234+ then if ow' == remaining_columns
235+ then ( ow', dw', char_count', b0 )
188− in if (w' + ow') > remaining_columns
236+ else if (w' + ow') > remaining_columns
189− then ( ow', char_count', b0 )
237+ then ( remaining_columns, dw', char_count' + ooverflow, B.append b0 $ B.pack $ encode $ genericReplicate ooverflow '…' )
190− else ( ow' + w', char_count' + 1, B.append b0 $ B.pack $ encode [c] )
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 )
243+ doverflow = skip_col - dw'
244+ ooverflow = remaining_columns - ow'
192snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()
246snoc_bg_fill :: MRowOps s -> Background -> Word -> Word -> ST s ()
193snoc_bg_fill _row_ops _bg 0 _row
247snoc_bg_fill _row_ops _bg 0 _row