;# *******************************************************************************
;# tclfpdf.tcl 
;# Version: 1.7.3 (2025)
;# Ported to TCL by L. A. Muzzachiodi
;# Credits:
;# Based on tFPDF 1.33 by Ian Back <ianb@bpm1.com>
;# and Tycho Veltmeijer <tfpdf@tychoveltmeijer.nl> (versions 1.30+)
;# wich is based on fpdf.php 1.85 by Olivier Plathey 
;# Parse of JPEG based on pdf4tcl 0.8 by Peter Spjuth
;# *******************************************************************************
;# Note: 
;# the definition of core fonts have a diference: the uv index in FPDF, not tfpdf, cause a bigger file (?)

set _version 1.7.3
set _isInit 1
package provide tclfpdf $_version
package require Tk
namespace eval ::tclfpdf:: {
	namespace export \
			SetMargins \
			SetLeftMargin \
			SetTopMargin \
			SetRightMargin \
			SetAutoPageBreak \
			SetDisplayMode \
			SetCompression \
			SetTitle \
			SetSubject \
			SetAuthor \
			SetKeywords \
			SetCreator \
			AliasNbPages \
			Error \
			Open \
			Close \
			AddPage \
			Header \
			Footer \
			PageNo \
			SetDrawColor \
			SetFillColor \
			SetTextColor \
			GetStringWidth \
			SetLineWidth \
			Line \
			Rect \
			AddFont \
			SetFont \
			SetFontSize \
			AddLink \
			SetLink \
			Link \
			Text \
			AcceptPageBreak \
			Cell \
			MultiCell \
			Write \
			Ln \
			Image \
			GetX \
			SetX \
			GetY \
			SetY \
			SetXY \
			Output \
			SetUnits \
			SetPageSize \
			SetPageOrientation \
			SetSystemFontsPaths \
			SetUserPath;
	;# SetUnits, SetPageSize and SetPageOrientation, SetSystemFontsPaths and SetUserPath only in TCLFPDF

	;#These will be set in _Init
	variable TCLFPDF_USERPATH			;# path of writeable folder for cache
	variable TCLFPDF_COREFONTSPATH 		;# path of core fonts definitions and ttfont source
	variable TCLFPDF_SYSTEMFONTSPATHS	;# list of path for load fonts

