pdf: heuristic for dealing with table wrapping.
parent
9d16162371
commit
0be0c69ea5
|
@ -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' )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue