diff --git a/README.md b/README.md index 1f8ee26..b45461c 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# **TCLFPDF 1.5 (2022)** # +# **TCLFPDF 1.6 (2023)** # ## *Port of tFPDF (PHP) by by Ian Back and Tycho Veltmeijer (modified version of FPDF by Olivier Plathey) to TCL* ## ---------- @@ -8,7 +8,7 @@ #### English ##### -This work aims to port [tFPDF]("http://www.fpdf.org/en/script/script92.php") (1.32) from PHP to TCL. This is a modified class of [FPDF]("http://www.fpdf.org/") (1.82) that adds support for UTF-8. +This work aims to port [tFPDF]("http://www.fpdf.org/en/script/script92.php") (1.33) from PHP to TCL. This is a modified class of [FPDF]("http://www.fpdf.org/") (1.85) that adds support for UTF-8. It is, therefore, a complete update of the previous version of 2014, which maintains backward compatibility, but adds full support for UTF-8. I have tried to be as faithful as possible to the original, keeping the names and structure of programs.This way it should be possible to port the examples or addons with minimal effort. @@ -16,7 +16,7 @@ Your comments or suggestions are always welcome. #### Spanish #### -Este trabajo pretende portar [tFPDF]("http://www.fpdf.org/en/script/script92.php") (1.32) de PHP a TCL. tFPDF es una clase modificada de [FPDF]("http://www.fpdf.org/") (1.82) que incorpora soporte para UTF-8. +Este trabajo pretende portar [tFPDF]("http://www.fpdf.org/en/script/script92.php") (1.33) de PHP a TCL. tFPDF es una clase modificada de [FPDF]("http://www.fpdf.org/") (1.85) que incorpora soporte para UTF-8. Por tanto, es una completa actualización de la versión previa de 2014 que mantiene la compatibilidad pero agrega completo soporte para UTF-8. He tratado de ser lo más fiel posible al original en PHP, manteniendo los nombres y la estructura de los programas. De esta manera debería ser posible portar los ejemplos o extensiones con un mínimo esfuerzo. @@ -24,7 +24,7 @@ Sus comentarios o sugerencias serán bienvenidos. -__*Luis Alejandro Muzzachiodi (2022)*__ +__*Luis Alejandro Muzzachiodi (2023)*__ ---------- diff --git a/examples/links_and_flowing_text.tcl b/examples/links_and_flowing_text.tcl new file mode 100644 index 0000000..e901779 --- /dev/null +++ b/examples/links_and_flowing_text.tcl @@ -0,0 +1,122 @@ +package require tclfpdf +namespace import ::tclfpdf::* + +set B 0 +set I 0 +set U 0 +set HREF "" + +proc WriteHTML { html } { + global HREF + # HTML parser + set html [ string map {\n "" } $html ] + set a0 {} + regsub -all "<(.*?)>" $html "»&»" a0 + set a1 [split $a0 »] + foreach i0 $a1 { + lappend a [string map { < "" > "" } $i0 ] + } + set i -1 + foreach e $a { + incr i + if { [expr $i%2] == 0 } { + # Text + if {$HREF ne ""} { + PutLink $HREF $e + } else { + Write 5 $e + } + } else { + # Tag + if { [string index $e 0] eq "/" } { + CloseTag [string toupper [string range $e 1 end]]; + } else { + # Extract attributes + set a2 [split $e " " ] + set tag {} + set tag [string toupper [lindex $a2 0]] + set a2 [lreplace $a2 0 0] + array set attr {} + set a3 "" + foreach v $a2 { + set a3 [regexp -inline {([^=]*)=["\']?([^"\']*)} $v ] + if { $a3 ne ""} { + set attr([string toupper [lindex $a3 1]]) [lindex $a3 2] + } + } + OpenTag $tag [array get attr] + } + } + } +} + +proc OpenTag { tag attr0 } { + global HREF + array set attr $attr0 + # Opening tag + if {$tag=="B" || $tag=="I" || $tag=="U" } { + SetStyle $tag 1 + } + if {$tag=="A" } { + set HREF $attr(HREF) + } + if { $tag=="BR" } { + Ln 5 + } +} + +proc CloseTag { tag } { + global HREF + # Closing tag + if { $tag=="B" || $tag=="I" || $tag=="U" } { + SetStyle $tag 0 + } + if { $tag == "A" } { + set HREF "" + } +} + +proc SetStyle { tag enable } { + # Modify style and select corresponding font + global B I U + set $tag [expr [set $tag] + ($enable ? 1 : -1)] + set style "" + set lis_tag [list B I U] + foreach s $lis_tag { + if { [set $s] >0 } { + set style $style$s; + } + } + SetFont "" $style +} + +proc PutLink { URL txt } { + #Put a hyperlink + SetTextColor 0 0 255 + SetStyle U 1 + Write 5 $txt $URL + SetStyle U 0 + SetTextColor 0 +} + +set html "You can now easily print text mixing different styles: bold, italic, +underlined, or all at once!

You can also insert links on +text, such as www.fpdf.org, or on an image: click on the logo." + +# First page +Init +AddPage +SetFont "Arial" "" 20 +Write 5 "To find out what's cool in this example, click " +SetFont "" "U" +set link [AddLink] +Write 5 "here" $link +SetFont "" +# Second page +AddPage +SetLink $link +Image "logo.gif" 10 12 30 0 "" "http://www.fpdf.org" +SetLeftMargin 45 +SetFontSize 14 +WriteHTML $html +Output "flow.pdf" \ No newline at end of file diff --git a/examples/logo.gif b/examples/logo.gif new file mode 100644 index 0000000..60b628a Binary files /dev/null and b/examples/logo.gif differ diff --git a/examples/utf8.pdf b/examples/utf8.pdf deleted file mode 100644 index 2fa2db0..0000000 Binary files a/examples/utf8.pdf and /dev/null differ diff --git a/makefont/makefont.tcl b/makefont/makefont.tcl index 6394bb3..edd42aa 100644 --- a/makefont/makefont.tcl +++ b/makefont/makefont.tcl @@ -21,7 +21,7 @@ proc Message { txt {severity ""} } { tk_messageBox -icon error -message $txt -title "$severity"; } std { - puts "$severity $msg"; + puts "$severity $txt"; } } } diff --git a/manual/setfont.htm b/manual/setfont.htm index 6485ca7..761b4e7 100644 --- a/manual/setfont.htm +++ b/manual/setfont.htm @@ -23,7 +23,7 @@

Description


Note: the font definition files must be accessible. They are searched successively in: Example using TCLFPDF_FONTPATH: diff --git a/pkgIndex.tcl b/pkgIndex.tcl index 2561006..c9641a2 100644 --- a/pkgIndex.tcl +++ b/pkgIndex.tcl @@ -1 +1 @@ -package ifneeded tclfpdf 1.5 [list source [file join $dir tclfpdf.1.5.tcl]] \ No newline at end of file +package ifneeded tclfpdf 1.6 [list source [file join $dir tclfpdf.1.6.tcl]] \ No newline at end of file diff --git a/tclfpdf.1.5.tcl b/tclfpdf.1.6.tcl similarity index 95% rename from tclfpdf.1.5.tcl rename to tclfpdf.1.6.tcl index 96295ba..9b052d7 100644 --- a/tclfpdf.1.5.tcl +++ b/tclfpdf.1.6.tcl @@ -1,9 +1,9 @@ ;# ******************************************************************************* ;# tclfpdf.tcl -;# Version: 1.5 (2022) +;# Version: 1.6 (2023) ;# Ported to TCL by L. A. Muzzachiodi ;# Credits: -;# Based on tFPDF 1.32 by Ian Back +;# Based on tFPDF 1.33 by Ian Back ;# and Tycho Veltmeijer (versions 1.30+) ;# wich is based on fpdf.php 1.8.2 by Olivier Plathey ;# Parse of JPEG based on pdf4tcl 0.8 by Peter Spjuth @@ -11,7 +11,7 @@ ;# Note: ;# the definition of core fonts have a diference: the uv index in FPDF, not tfpdf, cause a bigger file (?) -package provide tclfpdf 1.5 +package provide tclfpdf 1.6 package require Tk namespace eval ::tclfpdf:: { namespace export \ @@ -63,10 +63,17 @@ namespace eval ::tclfpdf:: { SetXY \ Output \ - variable TCLFPDF_VERSION "1.5" variable TCLFPDF_FONTPATH "[file join [pwd] [file dirname [info script]]]/font" - variable SYSTEM_TTFONTS "[file normalize $::env(SystemRoot)/fonts]"; # Windows + set SYSTEM_TTFONTS "" + switch -- $::tcl_platform(platform) { + windows { set SYSTEM_TTFONTS "[file normalize $::env(SystemRoot)/fonts]" } + unix { set SYSTEM_TTFONTS "/usr/share/fonts"} + macintosh {set SYSTEM_TTFONTS "/System/Library/Fonts"} + default { Error "Missing system path font.\n The platform: $::tc_platform(platform) isn't defined."} + } + + variable VERSION 1.6 variable unifontSubset ;# variable page ;# current page number variable n ;# current object number @@ -125,6 +132,7 @@ namespace eval ::tclfpdf:: { variable ZoomMode ;# zoom display mode variable LayoutMode ;# layout display mode variable metadata ;# document properties + variable CreationDate ;#document creation date variable PDFVersion ;# PDF version number variable Spaces4Tab ;#How spaces are a Tab ? variable TAB ;# Constant with spaces according Space4Tab @@ -227,6 +235,11 @@ proc ::tclfpdf::Init { { orientation P } { unit mm } { size A4 } } { SetDisplayMode "default" ; ;# Enable compression SetCompression 1; + ;#Metadata + variable VERSION; + variable metadata; + array set metadata "Producer tFPDF$VERSION"; + ;# Set default PDF version number variable PDFVersion "1.3"; if {[namespace which -command Header]== "::Header"} { @@ -778,8 +791,18 @@ proc ::tclfpdf::SetLink { link {y1 {0}} {page1 {-1}}} { proc ::tclfpdf::Link { x y w h link} { ;# Put a link on the page - variable PageLinks; variable page; variable k; variable hPt; - array set PageLinks [list $page [list [expr $x*$k] [expr $hPt-$y*$k] [expr $w*$k] [expr $h*$k] $link]]; + variable PageLinks; variable page; variable k; variable hPt; + set nl 0 + set i 0 + while (1) { + if {[array names PageLinks -exact $page,$i ] eq {}} { + set nl $i; + break; + } else { + incr i; + } + } + set PageLinks($page,$nl) [list [expr $x*$k] [expr $hPt-$y*$k] [expr $w*$k] [expr $h*$k] $link]; } proc ::tclfpdf::Text {x y txt } { @@ -1362,7 +1385,7 @@ proc ::tclfpdf::_getpagesize {size} { } proc ::tclfpdf::_beginpage { orientation size rotation} { - variable page; variable pages;variable state; + variable page; variable pages;variable PageLinks; variable state; variable lMargin; variable tMargin; variable bMargin; variable FontFamily; variable PageSizes; variable DefOrientation; variable DefPageSize;variable CurOrientation; @@ -1371,21 +1394,22 @@ proc ::tclfpdf::_beginpage { orientation size rotation} { variable CurRotation; incr page; - array set pages "$page {}"; + set pages($page) {}; + set PageLinks($page) {}; set state 2; - set x $lMargin; - set y $tMargin; + set x $lMargin; + set y $tMargin; set FontFamily ""; ;# Check page size and orientation if {$orientation==""} { - set orientation $DefOrientation; + set orientation $DefOrientation; } else { - set orientation [string toupper [string index $orientation 0]]; + set orientation [string toupper [string index $orientation 0]]; } if {$size==""} { - set size $DefPageSize; + set size $DefPageSize; } else { - set size [_getpagesize $size]; + set size [_getpagesize $size]; } if {$orientation!=$CurOrientation || [lindex $size 0]!=[lindex $CurPageSize 0] || [lindex $size 1]!=[lindex $CurPageSize 1]} { ;# New size or orientation @@ -1396,9 +1420,9 @@ proc ::tclfpdf::_beginpage { orientation size rotation} { set w [lindex $size 1]; set h [lindex $size 0]; } - set wPt [expr $w*$k]; - set hPt [expr $h*$k]; - set PageBreakTrigger [ expr $h-$bMargin]; + set wPt [expr $w*$k]; + set hPt [expr $h*$k]; + set PageBreakTrigger [expr $h-$bMargin]; set CurOrientation $orientation; set CurPageSize $size; } @@ -1409,9 +1433,9 @@ proc ::tclfpdf::_beginpage { orientation size rotation} { if {$rotation%90!=0} { Error "Incorrect rotation value: $rotation"; } - set CurRotation $rotation; set PageInfo($page,rotation) $rotation; } + set CurRotation $rotation; } proc ::tclfpdf::_endpage { } { @@ -1757,9 +1781,35 @@ proc ::tclfpdf::_putstreamobject { data } { _put "endobj"; } +proc ::tclfpdf::_putlinks { n } { + variable PageLinks; variable links; variable PageSizes; variable PageInfo; variable DefPageSize; + variable k; variable DefOrientation; + + set lpl [array get PageLinks $n,* ] + foreach {kpl vpl} $lpl { + lassign $vpl pl(0) pl(1) pl(2) pl(3) pl(4) pl(5) + _newobj; + set rect [format "%.2f %.2f %.2f %.2f" $pl(0) $pl(1) [expr $pl(0)+$pl(2)] [expr $pl(1)-$pl(3)]]; + set s "<>>>"; # URI need parenthesis but it come from _textstring + } else { + lassign $links($pl(4)) l(0) l(1); + if {[isset PageInfo($l(0),size)] } { + lassign $PageSizes($l(0)) PS(0) PS(1); + set h1 $PS(1); + } else { + set h1 [ expr { $DefOrientation == "P" } ?[ lindex $DefPageSize 1]*$k : [lindex $DefPageSize 0]*$k]; + } + append s [format "/Dest \[%d 0 R /XYZ 0 %.2f null\]>>" $PageInfo($l(0),n) [expr $h1-$l(1)*$k]]; + } + _put $s; + _put "endobj"; + } +} + proc ::tclfpdf::_putpage { n0 } { - variable PageInfo; variable DefPageSize; - variable k; variable DefOrientation; variable WithAlpha; + variable PageInfo; variable WithAlpha; variable n; variable AliasNbPages; variable pages; variable page; variable PageLinks; @@ -1774,26 +1824,14 @@ proc ::tclfpdf::_putpage { n0 } { _put "/Rotate PageInfo($n,rotation)"; } _put "/Resources 2 0 R" ; - if {[isset PageLinks($n0)] } { - ;# Links - set annots "/Annots \["; - foreach {pl(0) pl(1) pl(2) pl(3) pl(4)} $PageLinks($n0) { - set rect [format "%.2f %.2f %.2f %.2f" $pl(0) $pl(1) [expr $pl(0)+$pl(2)] [expr $pl(1)-$pl(3)]]; - append annots "<>>>"; # URI need parenthesis but it come from _textstring - } else { - lassing $links($pl(4)) l(0) l(1); - if {[isset PageInfo($l(0),size)] } { - lassign $PageSizes($l(0)) PS(0) PS(1); - set h1 $PS(1); - } else { - set h1 [ expr DefOrientation == "p" ? $DefPageSize(1)*$k : $DefPageSize(0)*$k]; - } - append annots [format "/Dest \[%d 0 R /XYZ 0 %.2f null\]>>" $PageInfo($l(0),n) [expr $h1-$l(1)*$k]]; - } - } - _put "$annots\]"; + if {[isset PageLinks($n0,* ] } { + set s "/Annots \["; + set lpl [array get PageLinks $n0,* ] + foreach {ipl pl} $lpl { + append s "[lindex $pl 5] 0 R "; + } + append s "\]"; + _put "$s"; } if {$WithAlpha} { _put "/Group <>"; @@ -1809,15 +1847,24 @@ proc ::tclfpdf::_putpage { n0 } { set pages($n0) [string map "$AliasNbPages $page" $pages($n0)]; } _putstreamobject $pages($n0); + ;#Link annotations + _putlinks $n0; } proc ::tclfpdf::_putpages { } { variable page; variable PageInfo; variable DefOrientation; - variable DefPageSize; variable k; variable n; + variable DefPageSize; variable k; variable n; variable PageLinks; set nb $page; + set nn $n; for {set n1 1} {$n1<=$nb } {incr n1} { - set PageInfo($n1,n) [expr $n+1+2*($n1-1)] + set PageInfo($n1,n) [ incr nn ]; + incr nn ; + set lpl [array get PageLinks $n1,* ] + foreach {ipl pl} $lpl { + lappend pl [incr nn] + set PageLinks($ipl) $pl + } } for {set n2 1} {$n2<=$nb } {incr n2} { _putpage $n2 @@ -2359,10 +2406,9 @@ proc ::tclfpdf::_putresources { } { } proc ::tclfpdf::_putinfo { } { - variable TCLFPDF_VERSION; variable metadata; + variable metadata; variable CreationDate; - set metadata(Producer) "TCLFPDF $TCLFPDF_VERSION"; - set metadata(CreationDate) "D:[clock format [clock seconds] -format %Y%m%d%H%M%S]"; + set metadata(CreationDate) $CreationDate; foreach { k1 v1 } [array get metadata] { _put "/$k1 [_textstring $v1]"; } @@ -2405,7 +2451,9 @@ proc ::tclfpdf::_puttrailer { } { proc ::tclfpdf::_enddoc { } { variable offsets; variable state; - variable n; + variable n; variable CreationDate; + + set CreationDate "D:[clock format [clock seconds] -format %Y%m%d%H%M%S]"; _putheader ; _putpages ; _putresources ;