@@ -19,7 +19,7 @@ import Graphics.Text.Width
1919
2020import Control.Lens
2121import Control.Monad ( forM_ )
22−import Control.Monad.Reader.Strict
22+import Control.Monad.Reader
2323import Control.Monad.State.Strict
2424import Control.Monad.ST.Strict hiding ( unsafeIOToST )
2525import Control.Monad.ST.Unsafe ( unsafeIOToST )
@@ -208,14 +208,32 @@ is_out_of_bounds image s
208208 | s ^. remain_rows <= 0 = True
209209 | otherwise = False
210210
211+add_unclipped :: Image -> BlitM s ()
212+add_unclipped EmptyImage = return ()
213+add_unclipped (HorizText text_str _ow _cw) = do
214+ use row_offset >>= snoc_op (AttributeChange a)
215+ add_unclipped_text text_str
216+add_unclipped (HorizJoin part_left part_right _ow _oh) = do
217+ -- TODO: push into env and use
218+ y <- use row_offset
219+ add_unclipped part_left
220+ row_offset .= y
221+ add_unclipped part_right
222+add_unclipped (VertJoin part_top part_bottom _ow _oh) = do
223+ y <- use row_offset
224+ add_unclipped part_top
225+ row_offset .= y + image_height part_top
226+ add_unclipped part_bottom
227+ -- TODO: assumes background character is 1 column
228+add_unclipped (BGFill ow oh) = do
229+ Background c a <- view bg
230+ let op = TextSpan ow ow (TL.replicate (fromIntegral ow) c)
231+ forM_ [y..y+oh] $ snoc_op op
232+
233+-- TODO: prove this cannot be called in fully clipped case
211234add_maybe_clipped :: Image -> BlitM s ()
212235add_maybe_clipped EmptyImage = return ()
213−-- The width provided is the number of columns this text span will occupy when displayed.
214−-- if this is greater than the number of remaining columsn the output has to be produced a
215−-- character at a time.
216−--
217−-- TODO: prove this cannot be called in fully clipped case
218−add_maybe_clipped (HorizText text_str _ow _cw) =
236+add_maybe_clipped (HorizText text_str ow _cw) = do
219237 use row_offset >>= snoc_op (AttributeChange a)
220238 left_clip <- use skip_columns
221239 right_clip <- use remaining_columns
@@ -223,37 +241,25 @@ add_maybe_clipped (HorizText text_str _ow _cw) =
223241 right_clipped = (ow - left_clip) > right_clip
224242 if left_clipped || right_clipped
225243 then let text_str' = clip_text left_clip right_clip
226− in render_unclipped_text_span text_str'
227− else render_unclipped_text_span text_str
228−process_image (VertJoin top_image bottom_image _ _) = do
229− (skip_row',skip_col') <- row_ops_for_image mrow_ops
230− top_image
231− bg
232− region
233− skip_dim
234− y
235− remaining_columns
236− remain_rows
237− let top_height = (image_height top_image) - (skip_row - skip_row')
238− (skip_row'',skip_col'') <- row_ops_for_image mrow_ops
239− bottom_image
240− bg
241− region
242− (skip_row', skip_col)
243− (y + top_height)
244− remaining_columns
245− (max 0 $ remain_rows - top_height)
246− return (skip_row'', min skip_col' skip_col'')
247− HorizJoin l r _ _ -> do
248− (skip_row',skip_col') <- row_ops_for_image mrow_ops l bg region skip_dim y remaining_columns remain_rows
249− -- Don't output the right part unless there is at least a single column left after
250− -- outputting the left part.
251− if image_width l - (skip_col - skip_col') > remaining_columns
252− then return (skip_row,skip_col')
253− else do
254− (skip_row'',skip_col'') <- row_ops_for_image mrow_ops r bg region (skip_row, skip_col') y (remaining_columns - image_width l + (skip_col - skip_col')) remain_rows
244+ in add_unclipped_text text_str'
245+ else add_unclipped_text text_str
246+add_maybe_clipped (VertJoin top_image bottom_image ow oh) = do
247+ add_maybe_clipped top_image
248+ row_offset += image_height top_image
249+ add_maybe_clipped bottom_image
250+add_maybe_clipped (HorizJoin left_image right_image ow oh) -> do
251+ add_maybe_clipped left_image
252+ add_maybe_clipped right_image
253+
254+ (skip_row',skip_col') <- row_ops_for_image mrow_ops l bg region skip_dim y remaining_columns remain_rows
255+ -- Don't output the right part unless there is at least a single column left after
256+ -- outputting the left part.
257+ if image_width l - (skip_col - skip_col') > remaining_columns
258+ then return (skip_row,skip_col')
259+ else do
260+ (skip_row'',skip_col'') <- row_ops_for_image mrow_ops r bg region (skip_row, skip_col') y (remaining_columns - image_width l + (skip_col - skip_col')) remain_rows
255261 return (min skip_row' skip_row'', skip_col'')
256− BGFill width height -> do
262+add_maybe_clipped (BGFill width height) -> do
257263 let min_height = if y + height > (region_height region)
258264 then region_height region - y
259265 else min height remain_rows
@@ -275,24 +281,27 @@ process_image (VertJoin top_image bottom_image _ _) = do
275281 ImageCrop (max_w,max_h) i ->
276282 row_ops_for_image mrow_ops i bg region skip_dim y (min remaining_columns max_w) (min remain_rows max_h)
277283
278−render_clipped_text_span :: DisplayString -> Int -> Int -> BlitM ()
279−render_clipped_text_span txt left_skip right_clip = do
280− use row_offset >>= snoc_op (AttributeChange a)
281− -- TODO: store a skip list in HorizText
284+-- TODO: store a skip list in HorizText
285+-- TODO: represent display strings containing chars that are not 1 column chars as a separate
286+-- display string value?
287+-- TODO: assumes max column width is 2
288+clip_text :: DisplayString -> Int -> Int -> DisplayString
289+clip_text txt left_skip right_clip =
290+ -- CPS would clarify this I think
282291 let (to_drop,pad_prefix) = clip_for_char_width left_skip txt 0
283− txt' = TL.append (if pad_prefix then TL.singleton '…' else TL.empty) (TL.drop to_drop txt)
292+ txt' = if pad_prefix then TL.cons '…' (TL.drop (to_drop+1) txt) else TL.drop to_drop txt
284293 (to_take,pad_suffix) = clip_for_char_width right_clip txt' 0
285294 txt'' = TL.append (TL.take to_take txt') (if pad_suffix then TL.singleton '…' else TL.empty)
286295 clip_for_char_width 0 _ n = (n, False)
287− clip_for_char_width 1 t n
288− | wcwidth (TL.head t) == 1 = (n+1, False)
289− | otherwise = (n, True)
290− clip_for_char_width lc t n
291− = apply_left_clip (lc - wcwidth (TL.head t)) (TL.rest t) (n + 1)
292− render_unclipped_text_span a txt''
293−
294−render_unclipped_text_span :: DisplayString -> BlitM ()
295−render_unclipped_text_span txt = do
296+ clip_for_char_width w t n
297+ | w < cw = (n, True)
298+ | w == cw = (n+1, False)
299+ | w > cw = clip_for_char_width (w - cw) (TL.rest t) (n + 1)
300+ where cw = safe_wcwidth (TL.head t)
301+ in txt''
302+
303+add_unclipped_text :: DisplayString -> BlitM ()
304+add_unclipped_text txt = do
296305 let op = TextSpan used_display_columns (TL.length txt) (TL.encodeUtf8 txt)
297306 used_display_columns = wcswidth $ TL.unpack txt
298307 use row_offset >>= snoc_op op