pdf: heuristic for dealing with table wrapping.

master
John Benediktsson 2020-03-03 11:31:00 -08:00
parent 9d16162371
commit 0be0c69ea5
2 changed files with 29 additions and 21 deletions

View File

@ -117,6 +117,11 @@ TUPLE: text string style ;
: <text> ( string style -- text )
[ convert-string ] dip text boa ;
! FIXME: need to make links clickable, render text first, draw
! box over text that is "link"
! https://www.w3.org/WAI/WCAG21/Techniques/pdf/PDF11.html
M: text pdf-render
[ style>> set-style ] keep
[
@ -250,11 +255,22 @@ M: table-row pdf-render
[ widths [ 0 or max ] change-at ] each-index
] each widths >alist sort-keys values
! make last cell larger
dup sum 400 swap [-] [ + ] curry dupd sequences.extras:change-last
dup sum dup 450 > [
! size down each column
dup sum dup 400 > [ 400 swap / [ * ] curry map ] [ drop ] if ;
over first 150 < [
! special-case small first column
drop dup unclip-slice over sum swap
450 swap - swap / [ * ] curry map! drop
] [
! size down all columns
450 swap / [ * ] curry map
] if
] [
! make last cell larger
450 swap [-] [ + ] curry dupd
sequences.extras:change-last
] if ;
: set-col-widths ( canvas rows -- )
[ max-col-widths ] keep [
@ -286,7 +302,7 @@ M: table pdf-render
} 2cleave ;
M: table pdf-width
2drop 400 ; ! FIXME: hardcoded max-width
2drop 450 ; ! FIXME: hardcoded max-width
: pdf-object ( str n -- str' )

View File

@ -17,10 +17,10 @@ IN: pdf.streams
PRIVATE>
TUPLE: pdf-writer style data ;
TUPLE: pdf-writer data ;
: new-pdf-writer ( class -- pdf-writer )
new H{ } >>style V{ } clone >>data ;
new V{ } clone >>data ;
: <pdf-writer> ( -- pdf-writer )
pdf-writer new-pdf-writer ;
@ -33,8 +33,7 @@ TUPLE: pdf-sub-stream < pdf-writer parent ;
: new-pdf-sub-stream ( style stream class -- stream )
new-pdf-writer
swap >>parent
swap >>style
dup parent>> style>> '[ _ swap assoc-union ] change-style ;
swap <style-stream> ;
TUPLE: pdf-block-stream < pdf-sub-stream ;
@ -42,32 +41,25 @@ M: pdf-block-stream dispose
[ data>> ] [ parent>> ] bi
[ data>> push-all ] [ stream-nl ] bi ;
TUPLE: pdf-span-stream < pdf-sub-stream ;
M: pdf-span-stream dispose
[ data>> ] [ parent>> data>> ] bi push-all ;
! Stream protocol
M: pdf-writer stream-flush drop ;
M: pdf-writer stream-write1
dup style>> '[ 1string _ <text> ] [ data>> ] bi* push ;
[ 1string f <text> ] [ data>> ] bi* push ;
M: pdf-writer stream-write
dup style>> '[ _ string>texts ] [ data>> ] bi* push-all ;
[ f string>texts ] [ data>> ] bi* push-all ;
M: pdf-writer stream-format
swap [ dup style>> ] dip assoc-union
'[ _ string>texts ] [ data>> ] bi* push-all ;
[ string>texts ] [ data>> ] bi* push-all ;
M: pdf-writer stream-nl
<br> swap data>> push ; ! FIXME: <br> needs style?
M: pdf-writer make-span-stream
pdf-span-stream new-pdf-sub-stream ;
swap <style-stream> <ignore-close-stream> ;
M: pdf-writer make-block-stream
pdf-block-stream new-pdf-sub-stream ;
@ -78,7 +70,7 @@ M: pdf-writer make-cell-stream
! FIXME: real table cells
M: pdf-writer stream-write-table ! FIXME: needs style?
nip swap [
[ data>> <table-cell> ] map <table-row>
[ stream>> data>> <table-cell> ] map <table-row>
] map <table> swap data>> push ;
M: pdf-writer dispose drop ;