Tcl Library Source Code

2018-12-12  Harald Oehlmann <[email protected]>

	* png.tcl: add function getPixelDimension to   get physical pixel size

2013-02-01  Andreas Kupries  <[email protected]>

	*
	* Released and tagged Tcllib 1.15 ========================
	* 

2012-07-09  Aaron Faupell <[email protected]>

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded png 0.3 [list source [file join $dir png.tcl]]

[manpage_begin png n 0.3]
[keywords comment]
[keywords image]
[keywords png]
[keywords timestamp]
[copyright {2004, Code: Aaron Faupell <[email protected]>}]
[copyright {2004, Doc:  Andreas Kupries <[email protected]>}]
[moddesc   {Image manipulation}]
[titledesc {PNG querying and manipulation of meta data}]
[category  {File formats}]
[require Tcl 8.2]
[require crc32]
[require png [opt 0.3]]
[description]
[para]

This package provides commands to query and modify PNG images. PNG
stands for [term {Portable Network Graphics}] and is specified at
[uri http://www.libpng.org/pub/png/spec/1.2].

Adds a unicode (international) comment to the PNG image in [arg file],
just before the first data chunk. Will throw an error if no data chunk
is found. [arg keyword] has to be less than 80 characters long to
conform to the PNG specification. [arg keyword2] is the translated
[arg keyword], in the language specified by the language identifier
[arg lang].

[call [cmd ::png::getPixelDimension] [arg file]]

Returns a dictionary with keys [const ppux], [const ppuy] and [const unit] if the information is present.
Otherwise, it returns the empty string.
The values of [const ppux] and [const ppuy] return the pixel per unit value iiiin X or Y direction.
The value of [const unit] may be meter or unknown. In case of meter, a dpi value may be found by the multiplication of 0.0254.

[call [cmd ::png::image] [arg file]]

Given a PNG file returns the image in the list of scanlines format used by Tk_GetColor.

[call [cmd ::png::write] [arg file] [arg data]]

Takes a list of scanlines in the Tk_GetColor format and writes the represented image

# png.tcl --
#
#       Querying and modifying PNG image files.
#
# Copyright (c) 2004-2012 Aaron Faupell <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: png.tcl,v 1.11 2012/07/09 16:35:04 afaupell Exp $

package provide png 0.3

namespace eval ::png {}

proc ::png::_openPNG {file {mode r}} {
    set fh [open $file $mode]
    fconfigure $fh -encoding binary -translation binary -eofchar {}
    if {[read $fh 8] != "\x89PNG\r\n\x1a\n"} { close $fh; return -code error "not a png file" }

            return
        }
        seek $fh [expr {$len + 4}] current
    }
    close $fh
    return -code error "no data chunk found"
}

proc ::png::getPixelDimension {file} {
    set fh [_openPNG $file]

    while {[set r [read $fh 8]] != ""} {
        binary scan $r Ia4 len type
        if {$type == "pHYs"} {
            set r [read $fh [expr {$len + 4}]]
            binary scan $r IIc ppux ppuy unit
            close $fh
            # mask out sign bit, from tcl 8.5, one may use u specifier
            set res [list ppux [expr {$ppux & 0xFFFFFFFF}]\
                     ppuy [expr {$ppuy & 0xFFFFFFFF}]\
                    unit]
            if {$unit == 1} {lappend res meter} else {lappend res unknown}
            return $res
        }
        seek $fh [expr {$len + 4}] current
    }
    close $fh
    return
}

proc ::png::image {file} {
    set fh [_openPNG $file]
    set chunks [_chunks $fh]
    set cdata {}

    set h [lsearch -exact -index 0 -inline $chunks IHDR]