26663ac · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

more progress on the new span renderer

26663acCorey O'Connor13 years ago

src/Graphics/Vty/Span.hs+60−51

compare with master

unifiedsplit

@@ -19,7 +19,7 @@ import Graphics.Text.Width

20import Control.Lens

21import Control.Monad ( forM_ )

22−import Control.Monad.Reader.Strict

22+import Control.Monad.Reader

23import Control.Monad.State.Strict

24import Control.Monad.ST.Strict hiding ( unsafeIOToST )

25import Control.Monad.ST.Unsafe ( unsafeIOToST )

@@ -208,14 +208,32 @@ is_out_of_bounds image s

208 | s ^. remain_rows <= 0 = True

209 | otherwise = False

210

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

211add_maybe_clipped :: Image -> BlitM s ()

234add_maybe_clipped :: Image -> BlitM s ()

212add_maybe_clipped EmptyImage = return ()

235add_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

219 use row_offset >>= snoc_op (AttributeChange a)

237 use row_offset >>= snoc_op (AttributeChange a)

220 left_clip <- use skip_columns

238 left_clip <- use skip_columns

221 right_clip <- use remaining_columns

239 right_clip <- use remaining_columns

@@ -223,37 +241,25 @@ add_maybe_clipped (HorizText text_str _ow _cw) =

223 right_clipped = (ow - left_clip) > right_clip

241 right_clipped = (ow - left_clip) > right_clip

224 if left_clipped || right_clipped

242 if left_clipped || right_clipped

225 then let text_str' = clip_text left_clip right_clip

243 then let text_str' = clip_text left_clip right_clip

226− in render_unclipped_text_span text_str'

244+ in add_unclipped_text text_str'

227− else render_unclipped_text_span text_str

245+ else add_unclipped_text text_str

228−process_image (VertJoin top_image bottom_image _ _) = do

246+add_maybe_clipped (VertJoin top_image bottom_image ow oh) = do

229− (skip_row',skip_col') <- row_ops_for_image mrow_ops

230− top_image

247+ add_maybe_clipped 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')

248+ row_offset += image_height top_image

238− (skip_row'',skip_col'') <- row_ops_for_image mrow_ops

239− bottom_image

249+ add_maybe_clipped bottom_image

240− bg

250+add_maybe_clipped (HorizJoin left_image right_image ow oh) -> do

241− region

251+ add_maybe_clipped left_image

242− (skip_row', skip_col)

252+ add_maybe_clipped right_image

243− (y + top_height)

253+

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

254+ (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

255+ -- Don't output the right part unless there is at least a single column left after

250− -- outputting the left part.

256+ -- outputting the left part.

251− if image_width l - (skip_col - skip_col') > remaining_columns

257+ if image_width l - (skip_col - skip_col') > remaining_columns

252− then return (skip_row,skip_col')

258+ then return (skip_row,skip_col')

253− else do

259+ 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

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

255 return (min skip_row' skip_row'', skip_col'')

261 return (min skip_row' skip_row'', skip_col'')

256− BGFill width height -> do

262+add_maybe_clipped (BGFill width height) -> do

257 let min_height = if y + height > (region_height region)

263 let min_height = if y + height > (region_height region)

258 then region_height region - y

264 then region_height region - y

259 else min height remain_rows

265 else min height remain_rows

@@ -275,24 +281,27 @@ process_image (VertJoin top_image bottom_image _ _) = do

275 ImageCrop (max_w,max_h) i ->

281 ImageCrop (max_w,max_h) i ->

276 row_ops_for_image mrow_ops i bg region skip_dim y (min remaining_columns max_w) (min remain_rows max_h)

282 row_ops_for_image mrow_ops i bg region skip_dim y (min remaining_columns max_w) (min remain_rows max_h)

277

283

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

282 let (to_drop,pad_prefix) = clip_for_char_width left_skip txt 0

291 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

284 (to_take,pad_suffix) = clip_for_char_width right_clip txt' 0

293 (to_take,pad_suffix) = clip_for_char_width right_clip txt' 0

285 txt'' = TL.append (TL.take to_take txt') (if pad_suffix then TL.singleton '…' else TL.empty)

294 txt'' = TL.append (TL.take to_take txt') (if pad_suffix then TL.singleton '…' else TL.empty)

286 clip_for_char_width 0 _ n = (n, False)

295 clip_for_char_width 0 _ n = (n, False)

287− clip_for_char_width 1 t n

296+ clip_for_char_width w t n

297+ | w < cw = (n, True)

288− | wcwidth (TL.head t) == 1 = (n+1, False)

298+ | w == cw = (n+1, False)

289− | otherwise = (n, True)

299+ | w > cw = clip_for_char_width (w - cw) (TL.rest t) (n + 1)

290− clip_for_char_width lc t n

300+ where cw = safe_wcwidth (TL.head t)

291− = apply_left_clip (lc - wcwidth (TL.head t)) (TL.rest t) (n + 1)

301+ in txt''

292− render_unclipped_text_span a txt''

302+

293−

294−render_unclipped_text_span :: DisplayString -> BlitM ()

303+add_unclipped_text :: DisplayString -> BlitM ()

295−render_unclipped_text_span txt = do

304+add_unclipped_text txt = do

296 let op = TextSpan used_display_columns (TL.length txt) (TL.encodeUtf8 txt)

305 let op = TextSpan used_display_columns (TL.length txt) (TL.encodeUtf8 txt)

297 used_display_columns = wcswidth $ TL.unpack txt

306 used_display_columns = wcswidth $ TL.unpack txt

298 use row_offset >>= snoc_op op

307 use row_offset >>= snoc_op op

vty.cabal+16

@@ -48,6 +48,7 @@ library

48 parallel >= 2.2 && < 3.3,

49 parsec >= 2 && < 4,

50 terminfo >= 0.3 && < 0.4,

51+ text >= 0.11.3,

51 unix,

52 unix,

52 utf8-string >= 0.3 && < 0.4,

53 utf8-string >= 0.3 && < 0.4,

53 vector >= 0.7

54 vector >= 0.7

@@ -105,6 +106,7 @@ test-suite verify-attribute-ops

105 parallel >= 2.2 && < 3.3,

106 parallel >= 2.2 && < 3.3,

106 parsec >= 2 && < 4,

107 parsec >= 2 && < 4,

107 terminfo >= 0.3 && < 0.4,

108 terminfo >= 0.3 && < 0.4,

109+ text >= 0.11.3,

108 unix,

110 unix,

109 utf8-string >= 0.3 && < 0.4,

111 utf8-string >= 0.3 && < 0.4,

110 vector >= 0.7

112 vector >= 0.7

@@ -157,6 +159,7 @@ test-suite verify-using-mock-terminal

157 parallel >= 2.2 && < 3.3,

159 parallel >= 2.2 && < 3.3,

158 parsec >= 2 && < 4,

160 parsec >= 2 && < 4,

159 terminfo >= 0.3 && < 0.4,

161 terminfo >= 0.3 && < 0.4,

162+ text >= 0.11.3,

160 unix,

163 unix,

161 utf8-string >= 0.3 && < 0.4,

164 utf8-string >= 0.3 && < 0.4,

162 vector >= 0.7

165 vector >= 0.7

@@ -209,6 +212,7 @@ test-suite verify-display-attributes

209 parallel >= 2.2 && < 3.3,

212 parallel >= 2.2 && < 3.3,

210 parsec >= 2 && < 4,

213 parsec >= 2 && < 4,

211 terminfo >= 0.3 && < 0.4,

214 terminfo >= 0.3 && < 0.4,

215+ text >= 0.11.3,

212 unix,

216 unix,

213 utf8-string >= 0.3 && < 0.4,

217 utf8-string >= 0.3 && < 0.4,

214 vector >= 0.7

218 vector >= 0.7

@@ -238,6 +242,7 @@ test-suite verify-empty-image-props

238 parallel >= 2.2 && < 3.3,

242 parallel >= 2.2 && < 3.3,

239 parsec >= 2 && < 4,

243 parsec >= 2 && < 4,

240 terminfo >= 0.3 && < 0.4,

244 terminfo >= 0.3 && < 0.4,

245+ text >= 0.11.3,

241 unix,

246 unix,

242 utf8-string >= 0.3 && < 0.4,

247 utf8-string >= 0.3 && < 0.4,

243 vector >= 0.7

248 vector >= 0.7

@@ -270,6 +275,7 @@ test-suite verify-eval-terminfo-caps

270 parallel >= 2.2 && < 3.3,

275 parallel >= 2.2 && < 3.3,

271 parsec >= 2 && < 4,

276 parsec >= 2 && < 4,

272 terminfo >= 0.3 && < 0.4,

277 terminfo >= 0.3 && < 0.4,

278+ text >= 0.11.3,

273 unix,

279 unix,

274 utf8-string >= 0.3 && < 0.4,

280 utf8-string >= 0.3 && < 0.4,

275 vector >= 0.7

281 vector >= 0.7

@@ -314,6 +320,7 @@ test-suite verify-image-ops

314 parallel >= 2.2 && < 3.3,

320 parallel >= 2.2 && < 3.3,

315 parsec >= 2 && < 4,

321 parsec >= 2 && < 4,

316 terminfo >= 0.3 && < 0.4,

322 terminfo >= 0.3 && < 0.4,

323+ text >= 0.11.3,

317 unix,

324 unix,

318 utf8-string >= 0.3 && < 0.4,

325 utf8-string >= 0.3 && < 0.4,

319 vector >= 0.7

326 vector >= 0.7

@@ -352,6 +359,7 @@ test-suite verify-image-trans

352 parallel >= 2.2 && < 3.3,

359 parallel >= 2.2 && < 3.3,

353 parsec >= 2 && < 4,

360 parsec >= 2 && < 4,

354 terminfo >= 0.3 && < 0.4,

361 terminfo >= 0.3 && < 0.4,

362+ text >= 0.11.3,

355 unix,

363 unix,

356 utf8-string >= 0.3 && < 0.4,

364 utf8-string >= 0.3 && < 0.4,

357 vector >= 0.7

365 vector >= 0.7

@@ -400,6 +408,7 @@ test-suite verify-inline

400 parallel >= 2.2 && < 3.3,

408 parallel >= 2.2 && < 3.3,

401 parsec >= 2 && < 4,

409 parsec >= 2 && < 4,

402 terminfo >= 0.3 && < 0.4,

410 terminfo >= 0.3 && < 0.4,

411+ text >= 0.11.3,

403 unix,

412 unix,

404 utf8-string >= 0.3 && < 0.4,

413 utf8-string >= 0.3 && < 0.4,

405 vector >= 0.7

414 vector >= 0.7

@@ -432,6 +441,7 @@ test-suite verify-parse-terminfo-caps

432 parallel >= 2.2 && < 3.3,

441 parallel >= 2.2 && < 3.3,

433 parsec >= 2 && < 4,

442 parsec >= 2 && < 4,

434 terminfo >= 0.3 && < 0.4,

443 terminfo >= 0.3 && < 0.4,

444+ text >= 0.11.3,

435 unix,

445 unix,

436 utf8-string >= 0.3 && < 0.4,

446 utf8-string >= 0.3 && < 0.4,

437 vector >= 0.7

447 vector >= 0.7

@@ -463,6 +473,7 @@ test-suite verify-picture-ops

463 parallel >= 2.2 && < 3.3,

473 parallel >= 2.2 && < 3.3,

464 parsec >= 2 && < 4,

474 parsec >= 2 && < 4,

465 terminfo >= 0.3 && < 0.4,

475 terminfo >= 0.3 && < 0.4,

476+ text >= 0.11.3,

466 unix,

477 unix,

467 utf8-string >= 0.3 && < 0.4,

478 utf8-string >= 0.3 && < 0.4,

468 vector >= 0.7

479 vector >= 0.7

@@ -515,6 +526,7 @@ test-suite verify-picture-to-span

515 parallel >= 2.2 && < 3.3,

526 parallel >= 2.2 && < 3.3,

516 parsec >= 2 && < 4,

527 parsec >= 2 && < 4,

517 terminfo >= 0.3 && < 0.4,

528 terminfo >= 0.3 && < 0.4,

529+ text >= 0.11.3,

518 unix,

530 unix,

519 utf8-string >= 0.3 && < 0.4,

531 utf8-string >= 0.3 && < 0.4,

520 vector >= 0.7

532 vector >= 0.7

@@ -567,6 +579,7 @@ test-suite verify-span-ops

567 parallel >= 2.2 && < 3.3,

579 parallel >= 2.2 && < 3.3,

568 parsec >= 2 && < 4,

580 parsec >= 2 && < 4,

569 terminfo >= 0.3 && < 0.4,

581 terminfo >= 0.3 && < 0.4,

582+ text >= 0.11.3,

570 unix,

583 unix,

571 utf8-string >= 0.3 && < 0.4,

584 utf8-string >= 0.3 && < 0.4,

572 vector >= 0.7

585 vector >= 0.7

@@ -602,6 +615,7 @@ test-suite verify-utf8-width

602 parallel >= 2.2 && < 3.3,

615 parallel >= 2.2 && < 3.3,

603 parsec >= 2 && < 4,

616 parsec >= 2 && < 4,

604 terminfo >= 0.3 && < 0.4,

617 terminfo >= 0.3 && < 0.4,

618+ text >= 0.11.3,

605 unix,

619 unix,

606 utf8-string >= 0.3 && < 0.4,

620 utf8-string >= 0.3 && < 0.4,

607 vector >= 0.7

621 vector >= 0.7

@@ -630,6 +644,7 @@ executable vty-interactive-terminal-test

630 parsec >= 2 && < 4,

644 parsec >= 2 && < 4,

631 string-qq,

645 string-qq,

632 terminfo >= 0.3 && < 0.4,

646 terminfo >= 0.3 && < 0.4,

647+ text >= 0.11.3,

633 unix,

648 unix,

634 utf8-string >= 0.3 && < 0.4,

649 utf8-string >= 0.3 && < 0.4,

635 vector >= 0.7

650 vector >= 0.7

@@ -661,6 +676,7 @@ executable vty-benchmark

661 random == 1.0.*,

676 random == 1.0.*,

662 string-qq,

677 string-qq,

663 terminfo >= 0.3 && < 0.4,

678 terminfo >= 0.3 && < 0.4,

679+ text >= 0.11.3,

664 unix,

680 unix,

665 utf8-string >= 0.3 && < 0.4,

681 utf8-string >= 0.3 && < 0.4,

666 vector >= 0.7

682 vector >= 0.7