From 0be0c69ea5aafb2ad4e9178623e584a3a21de8fa Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 3 Mar 2020 11:31:00 -0800
Subject: [PATCH] pdf: heuristic for dealing with table wrapping.

---
 extra/pdf/layout/layout.factor   | 26 +++++++++++++++++++++-----
 extra/pdf/streams/streams.factor | 24 ++++++++----------------
 2 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/extra/pdf/layout/layout.factor b/extra/pdf/layout/layout.factor
index 6cbaa919eb..381d3afd15 100644
--- a/extra/pdf/layout/layout.factor
+++ b/extra/pdf/layout/layout.factor
@@ -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' )
diff --git a/extra/pdf/streams/streams.factor b/extra/pdf/streams/streams.factor
index 5abcf26d16..9c9d5869ca 100644
--- a/extra/pdf/streams/streams.factor
+++ b/extra/pdf/streams/streams.factor
@@ -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 ;