	variable VERSION 			;#
	variable unifontSubset		;#
	variable page				;# current page number
	variable n				;# current object number
	variable offsets				;# array of object offsets
	variable buffer				;# buffer holding in-memory PDF
	variable pages				;# array containing pages
	variable state				;# current document state
	variable compress			;# compression flag
	variable k				;# scale factor (number of points in user unit)
	variable DefOrientation		;# default orientation
	variable CurOrientation		;# current orientation
	variable StdPageSizes		;# standard page sizes
	variable DefPageSize		;# default page size
	variable CurPageSize 		;# current page size
	variable CurRotation			;#current page rotation
	variable PageInfo			;#page-related data
	variable wPt 
	variable hPt				;# dimensions of current page in points
	variable w 
	variable h				;# dimensions of current page in user unit
	variable lMargin			;# left margin
	variable tMargin			;# top margin
	variable rMargin			;# right margin
	variable bMargin			;# page break margin
	variable cMargin		;# cell margin
	variable x
	variable y				;# current position in user unit
	variable lasth				;# height of last printed cell
	variable LineWidth			;# line width in user unit
	variable CoreFonts 			;# array of core font names
	variable fonts				;# array of used fonts
	variable FontFiles			;# array of font files
	variable encodings			;#array of encodings
	variable cmaps				;#array of ToUnicode CMaps
	variable FontFamily			;# current font family
	variable FontStyle			;# current font style
	variable underline			;# underlining flag
	variable CurrentFont			;# current font info
	variable FontSizePt			;# current font size in points
	variable FontSize			;# current font size in user unit
	variable DrawColor			;# commands for drawing color
	variable FillColor			;# commands for filling color
	variable TextColor			;# commands for text color
	variable ColorFlag			;# indicates whether fill and text colors are different
	variable WithAlpha			;# indicates whether alpha channel is used
	variable ws				;# word spacing
	variable images			;# array of used images
	variable PageLinks			;# array of links in pages
	variable links				;# array of internal links
	variable AutoPageBreak		;# automatic page breaking
	variable PageBreakTrigger		;# threshold used to trigger page breaks
	variable InHeader			;# flag set when processing header
	variable InFooter			;# flag set when processing footer
	variable AliasNbPages		;# alias for total number of pages
	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
	
proc ::tclfpdf::_Init {} {
	global _version _isInit
	variable w 0;
	variable h 0;
	;# Initialization of properties 
	variable state 0;
	variable page 0;
	variable n 2;
	variable buffer "";
	variable pages ; array unset pages *;
	variable PageInfo; array unset PageInfo *;
	variable fonts ;	array unset fonts *;
	variable FontFiles; array unset FontFiles *;
	variable encodings; array unset encodings *;
	variable cmaps; array unset cmaps *;
	variable images ; array unset images *;
	variable links ; array unset links *;
	variable InHeader 0;
	variable InFooter 0;
	variable lasth 0;
	variable FontFamily "";
	variable FontStyle "";
	variable FontSizePt 12;
	variable underline 0;
	variable DrawColor "0 G";
	variable FillColor "0 g";
	variable TextColor "0 g";
	variable ColorFlag 0;
	variable WithAlpha 0;
	variable ws 0;
	;# Added because tab is showed as square
	variable Spaces4Tab 4;
	variable TAB [string repeat " " $Spaces4Tab];
	variable x -1; # In PHP could be null not in tcl, i.e. if no there are page added
	variable y -1; # Idem
	;# Core fonts
	variable CoreFonts [list courier helvetica times symbol zapfdingbats];
	;# Automatic page break
	SetAutoPageBreak 1;
	;# Units
	SetUnit;
	;# Page orientation
	variable DefOrientation "p"
	;# Page sizes
	variable StdPageSizes;
	array set StdPageSizes { a3 {841.89 1190.55 } a4 {595.28 841.89} a5 {420.94 595.28} letter {612 792} legal {612 1008} };
	SetPageSize;
	;#SetPageOrientation is not necessary because SetPageSize make that
	;#Page rotation
	variable CurRotation 0;
	;# Default display mode
	SetDisplayMode "default" ;
	;# Enable compression
	SetCompression 1;
	;#Version TCLFPDF
	variable VERSION $_version;
	;#Metadata
	variable metadata; 
	array set metadata [list Producer "TCLFPDF $VERSION"];
	
	;# Set default PDF version number
	variable PDFVersion "1.3";
	if {[namespace which -command Header]== "::Header"} {
		if {[namespace which -command Header] =="::tclfpf::Header"} {
			rename ::tclfpdf::Header ""; 
		}
		rename Header ::tclfpdf::Header;
	}
	if {[namespace which -command Footer]== "::Footer"} {
		if {[namespace which -command Footer] == "::tclfpf::Footer"} {
			rename ::tclfpdf::Footer "" ;
		}
		rename Footer ::tclfpdf::Footer;
	};
	variable unifontSubset 0;
	variable AliasNbPages "";
	
	set dirscript [file dirname [info script]];

	;# Import utilities
	source -encoding utf-8 [file join $dirscript/misc/util.tcl];
	
	;#Import addons
	foreach addon [glob [file join $dirscript/addons/*.tcl]] {
		source -encoding utf-8 $addon;
	}

	;# Script fonts path
	variable TCLFPDF_COREFONTSPATH [file join "$dirscript/font"]; # path of TCLFPDF + font
	variable TCLFPDF_SYSTEMFONTSPATHS {} ;
	variable TCLFPDF_USERPATH {};
	
	;#Setting system and user fonts path
	switch -- $::tcl_platform(platform) {
			windows 	{ 	
						set _systemfonts [list "$::env(SystemRoot)/fonts"];
						set _userpath "$::env(LOCALAPPDATA)/tclfpdf";
					}
			unix 		{
						if { $::tcl_platform(os) eq "Darwin" } {
							set _systemfonts [list "/System/Library/Fonts" "/Libray/Fonts"];
							set _userpath "$::env(HOME)/tclfpdf";
						} else {			
							set _systemfonts [list "/usr/share/fonts" "/usr/local/share/fonts" "$::env(HOME)/.fonts"];
							set _userpath "$::env(HOME)/.local/share/tclfpdf";
						}	
					}
	}
	SetUserPath $_userpath;
	SetSystemFontsPaths $_systemfonts;
	set _isInit 0;
}

# Add in TCLFPDF .... ---------------------------------------------------------------
proc _SetPt {} {
	variable wPt; variable hPt; variable w; variable h; variable k;
	set wPt [expr $w*$k];
	set hPt [expr $h*$k];
} 

proc ::tclfpdf::SetUnit { { unit mm} } {
	;# Scale factor
	variable k;
	set unit [ string tolower $unit];
	if {$unit == "pt"} {
		set k 1;
	} elseif {$unit=="mm"} {
		set k [expr 72/25.4];
	} elseif {$unit=="cm"} {
		set k [expr 72/2.54];
	} elseif {$unit=="in"} {
		set k 72;
	} else {
		Error "Incorrect unit: $unit";
	}
	_SetPt;
	;#(Re)Set Margins
	;# Page margins (1 cm)
	set margin [expr 28.35/$k];
	SetMargins $margin $margin;
	;# Interior cell margin (1 mm)
	variable cMargin [expr $margin/10.0];
	;# Line width (0.2 mm)
	variable LineWidth [expr .567/$k];
	;#break margin
	variable bMargin [expr 2*$margin];
}

proc ::tclfpdf::SetPageSize { { size a4} } {
	set size [ string tolower $size];
	set size [ _getpagesize $size];
	variable DefPageSize $size;
	variable CurPageSize $size;
	variable DefOrientation;
	SetPageOrientation $DefOrientation;
}

proc ::tclfpdf::SetPageOrientation { {orientation p}} {
	variable DefOrientation;variable DefPageSize;
	variable w;variable h;variable bMargin;
	variable PageBreakTrigger;
	set size [ _getpagesize $DefPageSize];
	set orientation [ string tolower $orientation];
	if {$orientation=="p" || $orientation=="portrait"} {
		set DefOrientation "P";
		set w [lindex $size 0];
		set h [lindex $size 1];
	} elseif {$orientation=="l" || $orientation=="landscape"} {
		set DefOrientation "L";
		set w [lindex $size 1] ;
		set h [lindex $size 0];
	} else {
		Error "Incorrect orientation: $orientation";
	}
	variable CurOrientation $DefOrientation;
	_SetPt
	;# Automatic page break
	set PageBreakTrigger [expr $h-$bMargin];
}

# --------------------------------------------------------------------------------------

proc ::tclfpdf::SetMargins { left top {right ""} } {
	variable lMargin; variable tMargin; variable rMargin; 
	;# Set left, top and right margins
	set lMargin $left;
	set tMargin $top;
	if {$right==""} {
		set right $left;
	}
	set rMargin $right;
}

proc ::tclfpdf::SetLeftMargin { margin } {
	variable page; variable lMargin;variable x;
	;# Set left margin
	set lMargin $margin;
	if {$page>0 && $x<$margin} {
		set x $margin;
	}	
}

proc ::tclfpdf::SetTopMargin { margin } {
	variable tMargin;
	;# Set top margin
	set tMargin $margin;
}

proc ::tclfpdf::SetRightMargin { margin } {
	variable rMargin;
	;# Set right margin
	set rMargin $margin;
}

proc ::tclfpdf::SetAutoPageBreak { auto { margin 0} } {
	variable bMargin; variable h; variable AutoPageBreak; variable PageBreakTrigger;
	;# Set auto page break mode and triggering margin
	set AutoPageBreak $auto;
	set bMargin $margin;
	set PageBreakTrigger [expr $h-$margin];
}

proc ::tclfpdf::SetDisplayMode { zoom { layout default }} {
	variable ZoomMode; variable LayoutMode;
	;# Set display mode in viewer
	if {$zoom=="fullpage" || $zoom=="fullwidth" || $zoom=="real" || $zoom=="default" || [string is integer $zoom]} {
		set ZoomMode $zoom;
	} else {
		Error "Incorrect zoom display mode: $zoom" ;
	}
	if {$layout=="single" || $layout=="continuous" || $layout=="two" || $layout=="default"} {
		set LayoutMode $layout;
	} else {
		Error "Incorrect layout display mode: $layout" ;
	}
}

proc ::tclfpdf::SetCompression { compress1 } {
	variable compress;
	;# Set page compression
	set compress $compress1;
}

proc ::tclfpdf::SetTitle { title1 } {
	variable metadata;
	;# Title of document
	set metadat(title) $title1;
}

proc ::tclfpdf::SetSubject { subject1 } {
	;# Subject of document
	variable metadata;
	set metadata(subject) $subject1;
}

proc ::tclfpdf::SetAuthor { author1 } {
	;# Author of document
	variable metadata;
	set metadata(author) $author1;
}

proc ::tclfpdf::SetKeywords { keywords1 } {
	;# Keywords of document
	variable metadata;
	set metadata(keywords) $keywords1;
}

proc ::tclfpdf::SetCreator { creator1 } {
	;# Creator of document
	variable metadata;
	set metadata(creator) $creator1;
}

proc ::tclfpdf::AliasNbPages { {alias "%nb%"} } {
	;# Define an alias for total number of pages
	variable AliasNbPages;
	set AliasNbPages $alias;
}

proc ::tclfpdf::Error { msg } {
	global _isInit
	if {$_isInit } return;
	return -code error "TCLFPDF error: $msg";
}

proc ::tclfpdf::Close { } {
	variable page; variable state;variable InFooter;
	;# Terminate document
	if {$state==3} {
		return;
	}	
	if {$page==0} {
		AddPage;
	}	
	;# Page footer
	set InFooter 1;
	if {[namespace which -command Footer] ne "" } {
		Footer;
	}	
	set InFooter 0;
	;# Close page
	 _endpage ;
	;# Close document
	_enddoc ;
}

proc ::tclfpdf::AddPage { {orientation ""} {size ""} {rotation 0}} {
	variable state; variable FontFamily; variable underline; variable FontSizePt;
	variable LineWidth; variable DrawColor; variable FillColor; variable TextColor;
	variable ColorFlag; variable page;variable k;variable FontStyle; variable InHeader;
	variable InFooter;
	;# Start a new page
	if { $state==3} {
		Error "The document is closed";
	}	
	set family $FontFamily;
	if {$underline == 1} {
		set underlined "U"
	} else {
		set underlined "";
	}
	set style "$FontStyle$underlined";
	set fontsize $FontSizePt;
	set lw $LineWidth;
	set dc $DrawColor;
	set fc $FillColor;
	set tc $TextColor;
	set cf $ColorFlag;
	if { $page>0} {
		;# Page footer
		set InFooter 1;
		if {[namespace which -command Footer] ne "" } {
			Footer;
		}	
		set InFooter 0;
		;# Close page
		_endpage;
	}
	;# Start new page
	_beginpage $orientation $size $rotation;
	;# Set line cap style to square
	_out "2 J";
	;# Set line width
	set LineWidth $lw;
	_out [format "%.2f w" [expr $lw*$k]];
	;# Set font
	if {$family !=""} {
		SetFont $family $style $fontsize;
	}
	;# Set colors
	set DrawColor $dc;
	if {$dc !="0 G"} {
		_out $dc;
	}
	set FillColor $fc;
	if {$fc !="0 g"} {
		 _out $fc;
	}
	set TextColor $tc;
	set ColorFlag $cf;
	;# Page header
	set InHeader 1;
	if {[namespace which -command Header] ne "" } {
		Header;
	}	
	set InHeader 0;
	;# Restore line width
	if { $LineWidth!=$lw} {
		set LineWidth $lw;
		_out [format "%.2f w" [expr $lw*$k]];
	}
	;# Restore font
	if {$family!=""} {
		SetFont $family $style $fontsize;
	}
	;# Restore colors
	if { $DrawColor!=$dc} {
		set DrawColor $dc;
		_out $dc;
	}
	if { $FillColor!=$fc} {
		set FillColor $fc;
		_out $fc;
	}
	set TextColor $tc;
	set ColorFlag $cf;
}

;# proc ::tclfpdf::Header { } {
	;# To be implemented in your own proc
;# }

;# proc ::tclfpdf::Footer { } {
	;# To be implemented in your own proc
;# }

proc ::tclfpdf::PageNo { } {
	;# Get current page number
	variable page;
	return $page;
}

proc ::tclfpdf::SetDrawColor { r {g ""} {b ""} } {
	variable page; variable DrawColor;
	if { ($g == "" ^ $b=="") } {
		Error "Setting Draw Color : missing g or b parameter";
	}
	;# Set color for all stroking operations
	if {($r==0 && $g==0 && $b==0) || $g==""} {
		set DrawColor [format "%.3f G" [expr $r/255.00]];
	} else {
		set DrawColor [format "%.3f %.3f %.3f RG" [expr $r/255.00] [expr $g/255.00] [expr $b/255.00]];
	}	
	if { $page>0} {
		_out $DrawColor;
	}
}

proc ::tclfpdf::SetFillColor { r {g ""} {b ""} } {
	variable FillColor; variable page; variable TextColor;variable ColorFlag;	
	if { ($g == "" ^ $b=="") } {
		Error "Setting Fill Color : missing g or b parameter";
	}
	;# Set color for all filling operations
	if { ($r==0 && $g==0 && $b==0) || $g==""} {
		set FillColor [format "%.3f g" [expr $r/255.00]];
	} else {
		set FillColor [format "%.3f %.3f %.3f rg" [expr $r/255.00] [ expr $g/255.00] [ expr $b/255.00]];
	}	
	set ColorFlag [ expr {$FillColor !=$TextColor} ];
	if { $page >0 } {
		_out $FillColor;
	}	
}

proc ::tclfpdf::SetTextColor { r {g ""} {b ""} } {
	variable TextColor; variable ColorFlag;variable FillColor;
	if { ($g == "" ^ $b=="") } {
		Error "Setting Text Color : missing g or b parameter";
	}
	;# Set color for text
	if { ($r==0 && $g==0 && $b==0) || $g==""} {
		set TextColor [format "%.3f g" [expr $r/255.00]];
	} else {
		set TextColor [format "%.3f %.3f %.3f rg" [expr $r/255.00] [expr $g/255.00] [expr $b/255.00]];
	}	
	set ColorFlag [expr {$FillColor!=$TextColor} ]
}

proc ::tclfpdf::GetStringWidth { s } {
	variable page; variable CurrentFont; variable FontSize; variable unifontSubset;
	;# Get width of a string in the current font
	set cw [ _getList2Arr $CurrentFont cw];
	set CurrentFont_desc [_getList2Arr $CurrentFont desc]
	set CurrentFont_MW [_getList2Arr $CurrentFont MissingWidth]
	set w 0;
	if { $unifontSubset == 1 } {
		set unicode [_UTF8StringToArray $s];
		foreach char $unicode {
			if { [_getchar $cw [expr 2*$char]] ne "" } {
				set w [expr $w+ ([scan [_getchar $cw [expr 2*$char]] %c] << 8) + [scan [_getchar $cw [expr 2*$char+1]] %c ]]; 
			} elseif { $char>0 && $char<128 && [ _getchar $cw [format %c $char]] ne "" } { 
				set w [expr $w + [_getchar $cw [format %c $char]]];
			} elseif { [isset CurrentFont_desc)] && [MissingWidth in $CurrentFont_desc]} {
				set mw [lindex $CurrentFont_desc [lsearch $CurrentFont_desc MissingWidth ] ];
				set w [expr $w+ $mw];
			} elseif { [isset CurrentFont_MW)]} { 
				set w [expr $w+ $CurrentFont_MW]; 
			} else { 
				set w [expr $w+ 500];
			}
		}
	} else {
		set l [string length $s];
		for { set i 0} {$i<$l} {incr i} {
			set w [expr $w + [_findchar $cw [_getchar $s $i]]];
		}
	}	
	return [expr $w*$FontSize/1000.00];
}
proc ::tclfpdf::SetLineWidth { width } {
	variable page; variable LineWidth;variable k;
	;# Set line width
	set LineWidth $width;
	if { $page>0 } {
		_out [format "%.2f w" [expr $width*$k]];
	}	
}

proc ::tclfpdf::Line { x1 y1 x2 y2 } {
	variable k; variable h;
	;# Draw a line
	_out [format "%.2f %.2f m %.2f %.2f l S" [expr $x1*$k] [expr ($h-$y1)*$k] [expr $x2*$k] [expr ($h-$y2)*$k]];
}

proc ::tclfpdf::Rect { x1 y1 w1 h1 {style "" } } {
	variable k; variable h;
	;# Draw a rectangle
	if {$style=="F"} {
		set op "f";
	} elseif {$style=="FD" || $style=="DF"} {
		set op "B";
	} else {
		set op "S";
	}
	_out [format "%.2f %.2f %.2f %.2f re %s" [expr $x1*$k] [expr ($h-$y1)*$k] [expr $w1*$k] [expr -$h1*$k] $op ];
}

proc ::tclfpdf::AddFont { family {style ""} {file ""} {uni 0}} {
	variable fonts; variable FontFiles; variable AliasNbPages; variable TCLFPDF_USERPATH; variable TCLFPDF_COREFONTSPATH;
	;# Add a TrueType, OpenType or Type1 font
	set family [string tolower $family];
	set style [string toupper $style];
	if {$style=="IB"} {
		set style "BI";
	} 
	if {$file==""} {
		set ffamily [string map {" " ""} $family];
		set fstyle [string tolower $style];
		if {$uni} {
			set file "$ffamily$fstyle.ttf";
		} else {
			set file "$ffamily$fstyle.tcl";
		}
	} else {
		set ext [file extension $file]
		if {$uni } {
			if {$ext ne ".ttf"} {
				Error "Expecting .tff file but got \"$ext\" extension"
			} 
		} else {
			if {$ext ne ".tcl"} {
				Error "Expecting .tcl (font definition) but got \"$ext\" file"
			} 
		}
	}
	set fontkey "$family$style";
	if {[isset fonts($fontkey)]} {
		return;
	}
	if {$uni } {	
		set ttffilename [_SearchPathFile $file];
		set unifilename "$TCLFPDF_USERPATH/[string tolower [file rootname $file]]";
		set name "";
		set originalsize 0;
		file stat $ttffilename ttfstat;
		if { [file exists $unifilename.mtx.tcl]} {
			source -encoding utf-8 $unifilename.mtx.tcl;
		}
		if {! [isset type] || ![isset name] || $originalsize != $ttfstat(size)} {
			set ttffile $ttffilename;
			source -encoding utf-8 "$TCLFPDF_COREFONTSPATH/ttf_font.tcl";
			ttf_Init;
			ttf_getMetrics $ttffile;
			set long [array size ttf_charWidths];
			for {set x 0} {$x < $long} {incr x} {
				append cw $ttf_charWidths($x);
			}
			set name [ string map { \[ {} \( {} \) {} \] {} } $ttf_fullName];
			array set desc [list "Ascent" [expr round($ttf_ascent)] "Descent" [expr round($ttf_descent)] "CapHeight" [expr round($ttf_capHeight)] "Flags" $ttf_flags "FontBBox" "\[ [expr round($ttf_bbox(0))] [expr round($ttf_bbox(1))] [expr round($ttf_bbox(2))] [expr round($ttf_bbox(3))] \]" "ItalicAngle" $ttf_italicAngle "StemV" [expr round($ttf_stemV)] "MissingWidth" [expr round($ttf_defaultWidth)]];
			set up [expr round($ttf_underlinePosition)];
			set ut [expr round($ttf_underlineThickness)];
			set originalsize [expr $ttfstat(size)+0 ];# 0? sic
			set type "TTF";
			;#Generate metrics .tcl file
			append s "set name \"$name\" ;\n";
			append s "set type \"$type\";\n";
			append s "array set desc {[array get desc]};\n";
			append s "set up $up;\n";
			append s "set ut $ut;\n";
			append s "set ttffile \"$ttffile\";\n";
			append s "set originalsize $originalsize;\n";
			append s "set fontkey \"$fontkey\";\n";
			if {[catch {open "$unifilename.mtx.tcl" "wb" } fh ]} {
				Error "Can't open file: $unifilename.mtx.tcl";
			}
			puts -nonewline $fh $s ;#[string length $s];
			close $fh;
			if {[catch {open "$unifilename.cw.dat" "wb" } fh ]} {
				Error "Can't open file: $unifilename.cw.dat";
			}
			puts -nonewline $fh $cw;#[string length $cw];
			close $fh;
		} else {
			if {[catch {open "$unifilename.cw.dat" "rb" } fcw ]} {
				Error "Can't open file: $unifilename.cw.dat";
			}
			set cw [read $fcw [file size $unifilename.cw.dat]];
			close $fcw;
		}
		set i [expr [array size fonts] +1];
		set j -1;
		if { $AliasNbPages != ""} {
			;#range(0,57)
			while (1) {
				lappend sbarr [incr j] ;
				if {$j==57} break;
			}	
		} else {
			;#range(0,32);
			while (1) {
				lappend sbarr [incr j] ;
				if {$j==32} break;
			}
		}
		set fonts($fontkey) [list "i" $i "type" $type "name" $name "desc" [array get desc] "up" $up "ut" $ut "cw" $cw "ttffile" $ttffile "fontkey" $fontkey "subset" $sbarr "unifilename" $unifilename];
			
		set FontFiles($fontkey) [list "length1" $originalsize "type" "TTF" "ttffile" $ttffile];
		set FontFiles($file) "type TTF";
		unset cw;		
	} else {
		array set info [ _loadfont $file];
		set i [expr [array size fonts]+1];
		set info(i) $i;
		if {[isset info(file) 0]} {
			;# Embedded font
			if {$info(type)=="TrueType"} {
				set FontFiles($info(file)) [list length1 $info(originalsize)];
			} else {
				set FontFiles($info(file)) [list length1 $info(size1) length2 $info(size2)];
			}
		}
		set fonts($fontkey) [array get info];
	}
}

proc ::tclfpdf::SetFont { family {style ""} {size 0} } { 
	variable FontFamily; variable underline;variable fonts; variable k; variable CurrentFont;
	variable CoreFonts;variable page; variable FontSize; variable FontSizePt; variable FontStyle;
	variable unifontSubset;
	;# Select a font; size given in points
	if {$family==""} {
		set family $FontFamily;
	} else {
		set family [string tolower $family];
	}
	set style [string toupper $style];
	if {[string first "U" $style] !=-1} {
		set underline 1;
		set style [string map {"U" ""} $style];
	} else {
		set underline 0;
	}
	if {$style=="IB"} {
		set style "BI";
	}
	if {$size==0} {
		set size $FontSizePt;
	}
	;# Test if font is already selected
	if { $FontFamily==$family && $FontStyle==$style && $FontSizePt==$size} {
		return;
	}
	;# Test if font is already loaded
	set fontkey "$family$style";
	if {[lsearch [array names fonts] $fontkey ] ==-1} {
		;# Test if one of the core fonts
		if {$family=="arial"} {
			set family "helvetica";
		}
		if {[lsearch $CoreFonts $family]!=-1} {
			if {$family=="symbol" || $family=="zapfdingbats"} {
				set style "";
			}
			set fontkey "$family$style";
			if {[lsearch [array names fonts] $fontkey ] ==-1} {
			
				AddFont $family $style;
			}
		} else {
			Error "Undefined font: $family $style";
		}
	}
	;# Select it
	set FontFamily $family;
	set FontStyle $style;
	set FontSizePt $size;
	set FontSize [expr $size/$k];
	upvar 0 fonts($fontkey) ::tclfpdf::CurrentFont;
	
	if {[ _getList2Arr $fonts($fontkey) type]=="TTF"} { 
		set unifontSubset 1;
	} else { 
		set unifontSubset 0;
	}
	if {$page>0} {
		_out [format "BT /F%d %.2f Tf ET" [_getList2Arr $::tclfpdf::CurrentFont i] $FontSizePt];
	}
}

proc ::tclfpdf::SetFontSize {size} {
	;# Set font size in points
	variable FontSize;variable page;variable k;variable FontSizePt; variable CurrentFont;	
	if { $FontSizePt==$size} {
		return;
	}
	set FontSizePt $size;
	set FontSize [expr $size/$k];
	if { $page>0} {
		_out [format "BT /F%d %.2f Tf ET" [_getList2Arr $CurrentFont i ] $FontSizePt];
	}
}

proc ::tclfpdf::AddLink { } {
	;# Create a new internal link
	variable links;
	set n [expr [array size links] +1];
	array set links [list $n {}];
	return $n;
}

proc ::tclfpdf::SetLink { link {y1 {0}} {page1 {-1}}} {
	;# Set destination of internal link
	variable links; variable y; variable page;
	if {$y1 == -1} {
		set y1 $y;
	}	
	if {$page1 == -1} {
		set page1 $page;
	}	
	array set links [list $link [list $page1 $y1]];
}

proc ::tclfpdf::Link { x y w h link} {
	;# Put a link on the page
	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 } {
	;# Output a string
	variable k; variable h; variable underline; variable ColorFlag;
	variable unifontSubset; variable CurrentFont; variable fonts;
	if {![isset CurrentFont]} {
		Error "No font has been set";
	}		
	if {$unifontSubset == 1} {
		set txt2 "([_escape [_UTF8toUTF16BE $txt 0]])";
		foreach uni [_UTF8StringToArray $txt] {
			if {$uni ni [_getList2Arr $CurrentFont subset]} {
				_setSubList CurrentFont subset $uni;
			}
		}
	} else { 
		set txt2 "([_escape $txt])";
	}	
	set s [format "BT %.2f %.2f Td %s Tj ET" [expr $x*$k] [expr ($h-$y)*$k] $txt2];
	if { $underline == 1 && $txt!="" } {
		append s " [_dounderline $x $y $txt]";
	}	
	if { $ColorFlag == 1 } {
		set s "$q $TextColor $s $Q";
	}	
	_out $s;
}

proc ::tclfpdf::AcceptPageBreak { } {
	variable AutoPageBreak;	
	;# Accept automatic page break or not
	return $AutoPageBreak;
}

proc ::tclfpdf::Cell {w1 {h1 0} {txt ""} {border 0} {ln 0} {align ""} {fill 0} {link ""}} {
	variable k;variable y;variable InFooter;variable InHeader;variable h;
	variable x; variable ws; variable rMargin; variable cMargin; variable PageBreakTrigger;
	variable ColorFlag;variable TextColor;variable lasth; variable w; variable FontSize; variable FontSizePt;
	variable underline;variable lMargin;variable CurOrientation; variable CurPageSize;
	variable CurRotation; variable unifontSubset; variable CurrentFont; variable fonts;
	;# Output a cell
	set k1 $k;
	if { [expr $y+$h1] >$PageBreakTrigger && !$InHeader && !$InFooter && [AcceptPageBreak] } {
		;# Automatic page break
		set x1 $x;
		set ws1 $ws;
		if {$ws1>0} {
			set ws 0; 
			_out "0 Tw";
		}
		AddPage $CurOrientation $CurPageSize $CurRotation;
		set x $x1;
		if {$ws1>0} {
			set ws $ws1; 
			_out [format "%.3f Tw" [expr $ws1*$k1]];
		}
	}
	if {$w1==0} {
		set w1 [expr $w-$rMargin-$x];
	}	
	set s "";
	if {$fill !=0 || $border==1} {
		if {$fill !=0} {
			set op [expr {$border==1 ? "B" : "f"}];
		} else {
			set op "S";
		}
		set s [format "%.2f %.2f %.2f %.2f re %s " [expr $x*$k1] [expr ($h-$y)*$k1] [expr $w1*$k1] [expr -$h1*$k1] $op];
	}
	if {[string is alpha $border]} {
		set x1 $x;
		set y1 $y;
		if {[string first "L" $border]!=-1} {
			append s [format "%.2f %.2f m %.2f %.2f l S " [expr $x1*$k1] [expr ($h-$y1)*$k1] [ expr $x1*$k1] [expr ($h-($y1+$h1))*$k1]];
		}	
		if {[string first "T" $border]!=-1} {
			append s [format "%.2f %.2f m %.2f %.2f l S " [expr $x1*$k1] [expr ($h-$y1)*$k1] [expr ($x1+$w1)*$k1] [expr ($h-$y1)*$k1] ];
		}	
		if {[string first "R" $border]!=-1} {
			append s [format "%.2f %.2f m %.2f %.2f l S " [expr ($x1+$w1)*$k1] [ expr ($h-$y1)*$k1] [ expr ($x1+$w1)*$k1] [ expr ($h-($y1+$h1))*$k1]];
		}	
		if {[string first "B" $border]!=-1} {
			append s [format "%.2f %.2f m %.2f %.2f l S " [expr $x1*$k1] [expr ($h-($y1+$h1))*$k1] [expr ($x1+$w1)*$k1] [expr ($h-($y1+$h1))*$k1]];
		}	
	}
	if {$txt != ""} {
		if {![isset CurrentFont]} {
			Error " No font has been set";
		}
		if { $align=="J" || $align=="" } {
			set align "L"
		}
		switch -- $align {
			"R" { set dx [expr $w1-$cMargin- [GetStringWidth $txt]] }
			"C" { set dx [expr ($w1-[GetStringWidth $txt ])/2.00] } 
			"L" { set dx $cMargin }
			default { Error " Invalid cell align: $align" }
		}
		if {$ColorFlag ==1 } {
			append s " q $TextColor ";
		}
		#If multibyte, Tw has no effect - do word spacing using an adjustment before each space
		if {$ws !=0 && $unifontSubset ==1} {
			foreach uni [_UTF8StringToArray $txt] {
				if {$uni ni [_getList2Arr $CurrentFont subset]} {
					_setSubList CurrentFont subset $uni;
				}
			}
			set space [_escape [_UTF8toUTF16BE " " 0]];
			append s [format "BT 0 Tw %.2f %.2f Td \[" [expr ($x+$dx)*$k] [expr ($h-($y+0.5*$h1+0.3*$FontSize))*$k]];
			set t [split $txt ];
			set numt [llength $t];
			for {set i 0} {$i<$numt} {incr i} {
				set tx [lindex $t $i];
				set tx "([_escape [_UTF8toUTF16BE $tx 0]])";
				append s [format "%s " $tx];
				if { ($i+1)<$numt} {
					set adj [expr int (-($ws*$k)*1000/$FontSizePt)];
					append s [format "%d(%s) " $adj $space];
				}
			}
			append s "\] TJ";
			append s " ET";
		} else {
			if {$unifontSubset==1} {
				set txt2 "([_escape [_UTF8toUTF16BE $txt 0]])";
				foreach uni [_UTF8StringToArray $txt] {
					if {$uni ni [_getList2Arr $CurrentFont subset]} {
						_setSubList CurrentFont subset $uni;
					}	
				}
			} else {
				set txt2 "([ _escape $txt])";
			}
			append s [format "BT %.2f %.2f Td %s Tj ET" [expr ($x+$dx)*$k] [expr ($h-($y+.5*$h1+.3*$FontSize))*$k] $txt2];
		}
		if {$underline == 1} {
			append s " [_dounderline [expr $x+$dx] [ expr $y+0.5*$h1+0.3*$FontSize] $txt]";
		}	
		if {$ColorFlag == 1} {
			append s " Q";
		}	
		if {$link!=""} {
			Link [expr $x+$dx] [expr $y+0.5*$h1-0.5*$FontSize] [GetStringWidth $txt ] $FontSize $link;
		}	
	}
	if {$s!=""} {
		_out $s;
	}	
	set lasth $h1;
	if {$ln>0} {
		;# Go to next line
		set y [expr $y+$h1];
		if {$ln==1} {
			set x $lMargin;
		}	
	} else {
		set x [expr $x+$w1];
	}
}

proc ::tclfpdf::MultiCell {w1 h1 txt {border 0} {align "J"} {fill 0}} {
	variable CurrentFont; variable v; variable rMargin; variable x; variable w; variable unifontSubset;
	variable FontSize;variable cMargin; variable ws; variable h; variable lMargin; variable k; variable TAB;
	;# Output text with automatic or explicit line breaks
	if {![isset CurrentFont]} {
		Error "No font has been set";
	}
	set cw [_getList2Arr $CurrentFont cw];
	if {$w1==0} {
		set w1 [expr $w-$rMargin-$x];
	}	
	set wmax [expr ($w1-2*$cMargin)];
	set s [string map [list \r "" \t $TAB] $txt];
	if {$unifontSubset == 1} {
		set nb [utf8len $s];
		while {$nb >0 && [utf8substr $s [expr $nb -1] 1] == "\n" } {
			incr nb -1;
		} 
	} else {
		set nb [string length $s];
		set idx [expr $nb-1]
		if {$nb>0 && [string index $s $idx] =="\n"} {
			incr nb -1;
		}
	}
	set b 0;
	if {$border!=0} {
		if {$border==1} {
			set border "LTRB";
			set b "LRT";
			set b2 "LR";
		} else {
			set b2 "";
			if {[string first "L" $border]!=-1} {
				append b2 L;
			}	
			if {[string first "R" $border]!=-1} {
				append b2 R;
			}	
			if {[string first "T" $border]!=-1} {
				append b T; 
			} else {
				set b $b2;
			}	
		}
	}
	set sep -1;
	set i 0;
	set j 0;
	set l 0;
	set ns 0;
	set nl 1;
	while {$i<$nb} {
		;# Get next character
		if {$unifontSubset==1} {
			set c [utf8substr $s $i 1 ];
		} else {	
			set c [string index $s $i];
		}	
		if {$c=="\n"} {
			;# Explicit line break
			if { $ws>0} {
				set ws 0;
				_out "0 Tw";
			}
			Cell $w1 $h1 [ utf8substr $s $j [expr $i-$j]] $b 2 $align $fill;
			incr i;
			set sep -1;
			set j $i;
			set l 0;
			set ns 0;
			incr nl;
			if {$border !=0 && $nl==2} {
				set b $b2;
			}	
			continue;
		}
		if {$c==" "} {
			set sep $i;
			set ls $l;
			incr ns;
		}
		if {$unifontSubset==1} { 
			set l [expr $l + [GetStringWidth $c]];
		} else {
			set l [expr $l + ([_findchar $cw $c]*$FontSize/1000)];
		}
		if {$l>$wmax } {
		;# Automatic line break
			if {$sep==-1} {
				if {$i==$j} {
					incr i;
				}	
				if { $ws>0} {
					set ws 0;
					_out "0 Tw";
				}
				Cell $w1 $h1 [utf8substr $s $j [expr $i-$j]] $b 2 $align $fill;
			} else {			
				if {$align=="J"} {
					set ws [expr {($ns>1) ? ($wmax-$ls)/($ns-1) : 0}];
					_out [format "%.3f Tw" [expr $ws*$k]];
				}
				Cell $w1 $h1 [utf8substr $s $j [expr $sep-$j]] $b 2 $align $fill;
				set i [expr $sep + 1];
			}
			set sep -1;
			set j $i;
			set l 0;
			set ns 0;
			incr nl;
			if {$border!=0 && $nl==2} {
				set b $b2;
			}
		} else {
			incr i;
		}
	}
	;# Last chunk
	if { $ws>0} {
		set ws 0;
		_out "0 Tw";
	}
	if {$border!=0 && [string first "B" $border]!=-1} {
		append b "B";
	}
	Cell $w1 $h1 [utf8substr $s $j [expr $i-$j]] $b 2 $align $fill;
	set x $lMargin;
}

proc ::tclfpdf::Write { h1 txt {link "" }} {
	variable CurrentFont; variable w; variable rMargin; variable lMargin;
	variable x; variable FontSize; variable cMargin; variable y; variable unifontSubset;
	variable TAB;
	;# Output text in flowing mode
	if {![isset CurrentFont]} {
		Error "No font has been set";
	}
	set cw [_getList2Arr $CurrentFont cw];
	set w1 [expr $w-$rMargin-$x];
	set wmax [expr ($w1-2*$cMargin)];
	set s [string map [list \r "" \t $TAB] $txt];
	if {$unifontSubset==1} {
		set nb [utf8len $s];
		if {$nb==1 && $s==" "} {
			set x [expr $x + [GetStringWidth $s]];
			return;
		}
	} else {
		set nb [ string length $s ];
	}
	set sep -1;
	set i 0;
	set j 0;
	set l 0;
	set nl 1;
	while {$i<$nb} {
		;# Get next character
		set c [utf8substr $s $i 1];
		if {$c=="\n"} {
			;# Explicit line break
			Cell $w1 $h1 [ utf8substr $s $j [expr $i-$j] ] 0 2 "" 0 $link;
			incr i;
			set sep -1;
			set j $i;
			set l 0;
			if {$nl==1} {
				set x $lMargin;
				set w1 [expr $w-$rMargin-$x];
			set wmax [expr ($w1-2*$cMargin)];
			}
			incr nl;
			continue;
		}
		if {$c==" "} {
			set sep $i;
		}
		if {$unifontSubset==1} { 
			set l [expr $l + [GetStringWidth $c]];
		} else {
			set l [expr $l + ([_findchar $cw $c]*$FontSize/1000)];
		}
		if {$l>$wmax} {
			;# Automatic line break
			if {$sep==-1} {
				if { $x>$lMargin} {
					;# Move to next line
					set x $lMargin;
					set y [expr $y+ $h1];
					set w1 [expr $w-$rMargin-$x];
					set wmax [expr ($w-2*$cMargin)];
					incr i;
					incr nl;
					continue;
				}
				if {$i==$j} {
					incr i;
				}
				Cell $w1 $h1 [utf8substr $s $j [expr $i-$j ]] 0 2 "" 0 $link;
			} else {
				Cell $w1 $h1 [utf8substr $s $j [expr $sep-$j ]] 0 2 "" 0 $link;
				set i [expr $sep+1];
			}
			set sep -1;
			set j $i;
			set l 0;
			if {$nl==1} {
			set x $lMargin;
				set w1 [expr $w-$rMargin-$x];
				set wmax [expr ($w1-2*$cMargin)];
			}
			incr nl;
		} else {
			incr i;
		}
	}
	;# Last chunk
	if {$i !=$j} {
		Cell $l $h1 [ utf8substr $s $j ] 0 0 "" 0 $link;
	}
}

proc ::tclfpdf::Ln { {h ""} } {
	variable lMargin;variable y; variable lasth;variable x;
	;# Line feed; default value is the last cell height
	set x $lMargin;
	if {$h==""} {
		set y [ expr $y+ $lasth];
	} else {
		set y [expr $y+$h];
	}	
}

proc ::tclfpdf::Image { file { x1 "" } { y1 "" } { w1 "" } { h1 "" } { type1 "" } { link1 "" } } {
	variable images; variable k; variable y; variable x; variable Link;variable h;
	variable PageBreakTrigger; variable InHeader; variable InFooter;
	variable CurOrientation; variable CurPageSize; variable CurRotation

	if {$w1 eq {}} {
		set w1 0
	}
	if {$h1 eq {}} {
		set h1 0
	}
	
	;# Put an image on the page
	set file1 [file tail $file];
	if {$file1 == ""} {
		Error "Image file name is empty";
	}
	if {[lsearch [array names images] $file1 ] ==-1}	{
		;# First use of this image, get info
		if {$type1==""} {
			set pos [string last "." $file1];
			if {$pos==-1} {
				Error "Image file has no extension and no type was specified: $file";
			}	
			set type1 [_substr $file1 [expr $pos+1] ];
		}
		set type1 [string tolower $type1];
		if {$type1=="jpeg"} {
			set type1 "jpg";
		}
		set mtd "_parse$type1";
		if {[lsearch [info procs] $mtd] == -1} {
			Error "Unsupported image type: $type1";
		}
		array set info [$mtd $file];
		array set info "i [expr [array size images]+1]";
		set imagesl [ list [array get info]];
		array set images "$file1 $imagesl";
	} else {
		array set info $images($file1);
	}	
	;# Automatic width and height calculation if needed
	if {$w1==0 && $h1==0}	{
		;# Put image at 96 dpi
		set w1 -96;
		set h1 -96;
	}
	if {$w1<0} {
		set w1 [expr -$info(w)*72/$w1/$k];
	}	
	if {$h1<0} {
		set h1 [expr -$info(h)*72/$h1/$k];
	}	
	if {$w1==0} {
		set w1 [expr $h1*$info(w)/$info(h)];
	}	
	if {$h1==0} {
		set h1 [expr $w1*$info(h)/$info(w)];
	}	
	;# Flowing mode
	if {$y1==""} {
		if { [expr $y+$h1]>$PageBreakTrigger && !$InHeader && !$InFooter && [AcceptPageBreak] } {
			;# Automatic page break
			set x2 $x;
			AddPage $CurOrientation $CurPageSize $CurRotation;
			set x $x2;
		}
		set y1 $y;
		set y [expr $y+$h1];
	}
	if {$x1==""} {
		set x1 $x;
	}
	_out [format "q %.2f 0 0 %.2f %.2f %.2f cm /I%d Do Q" [expr $w1*$k] [expr $h1*$k] [expr $x1*$k] [expr ($h-($y1+$h1))*$k] $info(i) ];
	if {$link1!=""} {
		Link $x1 $y1 $w1 $h1 $link1;
	}	
}

proc ::tclfpdf::GetPageWidth {} {
	variable w;
	return $w;
}

proc ::tclfpdf::GetPageHeight {} {
	variable h;
	return $h;
}

proc ::tclfpdf::GetX { } {
	;# Get x position
	variable x;
	return $x;
}

proc ::tclfpdf::SetX { x1 } {
	;# Set x position
	variable x; variable w;
	if {$x1 >=0} {
		set x $x1;
	} else {
		set x [expr $w+$x1];
	}	
}

proc ::tclfpdf::GetY { } {
	;# Get y position
	variable y;
	return $y;
}

proc ::tclfpdf::SetY { y1 {resetX 1 }} {
	;# Set y position and optionally reset x
	variable lMargin; variable y; variable x; variable h;	
	if {$y1 >=0} {
		set y $y1;
	} else {	
		set y [expr $h+$y1];
	}
	if {$resetX } {
		set x $lMargin;
	}
}

proc ::tclfpdf::SetXY { x1 y1 } {
	;# Set x and y positions
	SetX $x1;
	SetY $y1 0;

}

proc ::tclfpdf::Output { {name "doc.pdf" } { dest "f" } } {
	variable state; variable page;
	variable buffer;
	variable TCLFPDF_USERPATH;
	;# Output PDF to some destination
	Close;
	set dest [string tolower $dest];
	switch $dest {
		"f"	{
			;# Save to local file
			if { [file writable [file dirname [info script]] ]== 0 } {
				set name [file join $TCLFPDF_USERPATH $name]
			} 
			if { [catch {open $name "wb"} f] } {
				Error "Can't save file $name"
			};
			puts -nonewline $f $buffer;
			close $f ;
			}
		"s"
			{
			;# Return as a string
			return $buffer;
			}
		default
			{
			Error "Incorrect output destination: $dest";
			}
	}
	;# Mimic Init (reset) : zero state
	set page 0;
	set state 0;
}

proc ::tclfpdf::_getpagesize {size} {
	variable StdPageSizes; variable k;

	if {[string is wordchar $size]} {
		set size [string tolower $size ];
		if { [lsearch [array names StdPageSizes] $size] == -1} {
			Error "Unknown page size: $size";
		}	
		set s $StdPageSizes($size);
		set a [expr [lindex $s 0]/$k];
		set b [expr [lindex $s 1]/$k];
		set lreturn [list $a $b];
	} else {
		set a [lindex $size 0];
		set b [lindex $size 1];
		if { $a > $b } {
			set lreturn [list $b $a ];
		} else {
			set lreturn [list $a $b ];
		}
	}	
	return $lreturn;
}

proc ::tclfpdf::_beginpage { orientation size rotation} {
	variable page; variable pages;variable PageLinks; variable PageInfo;
	variable state; variable lMargin; variable tMargin; variable bMargin;
	variable FontFamily; variable DefOrientation; 
	variable DefPageSize; variable CurOrientation; variable CurPageSize;
	variable x;variable y;variable w; variable h; variable k;
	variable wPt; variable hPt; variable PageBreakTrigger; variable CurRotation;
	
	incr page;
	set pages($page) {};
	set PageLinks($page) {};
	set state 2;
	set x $lMargin;
	set y $tMargin;
	set FontFamily "";
	;# Check page size and orientation
	if {$orientation==""} {
		set orientation $DefOrientation;
	} else {
		set orientation [string toupper [string index $orientation 0]];
	} 
	if {$size==""} {
		set size $DefPageSize;
	} else {
		set size [_getpagesize $size];
	}
	if {$orientation!=$CurOrientation || [lindex $size 0]!=[lindex $CurPageSize 0] || [lindex $size 1]!=[lindex $CurPageSize 1]} {
		;# New size or orientation
		if {$orientation=="P"} {
			set w [lindex $size 0];
			set h [lindex $size 1];
		} else {
			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 CurOrientation $orientation;
		set CurPageSize $size;
	}
	if {$orientation!=$DefOrientation || [lindex $size 0]!=[lindex $DefPageSize 0] || [lindex $size 1]!= [lindex $DefPageSize 1]} {
		set PageInfo($page,size) [list $wPt $hPt];
	}
	if {$rotation!=0} {
		if {$rotation%90!=0} {
			Error "Incorrect rotation value: $rotation";
		}
		set PageInfo($page,rotation) $rotation;		
	}
	set CurRotation $rotation;
}

proc ::tclfpdf::_endpage { } {
	variable state;
	
	set state 1;
}

proc ::tclfpdf::_loadfont { font } {

	;# Load a font definition file from the font directory
	source -encoding utf-8 [_SearchPathFile $font];
	if {![isset name]} {
		Error "Could not include font definition file: $font";
	}
	if {[isset enc] } {
		set enc [string tolower $enc];
	}
	if {![isset subsetted] } {
		set subsetted 0;
	}
	foreach v [info locals] {
		if {$v=="font"} continue;
		if {[array exists $v] } {
			lappend l $v [array get $v];
		} else {
			lappend l $v [set $v];
		}
	}
	return $l;
}

proc ::tclfpdf::_escape { s } {
	;# Escape special characters in strings
	return [string map {
				"\\" "\\\\"
				"(" "\\("
				")" "\\)"
				"\r" "\\r"
				"\t" "\\t"
				} $s]
}

proc ::tclfpdf::_textstring { s } {
	;# Format a text string
	if {![string is ascii -strict $s] } {
		set s [_UTF8toUTF16BE $s 1];
	}
	return "([_escape $s])";
}

proc ::tclfpdf::_dounderline { x1 y1 txt } {
	;# Underline text
	variable CurrentFont; variable ws; variable k; variable h; variable FontSize; variable FontSizePt;
	set up [_getList2Arr $CurrentFont up];
	set ut [_getList2Arr $CurrentFont ut];
	set w1 [expr [GetStringWidth $txt]+$ws*[expr {[llength [split $txt " "]] - 1}]];
	return [format "%.2f %.2f %.2f %.2f re f" [expr $x1*$k] [expr ($h-($y1-$up/1000.00*$FontSize))*$k] [expr $w1*$k] [expr -$ut/1000.00*$FontSizePt] ];
}

proc ::tclfpdf::_parsejpg { file } {
	;# Based on the method addJpeg of pdf4tcl 
	set imgOK false;
	if {[catch {open $file "rb"} fr] } {
		Error "Can't open file $file";
	}
	set img [read $fr];
	close $fr;
	binary scan $img "H4" h;
	if {$h != "ffd8"} {
		Error "File $file doesn't contain JPEG data.";
	}
	set pos 2;
	set img_length [string length $img];
	while {$pos < $img_length} {
		set endpos [expr {$pos+4}];
		binary scan [string range $img $pos $endpos] "H4S" h length;
		set length [expr {$length & 0xffff}];
		if {$h == "ffc0" || $h == "ffc2"} {
			incr pos 4;
			set endpos [expr {$pos+6}];
			binary scan [string range $img $pos $endpos] "cSSc" bits height width channels;
			set height [expr {$height & 0xffff}];
			set width [expr {$width & 0xffff}];
			set imgOK true;
			break;
		} else {
			incr pos 2;
			incr pos $length;
		}
	}
	if {!$imgOK} {
		Error "Something is wrong with jpeg data in file $file";
	} 
	if {$channels ==3} {
		set colspace "DeviceRGB";
	} elseif {$channels==4} {
		set colspace "DeviceCMYK";
	} else {
		set colspace "DeviceGray";
	}
	if {$bits !=""} {
		set bpc $bits;
	} else { 
		set bpc 8;
	}
	array set jpeg [ list w $width h $height cs $colspace bpc $bpc f DCTDecode data $img];
	return [array get jpeg]
}

proc ::tclfpdf::_parsepng { file} {
	;# Extract info from a PNG file
	if {[catch {open $file "rb"} f]} {
		Error "Can't open image file: $file";
	}
	set info [ _parsepngstream $f $file];
	close $f;
	return $info;
}

proc ::tclfpdf::_parsepngstream { f file } {
	variable PDFVersion; variable WithAlpha;
	;# Check signature
	if { [_readstream $f 8]!="[format %c 137]PNG[format %c 13][format %c 10][format %c 26][format %c 10]"} {
		Error "Not a PNG file: $file";
	}
	;# Read header chunk
	_readstream $f 4;
	if { [_readstream $f 4] !="IHDR"} {
		Error "Incorrect PNG file: $file";
	}
	set w [ _readint $f];
	set h [ _readint $f];
	set bpc [scan [_readstream $f 1] %c];
	if {$bpc>8} {
		Error "16-bit depth not supported: $file";
	}
	set ct [scan [_readstream $f 1] %c];
	if {$ct==0 || $ct==4} {
		set colspace "DeviceGray";
	} elseif {$ct==2 || $ct==6} {
		set colspace "DeviceRGB";
	} elseif {$ct==3} {
		set colspace "Indexed";
	} else {
		Error "Unknown color type: $file";
	}
	if {[scan [_readstream $f 1] %c] != 0} {
		Error "Unknown compression method: $file";
	}
	if {[scan [_readstream $f 1] %c] != 0} {
		Error "Unknown filter method: $file";
	}
	if {[scan [_readstream $f 1] %c] != 0} {
		Error "Interlacing not supported: $file";
	}
	_readstream $f 4;
	if {$colspace=="DeviceRGB"} {
		set colspace1 3;
	} else {
		set colspace1 1;
	}
	set dp "/Predictor 15 /Colors $colspace1 /BitsPerComponent $bpc /Columns $w";
	;# Scan chunks looking for palette, transparency and image data
	set pal "";
	set trns "";
	set data "";
	while {1} {
		set n [_readint $f];
		set type [_readstream $f 4];
		if {$type=="PLTE"} {
			;# Read palette
			set pal [_readstream $f $n];
			_readstream $f 4;
		} elseif {$type=="tRNS"} {
			;# Read transparency info
			set t [ _readstream $f $n];
			if {$ct==0} {
				array set trns 0 [scan [_substr $t 1 1 ] %c]
			} elseif {$ct==2} {
				array set trns array [list [scan [_substr $t 1 1] %c] [scan [_substr $t 3 1] %c] [scan [_substr $t 5 1] %c] ];
			} else {
				set pos [ string first [format %c 0] $t];
				if {$pos!=0} {
					set trns array($pos);
				}
			}
			_readstream $f 4;
		} elseif {$type=="IDAT"} {
			;# Read image data block
			set data "$data[_readstream $f $n]";
			_readstream $f 4;
		} elseif {$type=="IEND"} {
			break;
		} else {
			_readstream $f [expr $n+4];
		}
		if {!$n} break;
	}
	if {$colspace=="Indexed" && $pal==""} {
		Error "Missing palette in $file";
	}
	array set info [list w $w h $h cs $colspace bpc $bpc f FlateDecode dp $dp pal $pal trns $trns];
	if {$ct>=4} {
		;# Extract alpha channel
		set data [zlib decompress $data];
		set color "";
		set alpha "";
		if {$ct==4} {
			;# Gray image
			set len [expr 2*$w];
			for {set i 0} {$i<$h} {incr i} {
				set pos [expr (1+$len)*$i];
				set color "$color[string index $data $pos]";
				set alpha "$alpha[string index $data $pos]";
				set line [_substr $data [expr $pos+1] $len];
				append color [regexp "/(.)./s" $1 $line];
			append alpha [regexp "/.(.)/s" $1 $line];
			}
		} else {
			;# RGB image
			set len [expr 4*$w];
			for {set i 0} {$i<$h} { incr i} {
				set pos [expr (1+$len)*$i];
			set color "$color[string index $data $pos]";
			set alpha "$alpha[string index $data $pos]";
			set line [_substr $data [expr $pos+1] $len];
				set color1 [regsub -all "(.{3})." $line {\1}];
			set color "$color$color1";
				set alpha1 [regsub -all ".{3}(.)" $line {\1}];
				set alpha "$alpha$alpha1";				
			}
		}
		unset data;
		set data [zlib compress $color];
		array set info "smask [list [zlib compress $alpha]]";
		set WithAlpha 1;
		if { $PDFVersion < "1.4" } {
			set PDFVersion "1.4";
		}
	}
	array set info [list data $data];
	return [array get info];
}

proc ::tclfpdf::_readstream {f n} {
	;# Read n bytes from stream
	set res "";
	while {$n>0 && ![eof $f]} {
		set s [read $f $n];
		if {$s==0} {
		Error "Error while reading stream";
		}	
		set n [expr $n-[string length $s]];
		append res $s;
	}
	if {$n>0} {
		Error "Unexpected end of stream";
	}	
	return $res;
}

proc ::tclfpdf::_readint { f } {
	;# Read a 4-byte integer from stream
	set dummy [_readstream $f 4];
	binary scan $dummy I a;
	return $a;
}

proc ::tclfpdf::_parsegif { file } {
;#Note: sometimes there are some problems converting GIF to PNG
;# using img. One alternative is use the utility gif2png an then load the file as PNG
	set img "_$file"
	image create photo $img 
	;#first frame in case of animated GIF
	$img read $file -format "gif -index 0"
	set tmp $file.png
	$img write $tmp
	set info [_parsepng $tmp]
	file delete $tmp
	return $info
}

proc ::tclfpdf::_out { s } {
	variable state;variable page; variable pages;
	; variable n;
	;# Add a line to the document
	if { $state==2} {
		array set pages "$page [list "$pages($page)$s\n"]";
	} elseif { $state == 1} {
		_put $s;
	} elseif { $state == 0} {
		Error "No page han been added yet";
	} elseif { $state == 3} {
		Error "The document is closed";
	}
}

proc ::tclfpdf::_put { s } {
	variable buffer;
	append buffer "$s\n";	
}

proc ::tclfpdf::_getoffset { } {
	variable buffer;
	return [string length $buffer];
}

proc ::tclfpdf::_newobj { { _n {} } } {
	variable n; variable offsets;
	;# Begin a new object
	if {$_n=={}} {
		set _n [ incr n ];
	}	
	set offsets($_n) [_getoffset];
	_put "$_n 0 obj";
}

proc ::tclfpdf::_putstream { data } {
	_put "stream";
	_put $data;
	_put "endstream";
}

proc ::tclfpdf::_putstreamobject { data } {
	variable compress;
	if {$compress==1} {
		set entries "/Filter /FlateDecode ";
		set data [zlib compress $data];
	} else {
		set entries "";
	}
	append entries "/Length [string length $data]";
	_newobj;
	_put "<<$entries>>";
	_putstream $data;
	_put "endobj";
}

proc ::tclfpdf::_putlinks { n } {
	variable PageLinks; variable links; 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 "<</Type /Annot /Subtype /Link /Rect \[$rect\] /Border \[0 0 0\] ";
		if {![string is integer $pl(4)]} {
			append s "/A <</S /URI /URI [_textstring $pl(4)]>>>>"; # URI need parenthesis but it come from _textstring
		} else {
			lassign $links($pl(4)) l(0) l(1);
			if {[isset PageInfo($l(0),size)] } {
				lassign $Pageinfo($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 WithAlpha;
	variable n; variable AliasNbPages; variable pages; variable page;
	variable PageLinks; 
	
	_newobj;
	_put "<</Type /Page";
	_put "/Parent 1 0 R";
	if {[isset PageInfo($n0,size)] } {
		lassign $PageInfo($n0,size) PS(0) PS(1);
		_put [format "/MediaBox \[0 0 %.2f %.2f\]" $PS(0) $PS(1)];
	}
	if {[isset PageInfo($n0,rotation)] } {
		_put "/Rotate PageInfo($n,rotation)";
	}
	_put "/Resources 2 0 R" ;
	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 <</Type /Group /S /Transparency /CS /DeviceRGB>>";	
	}
	_put "/Contents [expr $n+1] 0 R>>";
	_put "endobj";
	# Page content
	if {$AliasNbPages != ""} {
		set alias [_UTF8toUTF16BE $AliasNbPages 0];
		set r [_UTF8toUTF16BE $page 0];
		set pages($n0) [string map "$alias $r" $pages($n0)];
		 # Now repeat for no pages in non-subset fonts
		 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 PageLinks;

	set nb $page;
	set nn $n;
	for {set n1 1} {$n1<=$nb } {incr n1} {
		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		
	}
	# Pages root
	_newobj 1;
	_put "<</Type /Pages";
	set kids "/Kids \[";
	for {set n3 1} {$n3<=$nb} {incr n3} {
		append kids "$PageInfo($n3,n) 0 R ";
	}
	_put "$kids\]";
	_put "/Count $nb";
	if { $DefOrientation=="P"} {
		set w1 [lindex $DefPageSize 0];
		set h1 [lindex $DefPageSize 1];
	} else {
		set w1 [lindex $DefPageSize 1];
		set h1 [lindex $DefPageSize 0];
	}
	_put [format "/MediaBox \[0 0 %.2f %.2f\]" [expr $w1*$k] [expr $h1 * $k]];
	_put ">>";
	_put "endobj";
}

proc ::tclfpdf::_putfonts { } {
	variable n; variable diffs;variable FontFiles; variable fonts; 
	variable TCLFPDF_COREFONTSPATH; variable CurrentFont;

	foreach {file info0} [array get FontFiles] {
		array set _info $info0 ;
		if {![isset _info(type)] || $_info(type)!="TTF" } {
			# Font file embedding
			_newobj;
			set FontFiles($file,n) $n;
			set file [_SearchPathFile $file];
			if { [catch {open $file "rb" } fp ] } {
				Error "Couldn't to open file : $file - $fp";
			}
			set font [read $fp];
			close $fp;
			set compressed [string equal [file extension $file] ".z"];
			if {!$compressed && [isset _info(length2)] } {
				set font [_substr $font 6 $_info(length1)][ _substr $font [expr 6 + $_info(length1)+6] $_info(length2)];
			}
			_put "<</Length [string length $font]";
			if {$compressed} {
				_put "/Filter /FlateDecode";
			}
			_put "/Length1 $_info(length1)";
			if {[isset _info(length2)] } {
				_put "/Length2 $_info(length2) /Length3 0";
			}
			_put ">>";
			_putstream $font;
			_put "endobj";
		}	
	}
	foreach {k1 _font11} [_ordarray fonts ascii] {
		array set font11 $_font11;
		#Encodings
		if {[isset font11(diff)] } {
			if {![isset encodings($font11(enc))]} {
				_newobj;
				_put "<</Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences \[$font11(diff)\]>>";
				_put "endobj";
				set $encodings($font11(enc)) $n;
			}
		}
		#ToUnicode CMap
		if {[isset font11(uv)]} {
			if { [isset font11(enc)] } {
				set cmapkey $font11(enc);
			} else {
				set cmapkey $font11(name);
			}	
			if {![isset cmaps($cmapkey)] } {
				set cmap [_tounicodecmap $font11(uv)];
				_putstreamobject $cmap;
				set cmaps($cmapkey) $n;
			}
		}
		;# Font objects
		set type $font11(type);
		set name $font11(name);
		if {$type=="Core"} {
			;#Core font
			set fonts($k1) "$fonts($k1) n [expr $n+1]";
			_newobj;
			_put "<</Type /Font";
			_put "/BaseFont /$name";
			_put "/Subtype /Type1";
			if {$name!="Symbol" && $name!="ZapfDingbats"} {
				_put "/Encoding /WinAnsiEncoding";
			}
			if { [isset font11(uv)] } {
				_put "/ToUnicode $cmaps($cmapkey) 0 R";
			}	
			_put ">>";
			_put "endobj";
		} elseif {$type=="Type1" || $type=="TrueType"} {
			;# Additional Type1 or TrueType/OpenType font
			if { [isset font11(subsetted)] && $font11(subsetted)} {
				set name "AAAAAA+$name";
			}
			set fonts($k1) "$fonts($k1) n [expr $n+1]";
			_newobj ;
			_put "<</Type /Font";
			_put "/BaseFont /$name";
			_put "/Subtype /$type";
			_put "/FirstChar 32 /LastChar 255";
			_put "/Widths [expr ($n+1)] 0 R";
			_put "/FontDescriptor [expr ($n+2)] 0 R";
			if { $font11(enc) != ""} {
				if {[isset font11(diff)] } {
					_put "/Encoding $encoding($font1(enc)) 0 R";
				} else {
					_put "/Encoding /WinAnsiEncoding";
				}
			}
			if {[isset font11(uv)]} {
				_put "/ToUnicode $cmaps($cmapkey) 0 R";
			}
			_put ">>";
			_put "endobj";
			;# Widths
			_newobj;
			array set cw $font11(cw);
			set s "\[";
			for {set i 32} {$i<=255 } {incr i} {
				set chr [format %c $i]
				append s "$cw($chr) ";
			}
			_put "$s\]";
			_put "endobj";
			;# Descriptor
			_newobj;
			set s "<</Type /FontDescriptor /FontName /$name";
			foreach {k v} $font11(desc) {
				append s " /$k $v";
			}
			if {$font11(file)!=""} {
				if {$type=="Type1"} { 
					set tipo ""
				} else {
					set tipo "2"
				}
				append s " /FontFile$tipo $FontFiles($font11(file),n) 0 R";
			}	
			_put "$s>>";
			_put "endobj";
		} elseif {$type=="TTF"} {
			;# TrueType embedded SUBSETS or FULL
			set fonts($k1) "$fonts($k1) n [expr $n+1]";
			source -encoding utf-8 "$TCLFPDF_COREFONTSPATH/ttf_font.tcl";
			ttf_Init;
			set fontname "MPDFAA+$font11(name)";
			set subset $font11(subset);
			_lremove subset 0;
			set ttfontstream [ttf_makeSubset $font11(ttffile) $subset];
			set ttfontsize [string length $ttfontstream];
			set fontstream [zlib compress $ttfontstream];
			array set codeToGlyph [array get ttf_codeToGlyph];
			if {[info exists codeToGlyph(0)] } {
				unset codeToGlyph(0);
			}
			;#Typeo Font
			;#A composite font - a font composed of other fonts, organized hierarchically
			_newobj;
			_put "<</Type /Font";
			_put "/Subtype /Type0";
			_put "/BaseFont /$fontname";
			_put "/Encoding /Identity-H"; 
			_put "/DescendantFonts \[[expr $n + 1] 0 R\]";
			_put "/ToUnicode [expr $n + 2] 0 R";
			_put ">>";
			_put "endobj" ;

			;#CIDFontType2
			;#A CIDFont whose glyph descriptions are based on TrueType font technology
			_newobj;
			_put "<</Type /Font" ;
			_put "/Subtype /CIDFontType2" ;
			_put "/BaseFont /$fontname" ;
			_put "/CIDSystemInfo [expr $n + 2] 0 R" ; 
			_put 	"/FontDescriptor [expr $n + 3] 0 R" ;
			array unset font111 *;
			array set font111 $font11(desc);
			if { [isset font111(MissingWidth) 0]} {
				_out "/DW $font111(MissingWidth) " ;
			}

			_putTTfontwidths [array get font11] $ttf_maxUni;

			_put "/CIDToGIDMap [expr $n + 4] 0 R" ;
			_put ">>" ;
			_put "endobj" ;

			;#ToUnicode
			_newobj;
			set toUni "/CIDInit /ProcSet findresource begin\n";
			append toUni "12 dict begin\n";
			append toUni "begincmap\n";
			append toUni "/CIDSystemInfo\n";
			append toUni "<</Registry (Adobe)\n";
			append toUni "/Ordering (UCS)\n";
			append toUni "/Supplement 0\n";
			append toUni ">> def\n";
			append toUni "/CMapName /Adobe-Identity-UCS def\n";
			append toUni "/CMapType 2 def\n";
			append toUni "1 begincodespacerange\n";
			append toUni "<0000> <FFFF>\n";
			append toUni "endcodespacerange\n";
			append toUni "1 beginbfrange\n";
			append toUni "<0000> <FFFF> <0000>\n";
			append toUni "endbfrange\n";
			append toUni "endcmap\n";
			append toUni "CMapName currentdict /CMap defineresource pop\n";
			append toUni "end\n";
			append toUni "end";
			_put "<</Length [string length $toUni]>>" ;
			_putstream $toUni;
			_put "endobj" ;

			;#CIDSystemInfo dictionary
			_newobj;
			_put "<</Registry (Adobe)" ; 
			_put "/Ordering (UCS)" ;
			_put "/Supplement 0" ;
			_put ">>" ;
			_put "endobj" ;

			;#Font descriptor
			_newobj;
			_put "<</Type /FontDescriptor" ;
			_put "/FontName /$fontname";
			foreach { kd v } $font11(desc) {
				if {$kd == "Flags"} { 
					set v [expr $v | 4]; 
					set v [expr $v & ~32];
				}	;#SYMBOLIC font flag
				_out " /$kd $v";
			}
			_put "/FontFile2 [expr $n + 2] 0 R" ;
			_put ">>" ;
			_put "endobj" ;

			;#Embed CIDToGIDMap
			;#A specification of the mapping from CIDs to glyph indices
			set cidtogidmap [string repeat "\x00" [expr 256*256*2]];
			foreach {cc glyph} [array get codeToGlyph] {
				_setchar cidtogidmap [expr $cc*2] [format %c [expr $glyph >> 8]];
				_setchar cidtogidmap [expr $cc*2 + 1] [format %c [expr $glyph & 0xFF]];
			}
			set cidtogidmap [zlib compress $cidtogidmap];
			_newobj;
			_put "<</Length [string length $cidtogidmap]" ;
			_put "/Filter /FlateDecode" ;
			_put ">>" ;
			_putstream $cidtogidmap;
			_put "endobj" ;

			;#Font file 
			_newobj;
			_put "<</Length [string length $fontstream]";
			_put "/Filter /FlateDecode" ;
			_put "/Length1 $ttfontsize";
			_put ">>" ;
			_putstream $fontstream;
			_put "endobj" ;
		} else {
			;# Allow for additional types
			set fonts($k1) "$fonts($k1) n [expr $n+1]";
			set mtd "_put[string tolower $type]";
			if {[info procs $mtd]==0} {
				Error "Unsupported font type: $type";
			}	
			[eval $mtd $font1];
		}
	}
}

proc ::tclfpdf::_putTTfontwidths { font0 maxUni} {

	array set font $font0;
	if {[file exists $font(unifilename).cw127.tcl]} {
		source -encoding utf-8 $font(unifilename).cw127.tcl;
		set startcid 128;
	} else {
		set rangeid 0;
		array set range {};
		set prevcid -2;
		set prevwidth -1;
		set interval 0;#false
		set startcid 1;
	}
	set cwlen [expr $maxUni + 1]; 

	#for each character
	for {set cid $startcid} {$cid<$cwlen} {incr cid} {
		if {$cid==128 && ![file exists $font(unifilename).cw127.tcl]} {
			if {[catch {open "$font(unifilename).cw127.tcl" "wb" } fh ]} {
				Error "Can't open file: $font(unifilename).cw127.tcl";
			}
			set cw127 "#-------\n";
			append cw127 "set rangeid $rangeid;\n";
			append cw127 "set prevcid $prevcid;\n";
			append cw127 "set prevwidth $prevwidth;\n";
			if {$interval} { 
				append cw127 "set interval 1;\n";#true
			} else { 
				append cw127 "set interval 0;\n";#false
			}
			append cw127 "array set range \[list [_ordarray range]\];\n";
			append cw127 "#------";
			puts -nonewline $fh $cw127; 
			close $fh;
		}
		set cid2 [_getchar $font(cw) [expr $cid*2]];
		set cid3 [_getchar $font(cw) [expr $cid*2+1]];

		if { $cid2 == "" || $cid3 == "" || $cid2 == "\00" && $cid3 == "\00" } {
			continue;
		}
		set width [expr ([scan [_getchar $font(cw) [expr $cid*2]] %c] << 8) + [scan [_getchar $font(cw) [expr $cid*2+1]] %c] ];
		if {$width == 65535} { 
			set width 0;
		}
		set f_s [lsearch $font(subset) $cid]
		if {$cid > 255 && ($f_s ==-1 || !$f_s)} {
			continue;
		}
		if { ![isset font(dw)] || [isset font(dw)] && $width != $font(dw) } {
			if {$cid == [expr $prevcid + 1]} {
				if {$width == $prevwidth} {
					if {$width == [lindex $range($rangeid) 0]} {
						lappend range($rangeid) $width;
					} else {
						_lremove range($rangeid) end;
						#new range
						set rangeid $prevcid;
						lappend range($rangeid) $prevwidth;
						lappend range($rangeid) $width;
					}
					set interval 1;#true
					if {[lsearch $range($rangeid) "interval 1"]==-1} {
						lappend range($rangeid) "interval 1" ;#true
					}
				} else {
					if {$interval} {
						;#new range
						set rangeid $cid;
						lappend range($rangeid) $width;
					} else {
						lappend range($rangeid) $width;
					}
					set interval 0;#false
				}
			} else {
				set rangeid $cid;
				lappend range($rangeid) $width;
				set interval 0;#false
			}
			set prevcid $cid;
			set prevwidth $width;
		}
	}
	set prevk -1;
	set nextk -1;
	set prevint 0;#false
	foreach {k ws} [_ordarray range] {
		set cws [llength $ws];
		if {($k == $nextk) && (!$prevint) && ([lsearch $range($k) "interval 1"] ==-1 || ($cws < 4))} {
			if { [lsearch $range($k) "interval 1"] !=-1 } { 
				_lremove range($k) "interval 1"
			}
			set range($prevk) [concat $range($prevk) $range($k)];			
			unset range($k);
		} else {
			set prevk $k;
		}
		set nextk [expr $k + $cws];
		if { [lsearch $ws "interval 1"] != -1 } {
			if {$cws > 3} {
				set prevint 1;#true
			} else {
				set prevint 0;# false
			}
			if {[isset range($k) 0] } { ;# not in the original, in PHP dont throw error
				_lremove range($k) "interval 1"
			}	
			incr nextk -1;
		} else {
			set prevint 0;# false
		}
	}
	set w "";
	foreach { k ws} [_ordarray range] {
		if {[ _countVal $ws] == 1} {
			append w " $k [expr $k + [llength ($ws)] - 1] [lindex $ws 0]";
		} else {
			append w " $k \[ [split $ws] \] \n";
		}
	}
	_out "/W \[$w\]";
}

proc _tounicodecmap { uv } {
	set ranges {};
	set nbr 0;
	set chars {};
	set nbc 0;
	foreach {c v} [lsort -stride 2 -integer $uv] {
		if { [llength $v] > 1 } {
			append ranges [format "<%02X> <%02X> <%04X>\n" $c [expr $c+[lindex $v 1]-1] [lindex $v 0] ];
			incr nbr;
		} else {
			append chars [format "<%02X> <%04X>\n" $c $v];
			incr nbc;
		}
	}
	append s "/CIDInit /ProcSet findresource begin\n";
	append s "12 dict begin\n";
	append s "begincmap\n";
	append s "/CIDSystemInfo\n";
	append s "<</Registry (Adobe)\n";
	append s "/Ordering (UCS)\n";
	append s "/Supplement 0\n";
	append s ">> def\n";
	append s "/CMapName /Adobe-Identity-UCS def\n";
	append s "/CMapType 2 def\n";
	append s "1 begincodespacerange\n";
	append s "<00> <FF>\n";
	append s "endcodespacerange\n";
	if {$nbr>0} {
		append s "$nbr beginbfrange\n";
		append s $ranges;
		append s "endbfrange\n";
	}
	if {$nbc>0} {
		append s "$nbc beginbfchar\n";
		append s $chars;
		append s "endbfchar\n";
	}
	append s "endcmap\n";
	append s "CMapName currentdict /CMap defineresource pop\n";
	append s "end\n";
	append s "end";
	return $s;
}

proc ::tclfpdf::_putimages { } {
	variable images;
	foreach file [array names images] {
		set images($file) [_putimage $images($file)];
		;# note: this doesn't works if used many times without close it
		;# _lunsetsubarr images $file data;
		;# _lunsetsubarr images $file smask;
	}
}

proc ::tclfpdf::_putimage { info1 } {
	variable n; variable compress;
	_newobj ;
	array set info $info1;
	array set info "n $n";
	_put "<</Type /XObject";
	_put "/Subtype /Image";
	_put "/Width $info(w)";
	_put "/Height $info(h)";
	if {$info(cs)=="Indexed"} {
		_put "/ColorSpace \[/Indexed /DeviceRGB [expr [string length $info(pal)]/3.00-1] [expr $n+1] 0 R\]";
	} else {
		_put "/ColorSpace /$info(cs)";
		if {$info(cs)=="DeviceCMYK"} {
			_put "/Decode \[1 0 1 0 1 0 1 0\]";
		}	
	}
	_put "/BitsPerComponent $info(bpc)";
	if { [isset info(f) 0]} {
		_put "/Filter /$info(f)";
	}
	if {[isset info(dp) 0]} {
		_put "/DecodeParms <<$info(dp)>>";
	}	
	if {[isset info(trns) 0]} {
		set trns "";
		for {set i 0} { $i < [array size $info(trns)]} {incr i} {
			append trns "$info(trns,$i) $info(trns,$i) ";
		}	
		_put "/Mask \[$trns\]";
	}
	if {[isset info(smask) 0]} {
		_put "/SMask [expr $n+1] 0 R";
	}
	_put "/Length [string length $info(data)]>>";
	_putstream $info(data);
	_put "endobj";
	;# Soft mask
	if {[isset info(smask) 0]} {
		set dp "/Predictor 15 /Colors 1 /BitsPerComponent 8 /Columns $info(w)";
		_putimage [list w $info(w) h $info(h) cs DeviceGray bpc 8 f $info(f) dp $dp data $info(smask)];
	}
	;# Palette
	if {$info(cs)=="Indexed"} {
		_putstreamobjest info(pal);
	}
	return [array get info];
}

proc ::tclfpdf::_putxobjectdict { } {
	variable images;
	foreach {k v} [array get images] {
		array set image $v;
		_put "/I$image(i) $image(n) 0 R";
	}	
}

proc ::tclfpdf::_putresourcedict { } {
	variable fonts;
	_put "/ProcSet \[/PDF /Text /ImageB /ImageC /ImageI\]";
	_put "/Font <<";
	foreach {k1 font1} [array get fonts] {
		array set font11 $font1;
		_put "/F$font11(i) $font11(n) 0 R";
	}
	_put ">>";
	_put "/XObject <<" ;
	_putxobjectdict ;
	_put ">>" ;
}

proc ::tclfpdf::_putresources { } {
	_putfonts ;
	_putimages ;
	;# Resource dictionary
	_newobj 2;
	_put "<<";
	_putresourcedict ;
	_put ">>";
	_put "endobj";
}

proc ::tclfpdf::_putinfo { } {
	variable metadata; variable CreationDate;
	
	set metadata(CreationDate) $CreationDate;
	foreach { k1 v1 } [array get metadata] {
		_put "/$k1 [_textstring $v1]";
	}
}

proc ::tclfpdf::_putcatalog { } {
	variable ZoomMode; variable LayoutMode; variable PageInfo;
	set n1 PageInfo(1,n)
	_put "/Type /Catalog";
	_put "/Pages 1 0 R";
	if { $ZoomMode=="fullpage"} {
		_put "/OpenAction \[3 0 R /Fit\]";
	} elseif { $ZoomMode=="fullwidth"} {
		_put "/OpenAction \[3 0 R /FitH null\]";
	} elseif { $ZoomMode=="real"} {
		_put "/OpenAction \[3 0 R /XYZ null null 1\]";
	} elseif { [string is int $ZoomMode] } {
		_put "/OpenAction \[3 0 R /XYZ null null [format \"%.2f\" [expr $ZoomMode/100)]]\]";
	}
	if { $LayoutMode=="single"} {
		_put "/PageLayout /SinglePage" ;
	} elseif { $LayoutMode=="continuous"} {
		_put "/PageLayout /OneColumn" ;
	} elseif { $LayoutMode=="two"} {
		_put "/PageLayout /TwoColumnLeft" ;
	}
}

proc ::tclfpdf::_putheader { } {
	variable PDFVersion;
	_put "%PDF-$PDFVersion";
}

proc ::tclfpdf::_puttrailer { } {
	variable n;
	_put "/Size [expr $n+1]";
	_put "/Root $n 0 R";
	_put "/Info [expr $n-1] 0 R";
}

proc ::tclfpdf::_enddoc { } {
	variable offsets; variable state;
	variable n; variable CreationDate;	
	
	set CreationDate "D:[clock format [clock seconds] -format %Y%m%d%H%M%S]";
	_putheader ;
	_putpages ;
	_putresources ;
	;# Info
	_newobj ;
	_put "<<";
	_putinfo ;
	_put ">>";
	_put "endobj";
	;# Catalog
	_newobj ;
	_put "<<";
	_putcatalog ;
	_put ">>";
	_put "endobj" ;
	;# Cross-ref
	set offset [_getoffset];
	_put "xref";
	_put "0 [expr $n+1]";
	_put "0000000000 65535 f ";
	for {set i 1} {$i<=$n} {incr i} {
		_put [format "%010d 00000 n " $offsets($i)];
	}
	;# Trailer
	_put "trailer";
	_put "<<";
	_puttrailer ;
	_put ">>";
	_put "startxref";
	_put $offset;
	_put "%%EOF";
	set state 3;
}

proc ::tclfpdf::_UTF8toUTF16BE { s setbom } {
	;# Convert UTF-8 to UTF-16BE with BOM if need
	set s [encoding convertto [encoding system] $s] 
	set res "";
	if { $setbom == 1} {
		set res "\xFE\xFF"; #Byte Order Mark (BOM)
	}	
	set nb [string length $s];
	set i -1;
	while {$i<$nb-1} {
		set c1 [scan [string index $s [incr i]] %c];
		if {$c1>=224} {
			;# 3-byte character
			set c2 [scan [string index $s [incr i]] %c];
			set c3 [scan [string index $s [incr i]] %c];
			set res "$res[format %c [expr ((($c1 & 0x0F)<<4) + (($c2 & 0x3C)>>2))]]";
			set res "$res[format %c [expr ((($c2 & 0x03)<<6) + ($c3 & 0x3F))]]";
		} elseif {$c1>=192} {
			;# 2-byte character
			set c2 [scan [string index $s [incr i]] %c];
			set res "$res[format %c [expr (($c1 & 0x1C)>>2)]]";
			set res "$res[format %c [expr ((($c1 & 0x03)<<6) + ($c2 & 0x3F))]]";
		} else {
			;# Single-byte character
			set res "$res\0[format %c $c1]";
		}
	}
	return $res;
}

proc ::tclfpdf::_UTF8StringToArray { str } {
	set str [encoding convertto [encoding system] $str];
	set out {};
	set len [string len $str];
	for {set i 0} { $i < $len} {incr i} {
		set uni -1;
		set h [ scan [string index $str $i] %c];
		if {$h <= 0x7F } {
			set uni $h;
		} elseif { $h >= 0xC2 } {
			if { ($h <= 0xDF) && ($i < $len -1) } {
				set uni [expr ($h & 0x1F) << 6 | ([scan [string index $str [incr i]] %c] & 0x3F) ];
			} elseif { ($h <= 0xEF) && ($i < $len -2) } {
				set uni [expr ($h & 0x0F) << 12 | ( [scan [string index $str [incr i]] %c] & 0x3F) << 6 | ( [scan [string index $str [incr i]] %c] & 0x3F) ];
			} elseif { ($h <= 0xF4) && ($i < $len -3) } {
				set uni [expr ($h & 0x0F) << 18 | ( [scan [string index $str [incr i]] %c] & 0x3F) << 12 | ( [scan [string index $str [incr i]] %c] & 0x3F) << 6 | ( [scan [ string index $str [incr i]] %c] & 0x3F)];
			}
		}
		if {$uni >= 0} {
			lappend out $uni;
		}
	}
	return $out;
}

proc ::tclfpdf::SetSystemFontsPaths { listofpaths } {

	variable TCLFPDF_SYSTEMFONTSPATHS;
	global _isInit;

	;#to check existence of directory
	foreach p $listofpaths {
		set p [ file normalize $p ];
		if { [file isdirectory $p ]== 1 } {
			lappend TCLFPDF_SYSTEMFONTSPATHS $p;
		}
	}
	;# even if TCLFPDF_SYSTEMFONTSPATHS was empty, still the font could be exist in other path ,
	;#so the script keep running in the init, however if was setted after then throw error
	if { $TCLFPDF_SYSTEMFONTSPATHS eq {} && $_isInit == 0 } {
			Error "Path not valid setting System Fonts: $p";
	}
}

proc ::tclfpdf::SetUserPath { path } {

	variable TCLFPDF_USERPATH;

	set path [ file normalize $path ];
	;#to check existence of directory
	;# Path exist
	if {[file exist $path]==1} {
		if {[file isdirectory $path ] ==1 } {
			if { [file writable $path ]== 1 } {
				set TCLFPDF_USERPATH $path;
			} else {
				Error "Folder isn't writable, setting User Path: $path";
			}
		} else {
				Error "Path is not a folder(is a File),\n setting User Path: $path";
		}
	} else {
	;# folder doesn't exist
		if { [catch [file mkdir $path] err]} {
			Error "Can't create folder $path : $err";
		} else {
			set TCLFPDF_USERPATH $path;
		}
	}
}

proc ::tclfpdf::_SearchPathFile { file } {

	variable TCLFPDF_SYSTEMFONTSPATHS;
	variable TCLFPDF_COREFONTSPATH;
	variable TCLFPDF_USERPATH;
	
	set declaredpaths $TCLFPDF_SYSTEMFONTSPATHS;
	lappend declaredpaths $TCLFPDF_COREFONTSPATH;
	lappend declaredpaths $TCLFPDF_USERPATH;

	foreach p $declaredpaths {
		if { [file exists "$p/$file"]} {
			return "$p/$file";
		}
	}
	Error "Could not find file font $file"
}

	;# Now initialize all
	_Init;

} ;# END eval namespace TCLFPDF