jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
818 Commits
1 Branch
1 Tag
180 MiB
 
 
 
 
 
 
Tree: 17b8a6dbbd
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '17b8a6dbbd'
${ noResults }
punkshell/src/modules/punk/pdf-999999.0a1.0.tm

2054 lines
114 KiB
Raw Blame History

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2025
#
# @@ Meta Begin
# Application punk::pdf 999999.0a1.0
# Meta platform tcl
# Meta license MIT
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::pdf 0 999999.0a1.0]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require punk::pdf]
#[keywords module]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of punk::pdf
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::pdf
#[list_begin itemized]
package require Tcl 8.6-
package require tclMuPDF
package require punk::args
package require punk::ansi
package require punk::lib
package require textblock
#*** !doctools
#[item] [package {Tcl 8.6}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
# ++ +++ ++ + +++ +++ +++ +++ +++ +++ +++ +++
namespace eval ::punk::pdf::system {} ;#full definition below
namespace eval ::punk::pdf {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection {Namespace punk::pdf}]
#[para] Core API functions for punk::pdf
#[list_begin definitions]
namespace import ::punk::ansi::a
namespace path ::punk::pdf::system
variable base_x_per_c 4 ;#fixed width output font's x_per_c.
variable cfg_blocksep_default "#pdf::text:blockstart type %type% pageindex %pageindex% blockindex %blockindex% y-index %y-index% tlc {%x0% %y0%} brc {%brc%} warnings %warnings% : %marker%"
variable cfg_pagesep_default "#pdf::text:pagestart index %index% pageblocks %pageblocks% textblocks %textblocks% imageblocks %imageblocks% : [a bold green]PAGE[a]"
variable cfg_header_default
set cfg_header_default \
"#pdf::text::header doc %doc% pages %pages% size %size% sha1 %sha1% punk::pdf %parserversion%
# args
# %args%"
variable callid 0
variable results
variable test
array set results {}
punk::args::define {
@id -id ::punk::pdf::text
@cmd -name punk::pdf::text\
-summary\
"Extract text from non-image parts of a PDF"\
-help\
"Extract text lines from a pdf
(No OCR - will only retrieve actual text contents)
The text function can only operate on the text spans provided by the underlying
engine (MuPDF) - which in some cases (for example spaces adjacent to brackets in
PDF32000_2008.pdf p24 eg4) does not interpret the number of whitespace characters
as a human reader would. The text data supplied for formulas such as in 7.10.1 of
the above document can be missing symbols such as the square-root symbol. This would
have to be converted to a unicode square root symbol with additional bracketing to
maintain meaning. The positioning of subscript numerals would also need to be
processed - and without font size information from tclMuPDF - this is currently
not practical to process reasonably. Such formulas will come out mangled.
"
@leaders -min 0 -max 0
@opts -min 0 -max 2
-p|-page_indexes -parsekey -page_indexes -type indexset -default "0.." -help\
"Comma delimited list of indexes and/or ranges specifying which pages to output.
The indexes are 0-based.
Ranges must be specified with .. as the separator.
end means the last page.
end-1 means the second last page.
0.. is the same as .. and is the same as 0..end
examples:
1,3..
output the page index 1 (2nd page) followed by all from index 3 to the end.
0..2,end
output the first 3 pages, and the last page.
end-1..0
output the pages in reverse order from 2nd last page to first page.
see also 'punk::lib::resolve_indexset'"
-b|-block_indexes -parsekey -block_indexes -type indexset -default "0.." -help\
"Comma delimited list of indexes and/or ranges specifying which blocks to output.
Format is as per -page_indexes"
-merge_yblocks -default false -help\
"Whether to merge blocks vertically when they interleave in the y direction.
This usually makes the output more in line with the source document - but
in some scenarios it might be desired to keep the blocks listed vertically
even though they appear side by side in the source. Such vertical listing as
given by default when -merge_yblocks is false, does not necessarily match the
left to right order.
Note that especially when there is small-font text with other text to the right,
The small-font text that is not rightmost may be truncated (with trailing ellipsis)
to fit it into the vertically merged layout. Such truncation produces warnings on
the -errchannel and increments the warning count visible in the -sep-block line
preceding the merged blocks.
Smaller print that doesn't fit in the layout is sometimes not required to extract
the main data from a document such as an invoice - and the merged data can make
other elements more amenable to parsing. In practice, 2 passes with -merge_yblocks
configured on and off, combined with -sep_block data and a set of custom rules
based on the specific document set may be required for information extraction."
#------------------------------------------------------------------------------------
-compact -type boolean -default false -help\
"If compact is false - blank lines approximating the vertical spacing in the
source document will be emitted between each block.
If -merged_yblocks is true - there will still be potential vertical whitespace
within any merged blocks, as the point of -merge_yblocks is to align elements
closely to that within the source document, but there will be no vertical
layout spacing between such merged blocks, or other non-merging blocks.
This setting is redundant if -postcompact is true."
-postcompact -type boolean -default false -help\
"Strip out vertical spacing (empty or whitespace-only lines) from all blocks.
This sets -compact to true, and removes vertical gaps from any merged blocks.
The most vertically compact representation of the text will result from setting
-merge true, -postcompact true and -image_place_ansi to the empty string, as
well as omitting (or setting to empty string) -sep_page and -sep_block.
Note that if the source PDF actually positioned blank lines as strings of
whitespace, these too would be removed.
If -image_place_ansi is left as the default or has other ansi codes, the
image placeholders will not be stripped, even if they consist of the default
space characters.
If -sep_block or -sep_page are set to one or more spaces - these blank lines
will still be emitted."
-shrink_textfree_blocks -type boolean -default true -help\
"If a block is image only - don't output the placeholders.
These placeholders will still be emitted if -merge_yblocks is true and they
are in a merged block that has also merged text blocks. Set -image_place_ansi
to the empty string to suppress ANSI background for all image placeholders."
-image_place_ansi -type dict -defaultdisplaytype dict -default {border Term-grey78 inner Term-grey58 small Term-grey15} -help\
"Dict of ANSI colour codes for the textual image placeholders.
Colour codes are those as listed by 'punk::ansi::a?'
If the default -image_place_chars values of the space character are being used,
the colour names should begin with a capital letter (indicating background as
opposed to foreground colour).
The placeholders are by default space characters with the ANSI applied.
This means that just by stripping ANSI from the output, layout is maintained,
and the text can be processed simply, or the ANSI can be retained if your text
parser wishes to use it to make decisions.
The colour at element 'border' is for the border colour, 'inner' for the area
within the border, and the colour at element 'small' is for images too small for
border representation. The border bears no relation to the underlying image - and
is merely to aid in seeing when images overlap or are cropped etc. The dimensions
of the placeholder are approximates only to the source images, as they are in
multiples of the fixed-width output font character width and line height.
Setting -image_place_ansi to an empty value, or -image_place_chars to an empty
value will stop ANSI from being output at the image locations."
#------------------------------------------------------------------------------------
-image_place_chars -type dict -defaultdisplaytype dict -default {tlc " " hlt " " trc " " vlr " " brc " " hlb " " blc " " vll " " inner " " small " "} -help\
"Characters to use for image placeholders. The default list of empty spaces is
recommended for ease of visualisation and output parsing assuming an function
such as punk::ansi::ansistrip is available. An alternative set of characters
such as a unicode block character might be useful alongside turning ANSI off by
setting -image_place_ansi to empty; if the unicode character is known to be
outside the domain of characters in the source document, and it is desired to
use such chars to detect approximate image position in relation to text.
tlc - border top left corner
hlt - border top horizontal lines
trc - border top right corner
vlr - border right vertical line
brc - border bottom right corner
hlb - border bottom horizontal line
blc - border bottom left corner
vll - border left vertical line
inner - image area within border
small - for images too small for borders
"
-header -type string -default "" -help\
"Header line to record details of the conversion run.
Set to 'default' to use the provided default template.
Substitutions available:
%doc% - full path of source pdf
%pages% - number of pages in the pdf
%size% - size in bytes of the input pdf file
%sha1% - sha1 checksum of the input pdf file
%parserversion% - version of punk::pdf used.
%args% - arguments supplied to text command.
%default% - the default header template - for extending."
-sep_page -type string -default "" -help\
"Send a line of output to stdout at the beginning of each
page in the PDF.
If set to the value: default
a default separator with some added info will be used.
line begins with: #pdf::text:pagestart
Substitutions available:
%index% 0-based index of the page (not the page number as in the PDF)
%pageblocks% total number of blocks in the page, includes both
text and image blocks.
%textblocks% number of text blocks in the page
%imageblocks% number of image blocks in the page
%nl% newline
%default% The default page sep - to allow extending."
-sep_block -type string -default "" -help\
"Send a line of output to stdout at the beginning of each
textblock in the PDF. This can aid in parsing.
If set to the the value: default
a default separator with some added info will be used.
line begins with: #pdf::text:blockstart
Substitutions available:
%type% type of block text or image
%pageindex% 0-based index of the page (not the page number as in the PDF)
%y-index% 0-based index of block after the textblock list has
been sorted by y0
%x0% first x coordinate of the block
%y0% first y coordinate of the block
%x1% second x coordinate of the block
%y1% second y coordinate of the block
%nl% newline
%warnings% Number of warnings emitted to stderr for the block.
These are normally for text overlay attempts, which should
only affect whitespace, but should be checked.
%default% The default blocksep - to allow extending."
-outchannel -type string -default stdout -choicerestricted 0 -choices {return null stderr stdout}\
-choicelabels {
return\
"Buffer the results as written and return as the result of the command"
null\
"Discard the output. (Only useful if error output is all that's required)"
}\
-choicecolumns 1\
-help\
"Determine where the main text output goes. Aside from the listed options,
any open Tcl channel can be used."
-errchannel -type string -default stderr -choicerestricted 0 -choices {return null stderr stdout}\
-choicelabels {
return\
"Buffer the errors as written and return as the result of the command"
null\
"Discard the error output."
}\
-choicecolumns 1\
-help\
"Determine where the error output goes. Aside from the listed options,
any open Tcl channel can be used."
-debug_pageblock -default "" -type list -minsize 2 -maxsize 2 -help\
"A 2-element list of the page then block index(s) for which to output
extra information on stderr.
Supplied value if not empty, must contain 2 elements {indexset indexset}
The membership selection is performed the same way as -page_indexes.
e.g {.. end-1} means second-last block on every page."
-debug_highlight -default "red bold" -help\
"ANSI codes as understood by punk::ansi (see punk::ansi::a?)
These are used to colourise output if -debug_pageblock has been set"
-highlight_overwrites -default "bold" -help\
"Ansi codes as understood by punk::ansi (see punk::ansi::a?)
These are used to mark text elements which have been overlayed with
the same text data. This may occur for example in table rows in the source
document that have alternating colour or emphasis.
Having this ANSI applied can be useful when parsing the output to aid in
grouping lines. e.g by using [punk::ansi::ta::detect <str>] or similar.
By applying ansi, the layout is not disturbed when viewing in a terminal,
and may be more visually similar to the source document.
Saved output can always be passed through an ansistrip function if needed,
or the default -highlight_overwrites can be overridden by supplying an empty
string."
-engine -type any -default MuPDF -choices {MuPDF} -help\
"Only MuPDF is currently implemented. Be aware that while this script and tclMuPDF
are MIT/BSD licensed, the underlying MuPDF library is AGPL - which could place
some restrictions on commercial use."
-warnings_engine -default 0 -choices {0 1 2}\
-choicelabels {
0\
" Do not display"
1\
" Display at end on stderr"
2\
" Display as they occur on stderr"
}\
-help\
"Whether to display internal warnings regarding the state of the PDF document.
The underlying MuPDF library can in many cases work with bad/corrupted PDFS,
and if so, may emit warnings."
-warnings_textblock -default 2 -type integer -range {0 9} -help\
"0 to disable.
1 for least info, 9 for most.
Emits warnings to error channel"
@values -min 1 -max 1
filename -type string -help\
"Path to the .pdf file to parse"
}
proc text {args} {
variable callid
incr callid
package require tcl::chan::variable
#variable testchan
#set testchan [::tcl::chan::variable ::punk::pdf::test($callid)]
#chan configure $testchan -translation lf
variable results
variable base_x_per_c
variable cfg_blocksep_default
variable cfg_pagesep_default
variable cfg_header_default
set x_per_line [expr {$base_x_per_c * 2}] ;#hack for now
set argd [punk::args::parse $args withid ::punk::pdf::text]
lassign [dict values $argd] leaders opts values received
set opt_pagesep [dict get $opts -sep_page]
if {$opt_pagesep eq "default"} {
set opt_pagesep $cfg_pagesep_default
}
set opt_blocksep [dict get $opts -sep_block]
#structure the sep so that after the first word it can be treated as a dict (assuming no empty strings for substitutions)
if {$opt_blocksep eq "default"} {
set opt_blocksep $cfg_blocksep_default
}
set opt_header [dict get $opts -header]
if {$opt_header eq "default"} {
set opt_header $cfg_header_default
}
set debug_pageblock [dict get $opts -debug_pageblock]
set debug_highlight [string trim [dict get $opts -debug_highlight]]
set highlight_overwrites [string trim [dict get $opts -highlight_overwrites]]
set page_indexes [string trim [dict get $opts -page_indexes]]
set block_indexes [string trim [dict get $opts -block_indexes]]
set warnings_engine [dict get $opts -warnings_engine]
set opt_compact [dict get $opts -compact]
set opt_postcompact [dict get $opts -postcompact]
if {$opt_postcompact} {
set opt_compact 1 ;#don't emit inter-block spacing in the first place
#will also strip vertical space merged blocks
}
set opt_image_place_ansi [dict get $opts -image_place_ansi]
set opt_image_place_chars [dict get $opts -image_place_chars]
set opt_shrink_textfree_blocks [dict get $opts -shrink_textfree_blocks]
if {$warnings_engine == 2} {
#turn on printwarnings before we start
::mupdf::printwarnings 1
}
set warnings_textblock [dict get $opts -warnings_textblock]
set opt_merge_yblocks [dict get $opts -merge_yblocks]
set opt_outchan [dict get $opts -outchannel]
switch -- $opt_outchan {
return {
package require tcl::chan::variable
set outchan [::tcl::chan::variable ::punk::pdf::results($callid)]
#chan configure $outchan -translation binary -encoding utf-8
chan configure $outchan -translation lf -encoding utf-8
}
null {
package require tcl::chan::null
set outchan [::tcl::chan::null]
}
default {
set outchan $opt_outchan
}
}
set opt_errchan [dict get $opts -errchannel]
switch -- $opt_errchan {
return {
package require tcl::chan::variable
if {$opt_outchan eq "return"} {
set errchan $outchan
} else {
set errchan [::tcl::chan::variable ::punk::pdf::results($callid)]
}
#chan configure $errchan -buffering none -translation binary
chan configure $errchan -buffering none -translation lf -encoding utf-8
}
null {
package require tcl::chan::null
set errchan [::tcl::chan::null]
}
default {
set errchan $opt_errchan
}
}
set fname [file normalize [dict get $values filename]]
if {![file exists $fname]} {
puts $errchan "file at '$fname' not found"
if {$opt_outchan eq "return" || $opt_errchan eq "return"} {
#if both are 'return' at the same time - the same channel is used for both
flush $outchan
flush $errchan
set result [set results($callid)]
return $result
}
return
}
set d [::mupdf::open $fname]
set npages [$d npages]
if {$opt_header ne ""} {
set opt_header [string map [list %default% $cfg_header_default] $opt_header]
package require sha1
set hash [sha1::sha1 -hex -file $fname]
set map [list %nl% \n %crlf% \r\n %doc% $fname %pages% $npages %size% [file size $fname] %sha1% $hash %args% $args %parserversion% [package present punk::pdf]]
puts $outchan [string map $map $opt_header]
}
set page_index_list [punk::lib::indexset_resolve $npages $page_indexes]
set debug_pageblock_pages [punk::lib::indexset_resolve $npages [lindex $debug_pageblock 0]]
if {$warnings_textblock >= 9} {
puts $errchan "Will process page indices: $page_index_list"
}
#for {set pageindex 0} {$pageindex < $npages} {incr pageindex} {}
foreach pageindex $page_index_list {
#if {$pageindex != 0} {
# continue
#}
set p [$d getpage $pageindex]
#set rawtextlist [$p text -bbox lines]
set rawtextlist [$p text -bbox lines -mode {preserve-ligatures preserve-whitespace preserve-spans}]
#preserve-spans: spans on same line not merged - each line will be a span of text with the same font, colour and size.
set ydict [dict create]
foreach tl $rawtextlist {
if {[punk::pdf::system::is_coord_list $tl]} {continue} ;#don't know what to do with plain coord lists here
if {[llength $tl] % 2 != 0} {
puts $errchan "WARNING Unhandled textlist $tl"
continue
}
foreach {spancoords text} $tl {
lassign $spancoords sx0 sy0 sx1 sy1
dict lappend ydict [list $sy0 $sy1] [list $sx0 $sx1 $text]
}
}
set pageblocks [$p blocks]
if {$opt_pagesep ne ""} {
set textblock_indexes [lsearch -all -index 0 $pageblocks textblock] ;#for count
set imageblock_indexes [lsearch -all -index 0 $pageblocks imageblock];#for count
set opt_pagesep [string map [list %default% $cfg_pagesep_default] $opt_pagesep]
set map [list %nl% \n %crlf% \r\n %index% $pageindex %pageblocks% [llength $pageblocks] %textblocks% [llength $textblock_indexes] %imageblocks% [llength $imageblock_indexes]]
puts $outchan [string map $map $opt_pagesep]
}
if {[llength $pageblocks] == 0} {
continue
}
#review
#sort pageblocks by y0
set pageblocks [lsort -real -index 2 $pageblocks]
set block_index_list [punk::lib::indexset_resolve [llength $pageblocks] $block_indexes]
set debug_pageblock_blocks [punk::lib::indexset_resolve [llength $pageblocks] [lindex $debug_pageblock 1]]
#-----------
#todo - normalize y0 to first encountered with vertical fudge factor (but retain original y0)
# - sort within normalised ny0 by normalised x0
# - only increment y-index when ny0 changes
# - provide 0-based x-index (for blocksep) for multiple blocks with same ny0
#-----------
set fudge_block 2 ;#how to pick a suitable fudge factor when we haven't examined font-size?
set block_x0s [list [lindex $pageblocks 0 1]]
set block_y0s [list [lindex $pageblocks 0 2]]
set block_x1s [list [lindex $pageblocks 0 3]]
set block_y1s [list [lindex $pageblocks 0 4]]
#fudged_textblock has original list entries plus 4 possibly normalized coordinates
#we provide normals against all other blocks in the page (review - do per doc instead?)
set fudged_textblocks [list [list {*}[lindex $pageblocks 0] {*}[lrange [lindex $pageblocks 0] 1 end]]] ;#no vfudge on first block
foreach tb [lrange $pageblocks 1 end] {
lassign $tb _ tbx0 tby0 tbx1 tby1
set nx0 $tbx0
set ny0 $tby0
set nx1 $tbx1
set ny1 $tby1
foreach ex0 $block_x0s {
set pointdiff [expr {abs($tbx0 - $ex0)}]
if {$pointdiff < $fudge_block} {
set nx0 $ex0
break
}
}
foreach ey0 $block_y0s {
set pointdiff [expr {abs($tby0 - $ey0)}]
if {$pointdiff < $fudge_block} {
set ny0 $ey0
break
}
}
foreach ex1 $block_x1s {
set pointdiff [expr {abs($tbx1 - $ex1)}]
if {$pointdiff < $fudge_block} {
set nx1 $ex1
break
}
}
foreach ey1 $block_y1s {
set pointdiff [expr {abs($tby1 - $ey1)}]
if {$pointdiff < $fudge_block} {
set ny1 $ey1
break
}
}
lappend block_x0s $tbx0
lappend block_y0s $tby0
lappend block_x1s $tbx1
lappend block_y1s $tby1
lappend fudged_textblocks [list {*}$tb $nx0 $ny0 $nx1 $ny1]
}
#textblock x0 y0 x1 y1 nx0 ny0 nx1 ny1
set fudged_textblocks [lsort -command block_ordering $fudged_textblocks]
#package require punk::lib
#puts stderr "[punk::lib::showdict -roottype list $fudged_textblocks]"
#todo - check bounds of pageblocks for non-overlapping?
set page_seen_chunks [dict create] ;#store every chunk as a key just for lookup (with value 1 )
set yindex 0
set last_ny0 [lindex $fudged_textblocks 0 6]
set TESTBLOCK ""
set MERGE_BUFFER [list] ;#store so we can optionally vertically merge subsequent blocks with same y-index
set tbnum -1
foreach tb $fudged_textblocks {
incr tbnum
set block_warning_count 0
lassign $tb rawblocktype bx0 by0 bx1 by1 bnx0 bny0 bnx1 bny1
switch -- $rawblocktype {
textblock {set blocktype text}
imageblock {set blocktype image}
default {set blocktype ?}
}
if {$last_ny0 != $bny0} {
set is_new_yindex 1
incr yindex
set last_ny0 $bny0
} else {
set is_new_yindex 0
}
if {$is_new_yindex} {
if {![llength $MERGE_BUFFER]} {
#nothing to process
} else {
#------------
#debug
#set lev -1
#foreach level $MERGE_BUFFER {
# incr lev
# puts $outchan "MB$lev"
# foreach entry $level {
# puts $outchan " $entry"
# }
#}
#------------
#puts "MB dimensions: [punk::pdf::system::merge_buffer_dimensions MERGE_BUFFER]"
set mbdimensions [punk::pdf::system::merge_buffer_dimensions MERGE_BUFFER] ;#list x0 y0 x1 y1
#set cur_merge_base_fields [dict get [lindex $MERGE_BUFFER 0 0] header fields]
#if {$bny0 >= [dict get $cur_merge_base_fields y1]} {}
if {$bny0 >= [lindex $mbdimensions 3]} {
#this block begins below the entire MERGE_BUFFER - time to render previous block
_process_merge_buffer MERGE_BUFFER $pageindex $cfg_blocksep_default $opt_blocksep $opt_merge_yblocks $opt_shrink_textfree_blocks $opt_postcompact $warnings_textblock $outchan $errchan
if {$tbnum in $block_index_list} {
#now this block's offset from the top
if {!$opt_compact} {
#default: -compact false
#set vdist [expr {$bny0 - [dict get $cur_merge_base_fields y1]}]
set vdist [expr {$bny0 - [lindex $mbdimensions 3]}]
#set vdistlines [expr {int(ceil($vdist / $x_per_line))}]
set vdistlines [expr {int(floor($vdist / $x_per_line))}]
if {$vdistlines > 0} {
set vseparator [string repeat \n $vdistlines]
puts -nonewline $outchan $vseparator
}
}
}
} else {
if {$tbnum in $block_index_list} {
lappend MERGE_BUFFER [list]
}
}
}
set TESTBLOCK "" ;#not so efficient, but we merge the block as we go even if user didn't request merging. review
}
if {$tbnum ni $block_index_list} {
continue
}
set fields [dict create type $blocktype pageindex $pageindex blockindex $tbnum y-index $yindex x0 $bx0 y0 $by0 x1 $bx1 y1 $by1]
set BUFINFO [dict create fields $fields sep ""]
if {$opt_blocksep ne ""} {
#puts stderr "[a bold yellow]type:$blocktype tb: $tbnum tlc: $bx0 $by0 brc: $bx1 $by1[a]"
set opt_blocksep [string map [list %default% $cfg_blocksep_default] $opt_blocksep]
#$block_warning_count not available yet - placeholder <w>
set map [list %nl% "\n" %crlf% "\r\n" %type% $blocktype %pageindex% $pageindex %blockindex% $tbnum %y-index% $yindex %x0% $bx0 %y0% $by0 %x1% $bx1 %y1% $by1 %tlc% "$bx0 $by0" %brc% "$bx1 $by1" %warnings% <w>]
switch -- $blocktype {
text {dict set map %marker% "[punk::ansi::a bold yellow]TBLOCK[punk::ansi::a]"}
image {dict set map %marker% "[punk::ansi::a yellow]IBLOCK[punk::ansi::a]"}
default {dict set map %marker% "[punk::ansi::a bold red]UNKNOWN BLOCK[punk::ansi::a]"}
}
#puts stdout >>>[string map $map $opt_blocksep]
dict set BUFINFO sep [string map $map $opt_blocksep]
#lappend MERGE_BUFFER [list header [string map $map $opt_blocksep]]
}
#set bufstack [lindex $MERGE_BUFFER end]
#lappend bufstack [list header $BUFINFO]
#lset MERGE_BUFFER end $bufstack
if {![llength $MERGE_BUFFER]} {
#lset MERGE_BUFFER end+1 [list [list header $BUFINFO]]
lappend MERGE_BUFFER [list [list header $BUFINFO]]
} else {
lset MERGE_BUFFER end end+1 [list header $BUFINFO]
}
#lappend MERGE_BUFFER [list header $BUFINFO]
if {$blocktype ne "text"} {
#todo - OCR (tesseract?)
if {$pageindex in $debug_pageblock_pages && $tbnum in $debug_pageblock_blocks} {
set debuginfo "b:$tbnum yinfo: $by0 $by1 ydata: $bx0 $bx1 <img>"
if {$debug_highlight ne ""} {
set debuginfo "[punk::ansi::a {*}$debug_highlight]$debuginfo\x1b\[m"
}
puts $errchan $debuginfo
}
#Note that there can still be text elements from the line dict that are within, or partially within this block
#This can occur for example with background image blocks.
#If we process the parts of the text that are fully within this block - we'll just get duplicated text output.
#It's possible also that an image could be above some text e.g a poor attempt at redaction.
#Such text should show up in another block anyway REVIEW - consider reporting in blocksep that img overlaps with text?
set imgstart_char_pos [x_to_c $bx0]
#possible for bx0 to be negative (image offset to left)
#set img_indent [string repeat " " $imgstart_char_pos]
set imgend_char_pos [x_to_c $bx1]
set img_char_width [expr {$imgend_char_pos - $imgstart_char_pos}] ;#width in terms of fixed-width output font (close enough for this case)
set vertx [expr {$bny1 - $bny0}]
set img_char_height [expr {int(ceil($vertx / $x_per_line))}] ;#linecount
#puts "-- img_char_height:$img_char_height img_char:width: $img_char_width"
if {$img_char_height == 0} {
puts $errchan "WARNING type debug msg {zero height image}" ;#todo
incr block_warning_count ;#0 based
#nothing to render for a zero height img
#MERGE_BUFFER will have header
lset MERGE_BUFFER end end+1 [list warnings $block_warning_count]
continue
}
#put a border around the image if it's big enough
#if it can't be bordered use a different colour
#this gives us 3 greys applied to space elements, to aid in seeing image overlaps and positioning.
#all can be easily stripped out with ansistrip to leave only spaces for text processing
#lassign $opt_image_place_ansi a_small a_border a_inner
#lassign $opt_image_place_chars c_small c_border c_inner
if {$img_char_height < 3 || $img_char_width < 3} {
#can't be framed without losing inner colour - use solid block of slightly different grey instead
if {![dict size $opt_image_place_chars]} {
set b [textblock::block $img_char_width $img_char_height " "]
} else {
set c_small [dict get $opt_image_place_chars small]
set b [textblock::block $img_char_width $img_char_height $c_small]
if {[dict size $opt_image_place_ansi]} {
#set b [punk::ansi::ansiwrap Term-grey58 $b]
set b [punk::ansi::ansiwrap [dict get $opt_image_place_ansi small] $b]
}
}
} else {
if {![dict size $opt_image_place_chars]} {
set c_tlc " "
set c_hlt " "
set c_trc " "
set c_vlr " "
set c_brc " "
set c_hlb " "
set c_blc " "
set c_vll " "
set c_inner " "
} else {
set c_tlc [dict get $opt_image_place_chars tlc]
set c_hlt [dict get $opt_image_place_chars hlt]
set c_trc [dict get $opt_image_place_chars trc]
set c_vlr [dict get $opt_image_place_chars vlr]
set c_brc [dict get $opt_image_place_chars brc]
set c_hlb [dict get $opt_image_place_chars hlb]
set c_blc [dict get $opt_image_place_chars blc]
set c_vll [dict get $opt_image_place_chars vll]
set c_inner [dict get $opt_image_place_chars inner]
}
set inner [textblock::block [expr {$img_char_width -2}] [expr {$img_char_height - 2}] $c_inner]
#set b [textblock::frame -type {} -ansiborder [a Term-grey15] [punk::ansi::ansiwrap Term-grey78 $inner]]
#set b [textblock::frame -type {} -ansiborder [a $a_border] [punk::ansi::ansiwrap $a_inner $inner]]
if {![dict size $opt_image_place_ansi]} {
set b [textblock::frame -type [list tlc $c_tlc hlt $c_hlt trc $c_trc vlr $c_vlr brc $c_brc hlb $c_hlb blc $c_blc vll $c_vll] $inner]
} else {
set a_border [dict get $opt_image_place_ansi border]
set a_inner [dict get $opt_image_place_ansi inner]
set b [textblock::frame -type [list tlc $c_tlc hlt $c_hlt trc $c_trc vlr $c_vlr brc $c_brc hlb $c_hlb blc $c_blc vll $c_vll] -ansiborder [a $a_border] [punk::ansi::ansiwrap $a_inner $inner]]
}
}
#set b [textblock::block $img_char_width $img_char_height " "]
#set b [punk::ansi::ansiwrap Term-102 $b]
set img_indent [textblock::block [expr {max(0,$imgstart_char_pos)}] $img_char_height \uFFFD]
if {$imgstart_char_pos < 0} {
#img representation is effectively cropped at left
#img_indent will just be a list of newlines to match height
#even if img_indent and b have no ansi - result of renderspace will have ansi resets (todo review overtype::renderspace)
set had_ansi 0
if {[punk::ansi::ta::detect $b]} {
set had_ansi 1
}
set positioned_block [overtype::renderspace -insert_mode 0 -expand_right 1 -startcolumn $imgstart_char_pos $img_indent $b]
if {!$had_ansi} {
#if user disabled ansi on image_placeholders - we need to ensure it still has none after renderspace
set positioned_block [punk::ansi::ansistrip $positioned_block]
}
} else {
set positioned_block [textblock::join -- $img_indent $b]
}
if {![llength $MERGE_BUFFER]} {
lappend MERGE_BUFFER [list [list block $positioned_block]]
} else {
lset MERGE_BUFFER end end+1 [list block $positioned_block]
}
continue
}
#scan all y-coords for items within
#(we are assuming no text items overlap the block's x or y bounds) review
set found_lines [list]
#we aren't assuming the ydata is ordered
dict for {yinfo ydata} $ydict {
lassign $yinfo dy0 dy1
set spans_in_block [list]
if {$dy0 >= $by0 && $dy1 <= $by1} {
#lappend found_lines [list $dy0 $dy1 $ydata]
#filter out lines where NO values are in range of the block
#(common to encounter line data where only some text elements are within the block we are currently at - e.g tables)
#todo - review treatment of
#assume if it just extends out of the blocks x range - it's part of a larger block (?) review - xrangefudge?
set has_element_in_range 0
foreach xxt $ydata {
lassign $xxt dx0 dx1
set xrangefudge 0 ;#shouldn't be needed?
if {($dx0 < ($bx0 - $xrangefudge)) || ($dx1 > ($bx1 + $xrangefudge))} {
#if {$tbnum == 16} {
# puts "ydata: $ydata"
# puts "x range: $xxt out of x range: $bx0 $bx1"
#}
#ignore element for this block - not rendered here
#todo - store somewhere to verify later it ended up in some block?
} else {
lappend spans_in_block $xxt
}
}
if {[llength $debug_pageblock]} {
lassign $debug_pageblock dp db
if {$pageindex in $debug_pageblock_pages && $tbnum in $debug_pageblock_blocks} {
set debuginfo "b:$tbnum yinfo: $yinfo ydata: [punk::ansi::ansistring VIEW -lf 1 $ydata]"
if {$debug_highlight ne ""} {
set debuginfo "[punk::ansi::a {*}$debug_highlight]$debuginfo\x1b\[m"
}
puts $errchan $debuginfo
}
}
if {[llength $spans_in_block]} {
#puts stderr $spans_in_block
lappend found_lines [list $dy0 $dy1 $spans_in_block]
}
}
}
#puts "found_lines: $found_lines"
#found_lines has had text elements outside the x-range of the block removed
if {[llength $found_lines]} {
set found_lines [lsort -real -index 0 $found_lines]
#vfudge
#often elements on same line are a little off in recorded y coords
#eg 658.8599... vs 659.0999...
#normalize with some vfudge factor - (proportional to x_per_c ? e.g vdiff < x_per_c )
set vfudged_lines [list]
#normalize to first y val encountered..
lappend vfudged_lines [lindex $found_lines 0] ;#nothing to normalize against (at least within this block)
foreach fl [lrange $found_lines 1 end] {
#-------------
#we can't determine the source x_per_c based on text elements in the line without knowing exact font ans size and using a text measurement API
set first_xxt [lindex $fl 2 0]
lassign $first_xxt tx0 tx1 t
#--------------
lassign $fl line_y0 line_y1
set existing_y0s [lsearch -all -inline -index 0 -subindices $vfudged_lines *]
set existing_y1s [lsearch -all -inline -index 1 -subindices $vfudged_lines *]
set vfudged_line_added 0
#set vfidx -1
#foreach ey0 $existing_y0s {
# incr vfidx
# set vdiff [expr {abs($line_y0 - $ey0)}]
# #x units per char is normally narrower than height
# set linefudge 1.5 ;#choose linefudge less than assumed x_per_line of 2*base_x_per_c - or small font lines will not be separated #REVIEW
# if {$vdiff < ($linefudge * $base_x_per_c)} {
# #normalize to existing value
# #line_y1 unnormalised??
# #if y1 vdiff is about the same - normalise it too
# set ey1 [lindex $existing_y1s $vfidx]
# set vdiff2 [expr {abs($line_y1 -$ey1)}]
# if {abs($vdiff2 - $vdiff) <= 8} {
# set line_y1 $ey1
# }
# set vfudged_line_added 1
# lappend vfudged_lines [list $ey0 $line_y1 [lindex $fl 2]]
# break
# }
#}
#when mixing fonts in same line - aligning the bases is more common.
set vfidx -1
foreach ey1 $existing_y1s {
incr vfidx
set vdiff [expr {abs($line_y1 - $ey1)}]
#x units per char is normally narrower than height
set linefudge 1.5 ;#choose linefudge less than assumed x_per_line of 2*base_x_per_c - or small font lines will not be separated #REVIEW
if {$vdiff < ($linefudge * $base_x_per_c)} {
#normalize to existing value
#if y0 vdiff is about the same - normalise it too
set ey0 [lindex $existing_y0s $vfidx]
set vdiff2 [expr {abs($line_y0 -$ey0)}]
if {abs($vdiff2 - $vdiff) <= 8} {
set line_y0 $ey0
}
set vfudged_line_added 1
lappend vfudged_lines [list $line_y0 $ey1 [lindex $fl 2]]
break
}
}
if {!$vfudged_line_added} {
lappend vfudged_lines $fl
}
}
#now merge vfudged lines with same y0
set dict_vfudge [dict create]
foreach fl $vfudged_lines {
lassign $fl ly0 ly1 xxtext_list
dict lappend dict_vfudge [list $ly0 $ly1] {*}$xxtext_list
}
#rebuild
set vfudged_lines [list]
dict for {k v} $dict_vfudge {
lappend vfudged_lines [list [lindex $k 0] [lindex $k 1] $v]
}
#if {[llength $vfudged_lines]} {
# puts stderr "vfudged lines: $vfudged_lines"
#}
#if our vfudge factor worked - we can now treat as ordered lines
set working_lines [list]
foreach line $vfudged_lines {
lassign $line ly0 ly1 spanlist
set spans_by_x0_original [lsort -real -index 0 $spanlist]
set spans_by_x0_adjusted $spans_by_x0_original ;#copy for updated x1s due to overlap expansion as we process each line
lappend working_lines [list $ly0 $ly1 $spans_by_x0_original $spans_by_x0_adjusted]
}
set block_lines [list]
set block_linenum -1
foreach fl $working_lines {
incr block_linenum
#puts "fline: $fl"
lassign $fl fy0 fy1 spans_by_x0 ;#don't pull out spans_by_x0_adjusted - it's adjusted within this loop by referring to its index in working_lines
set line_chunks [list]
#calculating x units per char for each string is only really possible if we know the exact font and size
set xidx -1 ;#index of spans in line, which are sorted by x0 (lhs)
set thisline_spancount [llength $spans_by_x0]
foreach xxt $spans_by_x0 {
incr xidx
lassign $xxt tx0 tx1 text
#puts -nonewline $testchan $text
#any span, including first may have rhs alignments with spans from previous lines in the same block
#look at original rhs alignment of spans in previous lines that match this one's x1
#look at original lhs alignment of spans in previous lines that match this one's x0
#only treat as rhs aligned spans if the text elements being compared have no trailing whitespace
#only treat as lhs aligned spans if the text elements being comapred have no leading whitespace
# - process both types at once and use the last match in the list for alignment
set this_text_right_alignable [expr {![regexp {\s+$} $text]}] ;#right alignable if no trailing ws
set this_text_left_alignable [expr {![regexp {^\s+} $text]}] ;#left alignable if no leading ws
set earlier_aligned_spans [list]
foreach pl [lrange $working_lines 0 $block_linenum-1] {
set spanidx -1
foreach pxxt [lindex $pl 2] pxxt_adjusted [lindex $pl 3] {
incr spanidx
set canalign ""
if {$this_text_right_alignable} {
if {abs([lindex $pxxt 1] - $tx1) < 1} {
set t [lindex $pxxt 2]
if {![regexp {\s+$} $t]} {
#test if right alignment would be within block bounds
set testx0 [expr {[lindex $pxxt_adjusted 1]-[c_to_x [string length $text]]}]
if {$testx0 >= $bx0} {
#puts "bleft:$bx0 testx0:$testx0 tx0:$tx0 tx1:$tx1 t:$t"
set canalign right
}
}
}
}
if {$this_text_left_alignable} {
if {abs([lindex $pxxt 0] - $tx0) < 1} {
set t [lindex $pxxt 2]
if {![regexp {^\s+$} $t]} {
if {$canalign eq ""} {
set canalign left
} else {
set canalign both
}
}
}
}
if {$canalign ne ""} {
lappend earlier_aligned_spans [dict create align $canalign originalspan $pxxt adjustedspan $pxxt_adjusted spanindex $spanidx spancount [llength [lindex $pl 2]]]
}
}
}
if {[llength $earlier_aligned_spans]} {
if {[llength $debug_pageblock]} {
lassign $debug_pageblock dp db
if {$pageindex in $debug_pageblock_pages && $tbnum in $debug_pageblock_blocks} {
set debuginfo "-PREV alignment choices [llength $earlier_aligned_spans]"
#foreach aligninfo $earlier_aligned_spans {
# set aligntext [lindex [dict get $aligninfo originalspan] 2]
# set originalcoords [lrange [dict get $aligninfo originalspan] 0 1]
# set adjustedcoords [lrange [dict get $aligninfo adjustedspan] 0 1]
# puts stdout "-[dict get $aligninfo align] original:$originalcoords adjusted:$adjustedcoords spanindex:[dict get $aligninfo spanindex] spancount:[dict get $aligninfo spancount] text:'$aligntext' ]"
#}
if {$debug_highlight ne ""} {
set debuginfo "[punk::ansi::a {*}$debug_highlight]$debuginfo\x1b\[m"
}
puts $errchan $debuginfo
}
}
}
#1st shot - use rhs of element immediately to the left (either existing TESTBLOCK or earliear spans on same line)
if {$xidx == 0} {
set prevspan_x0 ""
set prevspan_x1 ""
set prevspan_x1_adjusted ""
if {$TESTBLOCK ne ""} {
#----------------------------
#NOTE - blocks can be listed in the doc in non-left-right order
#ie the second block might have data to the left of the 1st block.
#.eg
# 4
# 3
# 2
# 1
#----
#merging to
# 1 2 3 4
#----------------------------
#set width [textblock::widthtopline $TESTBLOCK]
#set effective_prev_x1 [c_to_x $width]
##set prevspan_x1 $effective_prev_x1
#if {$tx0 < $effective_prev_x1} {
# set start_char_pos [x_to_c $effective_prev_x1]
# set this_text_indent [string repeat " " $start_char_pos]
#} else {
# set start_char_pos [x_to_c $tx0]
# set this_text_indent [string repeat " " $start_char_pos]
#}
set start_char_pos [x_to_c $tx0]
set this_text_indent [string repeat " " $start_char_pos]
#set effective_prev_x1 $start_char_pos
} else {
set start_char_pos [x_to_c $tx0]
set this_text_indent [string repeat " " $start_char_pos]
#set effective_prev_x1 $start_char_pos
set effective_prev_x1 0
}
set effective_prev_x1 0
} else {
#set prevspan_x1_adjusted [lindex $spans_by_x0_adjusted $xidx-1 1]
set prevspan_x0 [lindex $spans_by_x0 $xidx-1 0]
set prevspan_x1_adjusted [lindex $working_lines $block_linenum 3 $xidx-1 1]
set prevspan_x1 [lindex $spans_by_x0 $xidx-1 1]
#set effective_prev_x1 [expr {max($prevspan_x1,$prevspan_x1_adjusted)}]
set effective_prev_x1 $prevspan_x1_adjusted
set start_char_pos [x_to_c $tx0]
set this_text_indent [string repeat " " $start_char_pos]
}
##override above 1st shot with closest previous-line that has aligned span if applicable
#if tx0 closely matches bx0 - leave aligned with the block
if {abs($tx0 - $bx0) > 3} {
if {[llength $earlier_aligned_spans]} {
#choose most recent aligning span from lines above, but prefer based on closest matches for spanindex and spancount
#compare spanindex with xidx and spancount with thisline_spancount
#set aligned_span_info [lindex $earlier_aligned_spans end]
set aligned_span_info [lindex $earlier_aligned_spans 0] ;#choose - unless something lower with same or better match for spanindex/spancount
set si [dict get $aligned_span_info spanindex]
set sc [dict get $aligned_span_info spancount]
#use 'have' for 'already have' this flag in a previous candidate
set have_imatch [expr {$si == $xidx}]
set have_cmatch [expr {$sc == $thisline_spancount}]
foreach espan $earlier_aligned_spans {
if {$have_imatch && $have_cmatch} {
#must also have both to become new candidate
if {[dict get $espan spancount] == $thisline_spancount && [dict get $espan spanindex] == $xidx} {
set aligned_span_info $espan
}
} elseif {$have_cmatch} {
#only both flags, or same flag let this espan be the new candidate
if {[dict get $espan spancount] == $thisline_spancount} {
#same or both
if {[dict get $espan spanindex] == $xidx} {
set have_imatch 1
}
set aligned_span_info $espan
}
} elseif {$have_imatch} {
#only both flags, or same flag let this espan be the new candidate
if {[dict get $espan spancount] == $thisline_spancount} {
if {[dict get $espan spanindex] == $xidx} {
set have_cmatch 1
set aligned_span_info $espan
}
} else {
if {[dict get $espan spanindex] == $xidx} {
#same - new candidate by virtue of lower position
set aligned_span_info $espan
}
}
} else {
#no good matches yet - anything later in list is the new candidate
set aligned_span_info $espan
set have_imatch [expr {[dict get $espan spanindex] == $xidx}]
set have_cmatch [expr {[dict get $espan spancount] == $thisline_spancount}]
}
}
if {[llength $debug_pageblock]} {
lassign $debug_pageblock dp db
if {$pageindex in $debug_pageblock_pages && $tbnum in $debug_pageblock_blocks} {
set aligninfo $aligned_span_info
set aligntext [lindex [dict get $aligninfo originalspan] 2]
set originalcoords [lrange [dict get $aligninfo originalspan] 0 1]
set adjustedcoords [lrange [dict get $aligninfo adjustedspan] 0 1]
set debuginfo "CHOSENALIGN for '$text' -[dict get $aligninfo align] original:$originalcoords adjusted:$adjustedcoords spanindex:[dict get $aligninfo spanindex] spancount:[dict get $aligninfo spancount] text:'$aligntext' ]"
if {$debug_highlight ne ""} {
set debuginfo "[punk::ansi::a {*}$debug_highlight]$debuginfo\x1b\[m"
}
puts $errchan $debuginfo
}
}
#puts "tx0:$tx0 bx0:$bx0"
set canalign [dict get $aligned_span_info align]
set pxxt_adjusted [dict get $aligned_span_info adjustedspan]
if {$canalign in {both left}} {
set px0 [lindex $pxxt_adjusted 0]
set start_char_pos [x_to_c [expr {$px0}]]
set this_text_indent [string repeat " " $start_char_pos]
} else {
#right
set px1 [lindex $pxxt_adjusted 1]
set thistext_points [c_to_x [string length $text]] ;#this text's number of points (in terms of fixed-width *output* font)
set start_char_pos [x_to_c [expr {$px1 - $thistext_points}]]
set this_text_indent [string repeat " " $start_char_pos]
}
}
}
set lastchunk [lindex $line_chunks end] ;#lastchunk includes buffering
if {[llength $debug_pageblock]} {
lassign $debug_pageblock dp db
if {$pageindex in $debug_pageblock_pages && $tbnum in $debug_pageblock_blocks} {
set debuginfo "span x0 xx1 text: [lindex $xxt 0] [lindex $xxt 1] [punk::ansi::a normal]'[lindex $xxt 2]'\x1b\[m"
if {$debug_highlight ne ""} {
set debuginfo "[punk::ansi::a overline {*}$debug_highlight]$debuginfo\x1b\[m"
}
puts $errchan $debuginfo
if {$prevspan_x1 ne $prevspan_x1_adjusted} {
set C [punk::ansi::a yellow]
set RST \x1b\[m
} else {
set C "" ; set RST ""
}
set debuginfo "prev x0 x1 : $prevspan_x0 $prevspan_x1 prevspan_x1_adjusted: $C$prevspan_x1_adjusted$RST effective_prev_x1: $effective_prev_x1"
if {$debug_highlight ne ""} {
set debuginfo "[punk::ansi::ansiwrap underline {*}$debug_highlight $debuginfo]"
}
puts $errchan $debuginfo
}
}
#the x1 values produced for a span by MuPDF represent where the possibly-variable-width font text ended.
#The x_gap between this tx0 and previous tx1 thus generally only tells us that some gap is expected between the two spans - not how much.
#i.e
# - if x_gap is zero - we should probably join the two spans - otherwise can get unintended breaks in words
# - if x_gap is > zero - we can't assume much. There might be a small x_gap only because previous span is a large font.
# This means when we use tx0 as position to start - in some cases the gap is larger than desirable
# but we need to maintain it for columnar data REVIEW.
if {$xidx == 0} {
set x_gap [expr {$tx0 - $effective_prev_x1}]
set x_gap_chars [x_to_c $x_gap]
#set x_gap 0
#set buffer [string repeat " " $start_char_pos]
#set x_gap_chars 0
} else {
set x_gap [expr {$tx0 - $prevspan_x1}] ;#usually positive but can easily be negative. e.g the word TAX in some fonts can have the left of the A slightly under the top bar of the T
#if the font is large - this negative offset could be more than an entire width of our output character size.
#we really need to know the source font to do this even close to properly - REVIEW
set x_gap_chars [x_to_c $x_gap] ;#used to expand buffer below during collision detection.
#set buffer [string repeat "^" $x_gap_chars]
}
set buffer $this_text_indent
#if {$xidx > 0} {
# set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1] + $x_gap_chars}]]
#}
if {$xidx > 0 && $x_gap >= -3 && $x_gap < 0} {
#treat small negative gap (overlap) in source (prev_x1 > tx0) (typically for character overhang/underhang) as adjacency
dict set page_seen_chunks $text 1
set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1]}]]
lappend line_chunks "$buffer$text"
} elseif {$xidx > 0 && $x_gap >= 0 && $x_gap < ($base_x_per_c * 0.75)} {
#treat no, or small positive gap in source (prev_x1 < tx0) as intended adjacency
#.75 is yet another fudge for lack of font info - todo - rework to another engine?
#this branch could be merged with above, but kept separate for clarity and for specific comments.
dict set page_seen_chunks $text 1
set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1]}]]
lappend line_chunks "$buffer$text"
} elseif {$xidx > 0 && $effective_prev_x1 ne "" && $tx0 <= $effective_prev_x1} {
#possible overlap/overlay - left x of this data is before right x of previous
#first use output font's x_per_c and see if only overlaying whitespace
#in which case - it's probably a distinct piece of text - whether or not it matches previous value,
#whereas if it overlaps the text itself - it may be an 'overlay' of same data.
set prevtext [lindex $spans_by_x0 $xidx-1 2]
set prev_x0 [lindex $spans_by_x0 $xidx-1 0]
#set prevtrimmed [string trimright $prevtext] ;#removed this. whitespace in text data should be preserved - even if we are sometimes forced to add extra spacing, we shouldn't remove existing spacing.
set spandist [expr {[string length $prevtext] * $base_x_per_c}] ;#length of span in terms of fixed-width output font
set prevspan_to_x [expr {$prev_x0 + $spandist}] ;#rightmost x of previous output text's character data
set lastchunk_to_x [expr {[string length $lastchunk] * $base_x_per_c}]
set lastchunk_to_x $effective_prev_x1 ;#JJJ
#if {$lastchunk_to_x > $prevspan_to_x} {
# set prevdata_to_x $lastchunk_to_x
#} else {
# set prevdata_to_x $prevspan_to_x
#}
set prevdata_to_x [expr {max($prevspan_to_x,$lastchunk_to_x)}]
set x_overlap [expr {max(0,$prevdata_to_x - $tx0)}]
if {$tx0 <= $prevdata_to_x} {
#it really does overlap/collide
#not sure of all situations in which it occurs - seems to correspond to background colour in some contexts (e.g alternating highlights in table rows)
#It is known that some pdf docs overlay same text with very small x,y offsets to indicate bold/emphasis
#possibly also due to font embedding issues?
#choose to emphasize by default (or apply user-chosen ansi from -highlight_overwrites)
# - but warn if dup position with different data
if {$prevtext eq $text} {
#same text in same position.
#This can be somewhat useful in some situations to aid parsing the output.
# - It can allow grouping of related rows by whether ansi is present or not
# (occurs in some tables)
#It can also make the terminal output more visually in sync with the source document.
#It may however not always be desired (even though stripping ansi from resultant output is easy enough)
#ans so can be disabled using the -highlight_overwrites option
if {$highlight_overwrites ne ""} {
#default bolding or user-chosen ANSI
#our buffer is not right for overriding previous xchunk
#set xcursor_prev [string length [punk::ansi::ansistrip [join [lrange $line_chunks 0 end-1] ""]]]
#set buffer_prev [string repeat " " [expr {$startpos - $xcursor_prev}]]
#lset line_chunks end "$buffer_prev[punk::ansi::a {*}$highlight_overwrites]$text[punk::ansi::a]"
lset line_chunks end "$buffer[punk::ansi::a {*}$highlight_overwrites]$text[punk::ansi::a]"
}
#else: no need to overwrite same text if no ansi
} else {
#(seen in for example pdf of Erlang FTP-1.1.1 documentation.
#Documentation line where function name is fixed-width font span being inserted into pre-existing line of variable-width font
# where inserted font point-size also seems slightly larger.
#vertical alignment slightly different, and only one space either side
#)
set char_overlap [x_to_c $x_overlap]
#set expandchars [expr {max($char_overlap,$x_gap_chars)}]
set expandchars $char_overlap
#now check our expandchars isn't too short for the actual spaces and tail of prev text and start of current text
set dataspaces 0
if {[regexp {(\s+)$} $prevtext _ tailspaces]} {
if {$prevtext ne $tailspaces} {
#
incr dataspaces [string length $tailspaces]
}
}
if {[regexp {^(\s+)} $text _ leadingspaces]} {
if {$text ne $leadingspaces} {
incr dataspaces [string length $leadingspaces]
}
}
#if {$char_overlap > $x_gap_chars} {
# incr expandchars $dataspaces
#} else {
# set expandchars [expr {max($expandchars,$dataspaces)}]
#}
set expand [string repeat " " $expandchars]
append buffer $expand
# REVIEW - seems to work reasonably (e.g in FTP-1.1.1.pdf mentioned) - but we'll still output a warning
lappend line_chunks $buffer$text
if {$char_overlap > 0 && $warnings_textblock >= 4} {
puts $errchan "Warning pageindex [format %4s $pageindex] blockindex [format %4s $tbnum] blockwarning [format %4s $block_warning_count] type {text overlay}"
# "warning ---- block ---- : attempt to overlay text" ;#alignment comment
puts $errchan "existing : '$prevtext'"
puts $errchan "overlay : '$text'"
puts $errchan "calculated char overlap : $char_overlap"
puts $errchan "x-gap chars : $x_gap_chars"
#puts $errchan "data spaces : $dataspaces"
puts $errchan "expanding by : $expandchars"
#puts $errchan "end this chunk : [c_to_x [string length [lindex $line_chunks end]]]"
}
incr block_warning_count ;#0 based
#puts stderr ">>$spans_by_x0"
}
} else {
#for example?
#narrow columns where amount fills entire field
#Assume it is new data - we don't even look at whether values are the same ?
dict set page_seen_chunks $text 1
#if {$xidx > 0} {
# set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1] + $x_gap_chars}]]
#}
if {$xidx > 0 && $x_gap_chars == 0} {
set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1]}]]
}
lappend line_chunks "$buffer$text"
}
} else {
dict set page_seen_chunks $text 1
if {$xidx > 0} {
if {$x_gap_chars == 0} {
#set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1] + $x_gap_chars}]]
set buffer [string repeat " " [expr {[x_to_c $effective_prev_x1]}]]
}
}
lappend line_chunks "$buffer$text"
}
#position 3 is spans_by_x0_adjusted
set chunk [lindex $line_chunks end]
set chunklen [string length [punk::ansi::ansistrip $chunk]]
lset working_lines $block_linenum 3 $xidx 1 [c_to_x $chunklen]
#jjj
#if {[llength $line_chunks] == 1} {
# #lset working_lines $block_linenum 3 $xidx 0 [expr {[c_to_x $chunklen]-$start_char_pos}]
# lset working_lines $block_linenum 3 $xidx 0 [c_to_x [expr {$chunklen -[string length $buffer]}]]
#} else {
# #assert 2 or more
# set prevchunk [lindex $line_chunks end-1]
# set prevchunklen [string length [punk::ansi::ansistrip $prevchunk]]
# #lset working_lines $block_linenum 3 $xidx 0 [expr {[c_to_x $chunklen]-[c_to_x $prevchunklen]}]
# lset working_lines $block_linenum 3 $xidx 0 [c_to_x [expr {$prevchunklen + [string length $buffer]}]]
#}
}
#puts stdout [join $line_chunks ""]
set line ""
foreach lc $line_chunks {
set line [overtype::renderline -insert_mode 0 -expand_right 1 -transparent 1 $line $lc]
}
#lappend block_lines [join $line_chunks ""]
lappend block_lines $line
#puts stderr ">> $spans_by_x0"
}
#lappend MERGE_BUFFER [list lines $block_lines]
lset MERGE_BUFFER end end+1 [list lines $block_lines]
#lappend MERGE_BUFFER [list warnings $block_warning_count]
lset MERGE_BUFFER end end+1 [list warnings $block_warning_count]
#TESTBLOCK
# set mergedblock [overtype::block -transparent 1 -overflow 1 $mergedblock $block]
if {$TESTBLOCK eq ""} {
package require textblock
set TESTBLOCK [textblock::join -- [join $block_lines \n]]
set x1_previous_block 0
} else {
#set TESTBLOCK [overtype::block -transparent 1 -overflow 1 $mergedblock $block]
set TESTBLOCK [overtype::block -transparent 1 -overflow 1 $TESTBLOCK [join $block_lines \n]]
#must have been a previous block
set x1_previous_block [lindex $fudged_textblocks $tbnum-1 3]
}
#REVIEW - TESTBLOCK - perhaps of little use TEST.
#puts stdout "---TESTBLOCK--"
#puts stdout $TESTBLOCK
#puts stdout "--- --"
#puts stdout "--- x1 prev block $x1_previous_block"
#puts stdout "--- x1 testblock [c_to_x [textblock::widthtopline $TESTBLOCK]]"
} else {
puts $errchan "punk::pdf::text warning - shouldn't get here"
puts $outchan "$bx0,$by0----------------------------"
puts $outchan [$p textfrombox {*}[lrange $tb 1 4]]
puts $outchan "____________________________$bx1,$by1"
}
}
if {[llength $MERGE_BUFFER]} {
_process_merge_buffer MERGE_BUFFER $pageindex $cfg_blocksep_default $opt_blocksep $opt_merge_yblocks $opt_shrink_textfree_blocks $opt_postcompact $warnings_textblock $outchan $errchan
#puts $errchan "WARNING: MERGE_BUFFER not empty, but should be empty at end of page"
#puts $outchan [punk::lib::showdict -roottype list $MERGE_BUFFER]
}
}
if {$warnings_engine == 1} {
puts $errchan "MuPDF wasrepaired: [$d wasrepaired]"
puts $errchan "MuPDF warnings : [$d warnings]"
}
flush $outchan
flush $errchan
if {$opt_outchan eq "return" || $opt_errchan eq "return"} {
#if both are 'return' at the same time - the same channel is used for both
set result [encoding convertfrom utf-8 [set results($callid)]]
#set result [set results($callid)]
return $result
}
return
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::pdf ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::pdf::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent]
#*** !doctools
#[subsection {Namespace punk::pdf::lib}]
#[para] Secondary functions that are part of the API
#[list_begin definitions]
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::pdf::lib ---}]
}
::tcl::namespace::eval ::punk::pdf::system {
#for basic verifying/identifying of coord lists of form: x0 y0 x1 y1
proc is_coord_list {lst} {
if {[llength $lst] != 4} {
return 0
}
set result 1
foreach item $lst {
if {![string is double -strict $item]} {
return 0
}
}
return $result
}
#subset of possible boms - just for experimenting
proc bom_ident {binstr} {
if {[string match \uFFEF* $binstr]} {
return bom
}
set first32 [string range $binstr 0 3]
set bytes [binary scan $binstr H2H2H2H2 a b c d]
switch -- $a {
fe {
if {"$b" eq "ff"} {
return utf-16be
}
}
ef {
if {"$b$c" eq "bbbf"} {
return utf-8
}
}
ff {
if {$b eq "fe"} {
if {"$c$d" eq "0000"} {
return utf-32le
} else {
return utf-16le
}
}
}
default {
if {"$a$b$c$d" eq "0000feff"} {
return utf-32be
}
}
}
return unknown
}
#points to number of chars - in terms of fixed-width output font
proc x_to_c {x} {
upvar ::punk::pdf::base_x_per_c base_x_per_c
return [expr {round($x / $base_x_per_c)}] ;#jjj
#return [expr {int($x / $base_x_per_c)}]
#return [expr {int(ceil($x / $base_x_per_c))}]
}
#number of chars to points - in terms of fixed-width output font
proc c_to_x {charcount} {
upvar ::punk::pdf::base_x_per_c base_x_per_c
return [expr {$charcount * $base_x_per_c}]
}
proc merge_buffer_dimensions {bufname} {
upvar $bufname MB
if {![llength $MB]} {
return [list 0 0 0 0] ;#x0 y0 x1 y1
}
set firstheader [lindex $MB 0 0]
set flds [dict get [lindex $firstheader 1] fields]
set dimensions [list [dict get $flds x0] [dict get $flds y0] [dict get $flds x1] [dict get $flds y1]]
#we can get negative values e.g image offset to left or top
foreach sametopblocks $MB {
foreach B $sametopblocks {
if {[lindex $B 0] eq "header"} {
set flds [dict get [lindex $B 1] fields]
set this_x0 [dict get $flds x0]
set this_y0 [dict get $flds y0]
set this_x1 [dict get $flds x1]
set this_y1 [dict get $flds y1]
lset dimensions 0 [expr {min([lindex $dimensions 0],$this_x0)}]
lset dimensions 1 [expr {min([lindex $dimensions 1],$this_y0)}]
lset dimensions 2 [expr {max([lindex $dimensions 2],$this_x1)}]
lset dimensions 3 [expr {max([lindex $dimensions 3],$this_y1)}]
}
}
}
return $dimensions
}
#whether merging on or off - we keep a MERGE_BUFFER
#At every y-index change, and at end of page, process last entry(s)
proc _process_merge_buffer {bufname pageindex blocksep_default opt_blocksep domerge opt_shrink_textfree_blocks opt_postcompact opt_warnings_textblock outc errc} {
upvar ::punk::pdf::base_x_per_c base_x_per_c
upvar ::punk::pdf::testchan testchan
set x_per_line [expr {$base_x_per_c * 2}] ;#hack for now
upvar $bufname MB
if {!$domerge} {
set block_warnings 0
#puts "MB:'$MB'"
set warningrecords [lsearch -all -inline -index 0 $MB warnings]
foreach wr $warningrecords {
incr block_warnings [lindex $wr 1]
}
#just emit the header & line blocks we have in the merge buffer one after the other
set blockresult "" ;#needed for postcompact
set emissions [list] ;#need to enable blank sep_block even when -postcompact is true
foreach yset $MB {
foreach B $yset {
switch -- [lindex $B 0] {
header {
if {$opt_blocksep ne ""} {
set sep [dict get [lindex $B 1] sep]
set sep [string map [list <w> $block_warnings] $sep]
#puts $outc $sep
lappend emissions [list data $blockresult]
lappend emissions [list sep $sep]
set blockresult ""
#append blockresult $sep \n
}
}
lines {
set lines [lindex $B 1]
#puts $errc "--->[punk::ansi::ansistring VIEW $lines]"
set idx -1
foreach l $lines {
incr idx
if {[catch {
#puts $outc $l
append blockresult $l \n
} errMsg]} {
set prevline [lindex $lines $idx-1]
set nextline [lindex $lines $idx+1]
puts stderr "error writing output channel $outc\nerrMsg:$errMsg\n"
puts stderr " prevline:'[punk::ansi::ansistring VIEW -lf 1 $prevline]'"
puts stderr " lineview '[punk::ansi::ansistring VIEW -lf 1 $l]'"
puts stderr " nextline:'[punk::ansi::ansistring VIEW -lf 1 $nextline]'"
#puts $testchan "=----------------------------------------="
#puts $testchan $l
#puts $testchan "=----------------------------------------="
}
}
}
block {
if {!$opt_shrink_textfree_blocks} {
#puts $outc [string map [list \uFFFD " "] [lindex $B 1]]
append blockresult [string map [list \uFFFD " "] [lindex $B 1]] \n
#puts $errc "--->[punk::ansi::ansistring VIEW [lindex $B 1]]"
}
}
warnings {}
}
}
}
lappend emissions [list data $blockresult]
set output ""
if {$opt_postcompact} {
foreach e $emissions {
lassign $e etype data_or_header
switch -- $etype {
sep {
append output $data_or_header \n
}
data {
foreach ln [split $data_or_header \n] {
if {[string trim $ln] ne ""} {
append output $ln \n
}
}
}
}
}
puts -nonewline $outc $output
} else {
foreach e $emissions {
lassign $e _ data_or_header
puts -nonewline $outc $data_or_header\n
}
}
set MB [list]
return
}
set all_headers [list]
set headers_structure [list]
set mergedblock ""
set warnings [list]
if {[llength $MB]} {
#rootheader doesn't 'contain' subsequent blocks in x or y direction - it's just the y0 that triggers the new merge because it's below previous blocks
#set rootheader [lindex $MB 0 0 1]
##puts $errc "rootheader: $rootheader"
#set base_y [dict get $rootheader fields y0]
set mbdimensions [merge_buffer_dimensions MB] ;# x0 y0 x1 y1
set base_y [lindex $mbdimensions 1]
}
#loop through and determine which blocks of those to be merged are RHS e.g largest x1
set max_x1 0
#todo - further refine to find blocks in the mergeset with no textblocks to right?
set rhs_block_indexes [list]
set textblock_x0_list [list]
foreach sametopblocks $MB {
foreach B $sametopblocks {
if {[lindex $B 0] eq "header"} {
set flds [dict get [lindex $B 1] fields]
#puts "flds: $flds"
if {[dict get $flds type] eq "text"} {
set this_x1 [dict get $flds x1]
lappend textblock_x0_list [dict get $flds x0]
if {abs($this_x1 - $max_x1) < 1} {
lappend rhs_block_indexes [dict get $flds blockindex]
set max_x1 [expr {max($this_x1,$max_x1)}]
} elseif {$this_x1 > $max_x1} {
set max_x1 $this_x1
set rhs_block_indexes [list [dict get $flds blockindex]]
}
}
}
}
}
foreach sametop $MB {
set yheaders [list]
set y_index ""
if {[llength $sametop]} {
set firstheader [lindex $sametop 0 1]
set blockrow_y0 [dict get $firstheader fields y0]
set blockrow_y1 [dict get $firstheader fields y1]
set blockrow_top_offset [expr {$blockrow_y0 - $base_y}]
#set blockrow_x0 [dict get $firstheader fields x0]
#set blockrow_x1 [dict get $firstheader fields x1]
if {$opt_warnings_textblock >= 9} {
puts $errc "Warning type debug operation {merge blockrow} firstheader $firstheader"
}
}
set header_idx -1
#set leftright_max [expr {[llength $sametop] -1}]
set hdrs [lsearch -all -inline -index 0 $sametop header]
#puts "--- > $hdrs"
set header_max [expr {[llength $hdrs] -1}]
foreach B $sametop {
#puts "====>$B"
switch -- [lindex $B 0] {
header {
incr header_idx ;#not necessarily in left-right order!
set this_y_index [dict get [lindex $B 1] fields y-index]
set this_x0 [dict get [lindex $B 1] fields x0]
set this_x1 [dict get [lindex $B 1] fields x1]
set this_y0 [dict get [lindex $B 1] fields y0]
set this_y1 [dict get [lindex $B 1] fields y1]
set this_top_offset [expr {$this_y0 - $base_y}]
set this_bottom_offset [expr {$this_y1 - $base_y}]
set this_block_index [dict get [lindex $B 1] fields blockindex]
if {$y_index eq ""} {
set y_index $this_y_index
} else {
if {$this_y_index ne $y_index} {
#shouldn't happen - but be noisy and bomb out if it does rather than produce wonky text.
set errmsg "Found item in MERGE_BUFFER with non-matching y-index (this: $this_y_index vs previous: $y_index), sorry - something went wrong in [info script]"
append errmsg \n "Item being processed: $B"
append errmsg \n "remaining MERGE_BUFFER: $MB"
puts $errc $errmsg
}
}
lappend all_headers [lindex $B 1]
lappend yheaders [lindex $B 1]
}
lines {
set lines [lindex $B 1]
#review - vertical oriented text at left can stomp on data during merge
#we are only given the bbox info by tclMuPDF
if {abs($this_x1 - $this_x0) < 1} {
#non displayable
#todo - emit at document tail as a non-layed out block?
if {$opt_warnings_textblock > 0} {
#review - firstheader vs this_block_index?
#puts $errc "Warning - no x space. Undisplayed text on page:[dict get $firstheader fields pageindex] block:[dict get $firstheader fields blockindex] text:[join $lines \n]"
puts $errc "Warning pageindex [dict get $firstheader fields pageindex] blockindex [dict get $firstheader fields blockindex] type {no x space} msg {Undisplayed text} text \"[join $lines \n]\""
}
lappend warnings 1
} else {
#todo - restrict to blockrow x0 to x1 - use overtype::block to truncate with ellipsis
# - warn if ellipsis in output
#e.g overtype::textblock::ellipsis $space_available $block
set block [join $lines \n]
set numlines [llength $lines]
set bwidth [textblock::width $block] ;#assume ragged block (differing line lengths)
set margintop ""
set bottom_offsetlines [expr {int(round($this_bottom_offset / $x_per_line))}]
if {[llength $MB] > 1 && $bottom_offsetlines >= $numlines} {
#can use bottom of textblock dist from top (better line alignment for scenario: "smallprint fieldname:" "bigprint value" aligned at base ???)
set topmarginlines [expr {$bottom_offsetlines - $numlines}]
#puts "====> offset from bottom bottom_offsetlines:$bottom_offsetlines topmarginlines:$topmarginlines this_y1:$this_y1"
if {$topmarginlines > 0} {
set margintop [textblock::block $bwidth $topmarginlines " "]
}
} else {
if {$this_top_offset > 0} {
#puts "====> offset from top"
#set offsetlines [expr {int(ceil($blockrow_top_offset / $x_per_line))}]
set offsetlines [expr {int(round($blockrow_top_offset / $x_per_line))}] ;#
#set offsetlines [expr {int(floor($this_top_offset / $x_per_line))}] ;#
if {$offsetlines > 0} {
set margintop [textblock::block $bwidth $offsetlines " "]
}
}
}
if {$this_block_index ni $rhs_block_indexes} {
#truncate overwidth blocks except for rhs
#overwidth if can collide (or merge) with x0 of any other textblocks in the merge set
#only interested in blocks where x0 >= this x1
set next_x0_list [list]
foreach x0 $textblock_x0_list {
if {$x0 >= ($this_x1 - $base_x_per_c)} {
lappend next_x0_list $x0
}
}
set next_x0_list [lsort -real $next_x0_list]
set closest_x0 [lindex $next_x0_list 0]
if {$closest_x0 ne ""} {
#set maxwidthchars [x_to_c $this_x1]
set maxwidthchars [x_to_c $closest_x0]
incr maxwidthchars -1 ;#vertically merging text blocks results in unintended text adjacencies - REVIEW
if {$maxwidthchars < $bwidth} {
#warn of rhs truncation
#text will have 'ellipsis'
#review - source text could already have ellipsis - this makes detecting truncation harder
#for now we will produce a warning if ellipsis is in the result and is on the right hand side
#todo - use a function other than textblock::frame which can report truncation
set block [textblock::frame -type {} -boxlimits {} -width [expr {$maxwidthchars +2}] $block] ;# +2 for vertical frame borders - which are removed but needed for block -width
set is_truncated 0
foreach ln [split [punk::ansi::ansistrip $block] \n] {
if {[regexp {[\u2026]$} $ln]} {
set is_truncated 1
break
}
}
if {$is_truncated} {
if {$opt_warnings_textblock > 0} {
puts $errc "Warning pageindex [dict get $firstheader fields pageindex] blockindex [dict get $firstheader fields blockindex] type {truncation} msg {merged textblock truncated on rhs} text \"[join $lines \n]\""
}
lappend warnings 1
}
}
}
}
#apply margintop after possible rhs truncation above (no need for ellipsis above content)
if {$margintop ne ""} {
set movedblock $margintop\n$block
} else {
set movedblock $block
}
if {$mergedblock eq ""} {
#could be image - as we are using overtype - should result in blank area
#todo - consider option to set bg colour, then create a block of spaces of the right size - but don't add any chars other than ANSI codes which can be stripped easily.
set mergedblock $movedblock
} else {
set mergedblock [overtype::block -transparent 1 -overflow 1 $mergedblock $movedblock]
}
}
}
block {
set block [lindex $B 1]
set bwidth [textblock::widthtopline $block] ;#assume non-ragged block
set margintop ""
if {$this_top_offset > 0} {
#set offsetlines [expr {int(ceil($this_top_offset / $x_per_line))}]
set offsetlines [expr {int(round($this_top_offset / $x_per_line))}]
if {$offsetlines > 0} {
set margintop [textblock::block $bwidth $offsetlines "\uFFFD"]
}
#puts "=====> offset:$this_top_offset"
}
if {$mergedblock eq ""} {
if {$margintop ne ""} {
set mergedblock $margintop\n[string map [list \uFFFD " "] $block]
} else {
set mergedblock [string map [list \uFFFD " "] $block]
}
} else {
if {$margintop ne ""} {
set movedblock $margintop\n$block
} else {
set movedblock $block
}
#review - img placeholder can obscure text if above it - we don't have transparency info - so probably not what's wanted
set mergedblock [overtype::block -transparent \uFFFD -overflow 1 $mergedblock $movedblock]
}
}
warnings {
#count of warnings emitted to stderr for the block
lappend warnings [lindex $B 1]
}
}
}
lappend headers_structure $yheaders
}
if {[llength $all_headers] == 1} {
#puts stdout "---> [lindex $all_headers 0 1]"
#only one block was in the MERGE_BUFFER
set stored_filled_sep [dict get [lindex $all_headers 0] sep]
if {$opt_blocksep ne ""} {
#should only be one warning record - but if more, we'll sum them
set block_warnings 0
foreach w $warnings {
incr block_warnings $w
}
#all % placeholders filled, but <w> isn't
set sep [string map [list <w> $block_warnings] $stored_filled_sep]
#still want to allow emitting empty line when opt_postcompact is true, if opt_blocksep is set to space
puts $outc $sep
}
#set is_text_free 1 ;#default to disprove
#set headerinfo [lindex $all_headers 0 1]
#set list_merges [dict get $headerinfo type]
#foreach blockrow_merge $list_merges {
# foreach tp $blockrow_merge {
# if {$tp eq "text"} {
# #todo - look for whitespace only and treat as text free
# set is_text_free 0
# }
# }
#}
set blockresult ""
if {$opt_shrink_textfree_blocks} {
set teststripped [punk::ansi::ansistrip $mergedblock]
if {[string trim $teststripped] ne ""} {
set blockresult $mergedblock
}
} else {
set blockresult $mergedblock
}
set output ""
if {$opt_postcompact} {
foreach ln [split $blockresult \n] {
if {[string trim $ln] ne ""} {
append output $ln \n
}
}
puts -nonewline $outc $output
} else {
puts -nonewline $outc $blockresult\n
}
} elseif {[llength $all_headers] > 1} {
#more than one block was in the MERGE_BUFFER
set merged_minx0 Inf
set merged_maxx1 0
set merged_miny0 Inf
set merged_maxy1 0
set merged_types [list]
set block_indexes [list]
foreach yheaders $headers_structure {
set ytypes [list]
foreach h $yheaders {
#puts "===>$h"
set F [dict get $h fields]
lappend ytypes [dict get $F type]
lappend block_indexes [dict get $F blockindex]
set merged_minx0 [expr {min([dict get $F x0], $merged_minx0)}]
set merged_maxx1 [expr {max([dict get $F x1], $merged_maxx1)}]
set merged_miny0 [expr {min([dict get $F y0], $merged_miny0)}]
set merged_maxy1 [expr {max([dict get $F y1], $merged_maxy1)}]
#puts stderr $h
}
lappend merged_types $ytypes
}
if {$opt_blocksep ne ""} {
set total_warnings 0 ;#add warning counts from constituent blocks
foreach w $warnings {
incr total_warnings $w
}
set opt_blocksep [string map [list %default% $blocksep_default] $opt_blocksep]
set map [list %nl% "\n" %crlf% "\r\n" %type% "{$merged_types}" %pageindex% $pageindex %blockindex% "{$block_indexes}" %y-index% $y_index %x0% $merged_minx0 %y0% $merged_miny0 %x1% $merged_maxx1 %y1% $merged_maxy1 %tlc% "$merged_minx0 $merged_miny0" %brc% "$merged_maxx1 $merged_maxy1" %warnings% $total_warnings]
dict set map %marker% "[punk::ansi::a bold cyan]MERGEDBLOCK[punk::ansi::a]"
puts $outc [string map $map $opt_blocksep]
}
set blockresult ""
if {$opt_shrink_textfree_blocks} {
set teststripped [punk::ansi::ansistrip $mergedblock]
if {[string trim $teststripped] ne ""} {
#puts $outc $mergedblock
set blockresult $mergedblock
}
} else {
#puts $outc $mergedblock
set blockresult $mergedblock
}
set output ""
if {$opt_postcompact} {
foreach ln [split $blockresult \n] {
if {[string trim $ln] ne ""} {
append output $ln \n
}
}
puts -nonewline $outc $output
} else {
puts -nonewline $outc $blockresult\n
}
}
set MB [list]
}
#sorting helper function
proc block_ordering {a b} {
#compare by ny0 first, then nx0 (upper side of block then left side)
set s1 [expr {round([lindex $a 6] - [lindex $b 6])}]
if {$s1 == 0} {
return [expr {round([lindex $a 5] - [lindex $a 5])}]
} else {
return $s1
}
}
}
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval punk::pdf {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)punk::pdf"
@package -name "punk::pdf" -help\
"PDF parsing assistant"
}]
namespace eval argdoc {
#namespace for custom argument documentation
proc package_name {} {
return punk::pdf
}
proc about_topics {} {
#info commands results are returned in an arbitrary order (like array keys)
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
#Adjust this function or 'default_topics' if a different order is required
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
# -------------------------------------------------------------
# get_topic_ functions add more to auto-include in about topics
# -------------------------------------------------------------
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package punk::pdf
description to come..
} \n]
}
proc get_topic_License {} {
return "MIT"
}
proc get_topic_Version {} {
return "$::punk::pdf::version"
}
proc get_topic_Contributors {} {
set authors {{<julian@precisium.com.au> "Julian Noble"}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_custom-topic {} {
punk::args::lib::tstr -return string {
A custom
topic
etc
}
}
# -------------------------------------------------------------
}
# we re-use the argument definition from punk::args::standard_about and override some items
set overrides [dict create]
dict set overrides @id -id "::punk::pdf::about"
dict set overrides @cmd -name "punk::pdf::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About punk::pdf
}] \n]
dict set overrides topic -choices [list {*}[punk::pdf::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [punk::pdf::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
set argd [punk::args::parse $args withid ::punk::pdf::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::punk::pdf::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
# variable PUNKARGS
# variable PUNKARGS_aliases
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::punk::pdf
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::pdf [tcl::namespace::eval punk::pdf {
variable pkg punk::pdf
variable version
set version 999999.0a1.0
}]
return
#*** !doctools
#[manpage_end]