Updated 2012-09-11 01:18:35 by RLE

1. Introduction

Due to the need to get rid of libtiff, I needed to write tiff images without it and started to write a simple tiff RGB image writer in tcl using the tiff v6.0 specification documentation. Afterwards I transfered the functionality into C++ and I was happy to have no libtiff anymore.

The reasons to get rid of libtiff were, that we only needed to write tiff RGB images and that we have 5 platforms to support - 4 UNIX platforms with 32/64bit, ... - so we don't wanted to built more external libraries than needed.

The tiff package provides following functionality:
tiff2raw
this proc reads a TIFF image file, returns its image file header, its first image file directory containing all needed information to handle the returned raw data from the TIFF image file. The raw data is not decompressed or decoded. So if a LZW compressed TIFF image file is read, the raw data contains the LZW data. "all needed information" must be read carefully, because tiled images are not supported and even TIFF JPEG image files contains some en/decode information the package don't read yet. The returned raw data is a list of all strips read from the TIFF image file.
raw2tiff
this proc takes raw data, the width, height, horizontal and vertical resolution, a description to write a TIFF uncompressed RGB image file. So the raw data must be plain RGB data. All RGB data will be written into one strip.
dumpTiff
this proc dumps a TIFF image file by writing the information from the image file header and the first image file directory to a channel or a file. Optional the proc saves the raw data into a file too.
photo2raw
this proc converts data given by the data command of a tk image (type photo) object into plain RGB data.
photo2tiff
this proc converts a given image (type photo) into a TIFF uncompressed RGB image file, using the given description and the horizontal and vertical resolution.
tiff2photo
this proc converts if possible a TIFF image file into a tk image (type photo) object. Only uncompressed RGB, RGB palette, Grayscaled and Black/White image files are accepted.

Some irregularies or simples irritations are following behaviour of tk image photo objects in tcl/tk v8.4.3:

  • changing the option -palette of a tk image photo does not change the data of the tk image photo. So changing the tk image photo to black/white doesn't change the data to reflect this change. Extracted data, saved as TIFF image file contains still all previously seen colours
  • using "$photo put $data" on a tk image photo causes the options -width and -height to return zero if ask for using "$photo cget -width" or "$photo cget -height"
  • the -data option during the creation of the tk image photo does not accept the typical data returned by "$photo data"

Perhabs somebody could clear these irritations of mine?

2. Description

2.1 tiff2raw

2.1.1 Syntax
 tiff2raw fileName ifhVar ifdVar ?bufferVar?
fileName
path to the TIFF image file to be read (with extension)
ifhVar
image file header array variable to contain all per header element an array element with the corresponding value/information.
ifdVar
image file directory array variable to contain all read directory entries describing the TIFF image file or respectively the raw data belonging to this first image file directory of the TIFF image file
bufferVar
the variable to contain the raw data, a list of strips, referenced by the first image file directory

2.1.2 Details

1. in the image file header array variable are only stored following elements:

  • byteOrder contains "MM" (big endian) or "II" (little endian)
  • version contains 42 (always)
  • ifd.offset contains the offset inside the TIFF image file to the first image file directory (ifd)

2. a TIFF image file can store multiple pages, images or image extending data like alpha channel or transparency data. The proc tiff2raw only supports the first image file directory and extracts only raw data referenced by this image file directory!

3. the image file directory array variable elements are named like following:

  • if the image file directory entry has a known tag (identifier) its known name will be used
  • if the tag is not known, the tag value (integer) will be used as array element identifier

4. the data belonging to a image file directory entry is a list collecting following data:

  • the value of the image file directory entry - may be a list, binary, ASCII or numerical data
  • the type of the image file directory entry - may be Byte, Ascii, Short, Long, Rational (two Longs), SByte, Undefined, SShort, SLong, SRational, Float or Double
  • the count of values belonging to the image file directory entry
  • the offset to the values of the image file directory - may be "<ifd>" (extracted from the image file directory), <calculated> (a calculated value, not directly extracted from the file), <out of range> (if an invalid offset was read) or the offset in the format "0x.../..." (hexadecimal / decimal)

5. every image file directory entry value, that could be translated into a token will be translated - e.g. "photometric = 2" will be translated into "photometric = RGB"

2.2 raw2tiff

2.2.1 Syntax
 raw2tiff fileName description width height xdpi ydpi bufferVar
fileName
path to the TIFF image file to be written (with extension)
description
a string used to be stored as description inside the TIFF image file
width
width of the image described by the raw data in pixels
height
height of the image described by the raw data in pixels
xdpi
horizontal resolution of the image described by the raw data in dpi (dots per inch)
ydpi
vertical resolution (like xdpi)
bufferVar
variable containing binary data describing the plain RGB values to be written into a TIFF RGB image file.

2.3 Details

1. the length of the raw/binary data must be:

  • samplesPerPixel = 3
  • bitsPerSample = 8
  • countOfBytes = height * ( width * samplesPerPixel * bitsPerSample ) / 8

2. the format of the raw/binary data must be "...RGBRGBRGBRGB..." - one byte per colour, red, green following red, blue following green, and so on

3. the resolution of the image is not important, although it would be used to determine the WYSIWYG size, the size, when to be printed

2.3 dumpTiff

2.3.1 Syntax
 dumpTiff fileName ?out? ?saveRawData?
fileName
path to the TIFF image file to be read (with extension)
out
a channel name or a filename to write to. if omitted the output filename will be "filename.dump.txt"
saveRawData
boolean flag, signalizing if the raw data referenced by the first image file directory should be saved into a file named "filename.raw"

2.3.2 Details

1. the written text file contains the information about the byte order inside the TIFF image file and the image file directory with its entries and the corresponding values

2. the eventually saved raw data could be read by e.g. IrfanView

2.4 photo2raw

2.4.1 Syntax
 photo2raw photo rawDataVar
photo
name of a tk image (type photo) or of the name of a variable containing the tk image data (if tk is not present)
rawDataVar
the name of a variable to contain the generated raw data

2.4.2 Details

1. if tk is not present the first argument must be a variable containing the data returned by the command:
 $photo data

2. if tk is present the first argument will be taken as name of a tk image of the type photo and the needed data will be requested by:
 $photo data

2.5 photo2tiff

2.5.1 Syntax
 photo2tiff photo fileName description xdpi ydpi
photo
name of a tk image (type photo) or of the name of a variable containing the tk image data (if tk is not present)
fileName
path to the TIFF image file to be written (with extension)
description
a string used to be stored as description inside the TIFF image file
xdpi
horizontal resolution of the tk image in dpi (dots per inch)
ydpi
vertical resolution (like xdpi)

2.5.2 Details

1. this proc will only write uncompressed TIFF RGB image files

2.6 tiff2photo

2.5.1 Syntax
 tiff2photo fileName photo ?ifdVar?
fileName
path to the TIFF image file to be read (with extension)
photo
name of a tk image (type photo) or of the name of a variable to the tk image data (if tk is not present)
ifdVar
image file directory array variable to contain all read directory entries describing the TIFF image file or respectively the raw data belonging to this first image file directory of the TIFF image file

2.5.2 Details

1. this proc will only read uncompressed TIFF RGB/RGB Palette/Grayscaled/Bilevel (= black/white) image files

2. black/white and white/black pictures are handled like this ... white or black background

3. some grayscaled TIFF image files were suddenly shown as inversed image, even if the have a white background specified in the image file header - I don't know why!

4. Halftone dithering and threshhold or similar things are not applied, so the tk image could differ from the TIFF image file seen in a viewer or editor

5. if the tk image of the type photo is not created yet, this proc will create this tk image

6. if tk is not present, the second argument will be taken as variable name to contain the tk image photo data need to be used with the command:
 $photo put $data

3. Enhancements eventuall future plans

  • introducing callbacks to enable the de/compression of raw data
  • to read values like the DTables, ACTables for JPEG as values of the image file directory and not only their offsets
  • extend to read all image file directories and their raw data
  • extend to extract extra samples per pixel (extra data, alpha channel or transparency samples)

4. Source

Please reap the first code and save it as the pkgIndex.tcl file:
 package ifneeded tiff 1.0 [list source [file join $dir tiff.1.0.tcl]]

Please reap the second code and save it as tiff.1.0.tcl file:
 uplevel #0 {
    package provide tiff 1.0;
 
    lappend ::auto_path [file dirname [info script]];
 }
 
 namespace eval ::tiff {
    proc this   {} "return [namespace current];";
    proc parent {} "return [namespace parent [this]];";
 
    variable TIFF_IFD_TAG_NAMES;
 
    array set TIFF_IFD_TAG_NAMES {
       254   newSubfileType
       255   subfileType
       256   width
       257   height
       258   bitsPerSample
       259   compression
       262   photometric
       263   threshholding
       264   cellWidth
       265   cellLength
       266   fillOrder
       269   documentName
       270   imageDescription
       271   make
       272   model
       273   stripOffset
       274   orientation
       277   samplesPerPixel
       278   rowsPerStrip
       279   stripByteCount
       280   minSampleValue
       281   maxSampleValue
       282   xResolution
       283   yResolution
       284   planarConfiguration
       285   pageName
       286   xPosition
       287   yPosition
       288   freeOffsets
       289   freeByteCounts
       290   grayResponseUnit
       291   grayResponseCurve
       292   t4Options
       292   t6Options
       296   resolutionUnit
       297   pageNumber
       301   transferFunction
       305   software
       306   dateTime
       315   artist
       316   hostName
       317   predictor
       318   whitePoint
       319   primaryChormaticities
       320   colorMap
       321   halftoneHints
       322   tileWidth
       323   tileLength
       324   tileOffsets
       325   tileByteCounts
       332   inkSet
       333   inkNames
       334   numberOfInks
       336   dotRange
       337   targetPrinter
       338   extraSamples
       339   sampleFormat
       340   sMinSampleValue
       341   sMaxSampleValue
       342   transferRange
       512   jpegProc
       513   jpegInterchangeFormat
       514   jpegInterchangeFormatLength
       515   jpegRestartInterval
       517   jpegLosslessPredictors
       518   jpegPointTransforms
       519   jpegQTables
       520   jpegDCTables
       521   jpegACTables
       529   yCbCrCoefficients
       530   yCbCrSubSampling
       531   yCbCrPositioning
       532   referenceBlackWhite
       33432 copyright
    }
 
    proc tiffIfdTags {token} {
       variable TIFF_IFD_TAG_NAMES;
       
       if {![info exists TIFF_IFD_TAG_NAMES($token)]} {
          set types   {};
 
          foreach name [lsort -dictionary [array names TIFF_IFD_TAG_NAMES {[A-Z]*}]] {
             lappend types "$name ($TIFF_IFD_TAG_NAMES(name))";
          }
          
          if {[string is integer -strict $token]} {
             return $token;
          }
 
          error "bad image file directory tag name \"$token\": must be [join $types {, }]";
       }
 
       return $TIFF_IFD_TAG_NAMES($token);
    }
 
    variable TIFF_IFD_TAG_TYPES;
 
    array set TIFF_IFD_TAG_TYPES {
       Byte      1
       Ascii     2
       Short     3
       Long      4
       Rational  5
       SByte     6
       Undefined 7
       SShort    8
       SLong     9
       SRational 10
       Float     11
       Double    12
       1   Byte
       2   Ascii
       3   Short
       4   Long
       5   Rational
       6   SByte
       7   Undefined
       8   SShort
       9   SLong
       10  SRational
       11  Float
       12  Double
    };
 
    proc tiffIfdTagTypes {token} {
       variable TIFF_IFD_TAG_TYPES;
       
       if {![info exists TIFF_IFD_TAG_TYPES($token)]} {
          set types   {};
 
          foreach name [lsort -dictionary [array names TIFF_IFD_TAG_TYPES {[A-Z]*}]] {
             lappend types "$name ($TIFF_IFD_TAG_TYPES(name))";
          }
          
          error "bad image file directory tag type \"$token\": must be [join $types {, }]";
       }
 
       return $TIFF_IFD_TAG_TYPES($token);
    }
 
    variable TIFF_IFD_TAG_BYTES ;
 
    array set TIFF_IFD_TAG_BYTES {
       1         1
       Byte      1
       2         1
       Ascii     1
       3         2
       Short     2
       4         4
       Long      4
       5         8
       Rational  8
       6         1
       SByte     1
       7         1
       Undefined 1
       8         2
       SShort    2
       9         4
       SLong     4
       10        8
       SRational 8
       11        4
       Float     4
       12        8
       Double    8
    };
 
    proc tiffIfdTagBytes {token} {
       variable TIFF_IFD_TAG_BYTES;
       
       if {![info exists TIFF_IFD_TAG_BYTES($token)]} {
          set types   {};
 
          foreach name [lsort -dictionary [array names TIFF_IFD_TAG_BYTES {[A-Z]*}]] {
             lappend types "$name ($TIFF_IFD_TAG_BYTES(name)B)";
          }
          
          error "bad image file directory tag type \"$token\": must be [join $types {, }]";
       }
 
       return $TIFF_IFD_TAG_BYTES($token);
    }
 
    variable TIFF_SIZES;
 
    array set TIFF_SIZES [list \
       ifd.entry.value   [tiffIfdTagBytes Long] \
       ifh               [expr {2*[tiffIfdTagBytes Short] + [tiffIfdTagBytes Long]}] \
       ifd.entry         [expr {2*[tiffIfdTagBytes Short] + 2*[tiffIfdTagBytes Long]}] \
    ];
 
    proc tiffSizes {token args} {
       variable TIFF_SIZES;
       
       if {$token == "ifd"} {
          if {[llength $args] != 1} {
             error "wrong # args: should be \"tiffSizes ifd ifdEntryCount\"";
          }
 
          return [expr {[tiffIfdTagBytes Short] + [lindex $args 0]*$TIFF_SIZES(ifd.entry) + [tiffIfdTagBytes Long]}];
       }
 
       if {$args != {}} {
          error "wrong # args: should be \"tiffSizes token\"";
       }
 
       if {![info exists TIFF_SIZES($token)]} {
          error "bad image file directory tag type \"$token\": must be [join [lsort -dictionary [array names TIFF_SIZES {[A-Z]*}]] {, }]";
       }
 
       return $TIFF_SIZES($token);
    }
 
    proc compression {token} {
       if {[string is integer $token]} {
          switch -exact -- $token {
             1         {return "Uncompressed";}
             2         {return "CCITT 1D";}
             3         {return "Group 3 Fax";}
             4         {return "Group 4 Fax";}
             5         {return "LZW";}
             6         {return "JPEG";}
             32773     {return "PackBits";}
             default   {return "Unknown \"$token\"";}
          }
       }
 
       switch -exact -- $token {
          "Uncompressed"  {return 1;}
          "CCITT 1D"      {return 2;}
          "Group 3 Fax"   {return 3;}
          "Group 4 Fax"   {return 4;}
          "LZW"           {return 5;}
          "JPEG"          {return 6;}
          "PackBits"      {return 32773;}
       }
 
       error "bad compression mode \"$token\": must be Uncompressed, CCITT 1D, Group 3 Fax, Group 4 Fax, LZW, JPEG or PackBits";
    }
 
    proc photometric {token} {
       if {[string is integer $token]} {
          switch -exact -- $token {
             0         {return "whiteIsZero";}
             1         {return "blackIsZero";}
             2         {return "RGB";}
             3         {return "RGB Palette";}
             4         {return "Transparency Mask";}
             5         {return "CMYK";}
             6         {return "YCbCr";}
             8         {return "CIELab";}
             default   {return "Unknown \"$token\"";}
          }
       } 
 
       switch -exact -- $token {
          whiteIsZero         {return 0;}
          blackIsZero         {return 1;}
          RGB                 {return 2;}
          "RGB Palette"       {return 3;}
          "Transparency Mask" {return 4;}
          CMYK                {return 5;}
          YCbCr               {return 6;}
          CIELab              {return 8;}
       }
 
       error "bad photometric interpretation mode \"$token\": must be whiteIsZero, blackIsZero, RGB, RGB Palette, Transparency Mask, CMYK, YCbCr or CIELab";
    }
 
    proc resolutionUnit {token} {
       if {[string is integer $token]} {
          switch -exact -- $token {
             1         {return "None";}
             2         {return "Inch";}
             3         {return "Centimeter";}
             default   {return "Unknown \"$token\"";}
          }
       }
 
       switch -exact -- $token {
          "None"         {return 1;}
          "Inch"         {return 2;}
          "Centimeter"   {return 3;}
       }
 
       error "bad resolution unit \"$token\": must be None, Inch, or Centimeter";
    }
 
    proc extraSamples {token} {
       if {[string is integer $token]} {
          switch -exact -- $token {
             0         {return "Unspecified";}
             1         {return "AssociatedAlpha";}
             2         {return "UnassociatedAlpha";}
             default   {return "Unknown \"$token\"";}
          }
       }
 
       switch -exact -- $token {
          "Unspecified"         {return 0;}
          "AssociatedAlpha"     {return 1;}
          "UnassociatedAlpha"   {return 2;}
       }
 
       error "bad extra sample type \"$token\": must be Unspecified, AssociatedAlpha, or UnassociatedAlpha";
    }
 
    proc getb {byteOrder channel type args} {
       if {[llength $args] > 2} {
          error "wrong # args: should be \"getb channel type ?count? ?fieldSize?\"";
       }
 
       set count      "";
       set fieldSize  "";
 
       foreach {count fieldSize} $args {break;};
 
       if {$count == ""} {
          set count   1;
       }
 
       switch -glob -- $type {
          Undefined   -
          *Byte {
             if {$count == 1} {
                set format "c";
             } else {
                set format "a$count";
             }
          }
          Ascii  {set format "A*";}
          *Short  -
          *Long  {
             if {[string match {*Short} $type]} {
                set format "S";
             } else {
                set format "I";
             }
 
             if {$byteOrder == "II"} {
                set format [string tolower $format];
             }
          }
          Float   {set format "f";}
          Double  {set format "d";}
          default {
             error "bad type \"$type\": must be Ascii, (S)Byte, Double, Float, (S)Long, (S)Short, or Undefined";
          }
       }
 
       set byteCount [expr {$count * [tiffIfdTagBytes $type]}];
 
       if {$fieldSize == ""} {
          set fieldSize [tiffIfdTagBytes $type];
       }
 
       if {$fieldSize < $byteCount} {
          set fillByteCount 0;
       } else {
          set fillByteCount [expr {$fieldSize - $byteCount}];
          set byteCount     $fieldSize;
       }
 
       set value       {};
       set position    [tell $channel];
       set binaryValue [read $channel $byteCount];
 
       if {![binary scan $binaryValue ${format}x$fillByteCount value]} {
          puts \n[info level [info level]];
 
          binary scan $binaryValue c* bValue;
 
          puts "$bValue => ${format}x$fillByteCount => $value @ $position";
 
          error "couldn't get $type value at [expr {[tell $channel] - $byteCount}] with $byteCount bytes: binary value = $value" $::errorInfo $::errorCode;
       }
 
       switch -glob -- $type {
          Undefined -
          *Byte     {set add   0xFF;}
          *Short    {set add   0xFFFF;}
          *Long     {set add   0xFFFFFFFF;}
       }
       
       switch -glob -- $type {
          Undefined -
          *Byte     -
          *Short    -
          *Long     {
             if {!((($type == "Undefined") || [string match {*Byte} $type]) && ($byteCount != 1))} {
                set idx   0;
 
                foreach subValue $value {
                   set value   [lreplace $value $idx $idx [expr {$subValue & $add}]];
                }
             }
          }
       }
 
       return $value;
    }
 
    proc putb {byteOrder channel type value args} {
       if {[llength $args] > 1} {
          error "wrong # args: should be \"putb byteOrder channel type value ?fieldSize?\"";
       }
 
       switch -exact -- $type {
          Ascii   -
          Byte   {
             set fieldSize [lindex $args 0];
             set byteCount [string length $value];
 
             if {$type == "Ascii"} {
                incr byteCount;
 
                set format "a$byteCount";
             } else {
                if {$byteCount == ""} {
                   set byteCount 1;
                   set format    "c";
                } else {
                   set format "a*";
                }
             }
          }
          Short   -
          Long   {
             set fieldSize [lindex $args 0];
             set byteCount [tiffIfdTagBytes $type];
 
             if {$type == "Short"} {
                set format "S";
             } else {
                set format "I";
             }
 
             if {$byteOrder == "II"} {
                set format   [string tolower $format];
             }
          }
          default   {
             error "bad type \"$type\": must be Ascii, Byte, Long, or Short";
          }
       }
 
       if {$fieldSize == ""} {
          set fieldSize [tiffIfdTagBytes $type];
       }
 
       if {$fieldSize < $byteCount} {
          set fillByteCount   0;
       } else {
          set fillByteCount [expr {$fieldSize - $byteCount}];
       }
 
       puts -nonewline $channel [binary format ${format}x$fillByteCount $value];
 
       return;
    }
 
    # ========================================================================== #
    # raw2tiff                                                                   #
    # ========================================================================== #
    # - writes a full RGB TIFF image file from the given RGB data in 'buffer'    #
    # - writes a TIFF image file containing only one strip of data               #
    # - writes all data in big endian byte order                                 #
    # ========================================================================== #
    #
    proc raw2tiff {fileName description width height xdpi ydpi bufferVar} {
       # opening the TIFF image file to write as binary
       #
       if {[catch {set fid [open $fileName w];} reason]} {
          error "couldn't write TIFF image file \"$fileName\": $reason" $::errorInfo $::errorCode;
       }
 
       fconfigure $fid -translation binary -buffersize 1000000 -buffering full;
 
       upvar $bufferVar buffer;
 
       # filling the image file header
       #
       binary scan "MM" s ifhByteOrder;  # big endian byteorder (M = Motorola)
       set ifhVersion   42;              # magic number ;-)
       set ifhIfdOffset [tiffSizes ifh]; # let the image file directory start right behind the header
       
       # writing the image file header
       #
       putb $ifhByteOrder $fid Short $ifhByteOrder;
       putb $ifhByteOrder $fid Short $ifhVersion;
       putb $ifhByteOrder $fid Long  $ifhIfdOffset;
 
       # building the image file directory
       #
       set ifdEntryCount    18;
       set ifdNextIfdOffset 0;
       set ifdSize          [tiffSizes ifd $ifdEntryCount];
 
       # presetting the image file directory entry values
       #
       set compression     [compression Uncompressed];
       set photometric     [photometric RGB];
       set resolutionUnit  [resolutionUnit Inch];
 
       set bitsPerSample   {8 8 8};
       set samplesPerPixel 3;
 
       set stripOffset [expr {
            [tiffSizes ifh]
          + [tiffIfdTagBytes Short]
          + $ifdSize
          + [tiffIfdTagBytes Long]
          + ((  [tiffIfdTagBytes Short]
              + $ifdSize
              + [tiffIfdTagBytes Long]) % 4)
       }];
       set stripByteCount [expr {$width * $height * $samplesPerPixel}];
       set rowsPerStrip   $height;
 
       set xResolution    [list [list $xdpi 1]];
       set yResolution    [list [list $ydpi 1]];
 
       set make     "EDS PLM solutions/Manifacturing Planing Solutions/simulation & analysis products/Berlin (Germany)";
       set software "eds/toolkit v3.40";
       set dateTime [clock format [clock scan now] -format {%Y:%m:%d %H:%M:%S}];
       set artist   $::tcl_platform(user);
       set hostName [info hostname];
       
       # filling the image file directory entries
       #
       array set ifdEntries [list \
          0.name    "ImageWidth" \
          0.tag     256 \
          0.type    Long \
          0.count   1 \
          0.value   $width \
          0.offset  0 \
          1.name    "ImageHeight" \
          1.tag     257 \
          1.type    Long \
          1.count   1 \
          1.value   $height \
          1.offset  0 \
          2.name    "BitsPerSample" \
          2.tag     258 \
          2.type    Short \
          2.count   3 \
          2.value   $bitsPerSample \
          2.offset  0 \
          3.name    "Compression" \
          3.tag     259 \
          3.type    Short \
          3.count   1 \
          3.value   $compression \
          3.offset  0 \
          4.name    "PhotometricInterpretation" \
          4.tag     262 \
          4.type    Short \
          4.count   1 \
          4.value   $photometric \
          4.offset  0 \
          5.name    "ImageDescription" \
          5.tag     270 \
          5.type    Ascii \
          5.count   [expr {[string length $description] + 1}] \
          5.value   $description \
          5.offset  0 \
          6.name    "Make" \
          6.tag     271 \
          6.type    Ascii \
          6.count   [expr {[string length $make] + 1}] \
          6.value   $make \
          6.offset  0 \
          7.name    "StripOffset" \
          7.tag     273 \
          7.type    Long \
          7.count   1 \
          7.value   $stripOffset \
          7.offset  0 \
          8.name    "SamplesPerPixel" \
          8.tag     277 \
          8.type    Short \
          8.count   1 \
          8.value   $samplesPerPixel \
          8.offset  0 \
          9.name    "RowsPerStrip" \
          9.tag     278 \
          9.type    Long \
          9.count   1 \
          9.value   $rowsPerStrip \
          9.offset  0 \
          10.name   "StripByteCount" \
          10.tag    279 \
          10.type   Long \
          10.count  1 \
          10.value  $stripByteCount \
          10.offset 0 \
          11.name   "XResolution" \
          11.tag    282 \
          11.type   Rational \
          11.count  1 \
          11.value  $xResolution \
          11.offset 0 \
          12.name   "YResolution" \
          12.tag    283 \
          12.type   Rational \
          12.count  1 \
          12.value  $yResolution \
          12.offset 0 \
          13.name   "ResolutionUnit" \
          13.tag    296 \
          13.type   Short \
          13.count  1 \
          13.value  $resolutionUnit \
          13.offset 0 \
          14.name   "Software" \
          14.tag    305 \
          14.type   Ascii \
          14.count  [expr {[string length $software] + 1}] \
          14.value  $software \
          14.offset 0 \
          15.name   "DateTime" \
          15.tag    306 \
          15.type   Ascii \
          15.count  [expr {[string length $dateTime] + 1}] \
          15.value  $dateTime \
          15.offset 0 \
          16.name   "Artist" \
          16.tag    315 \
          16.type   Ascii \
          16.count  [expr {[string length $artist] + 1}] \
          16.value  $artist \
          16.offset 0 \
          17.name   "Hostname" \
          17.tag    316 \
          17.type   Ascii \
          17.count  [expr {[string length $hostName] + 1}] \
          17.value  $hostName \
          17.offset 0 \
       ];
 
       for {set i 0} {$i < $ifdEntryCount} {incr i} {
          set ifdEntries($i.bytes)   [tiffIfdTagBytes $ifdEntries($i.type)];
          set ifdEntries($i.size)      [expr {$ifdEntries($i.bytes) * $ifdEntries($i.count)}];
       }
 
       # finding all image file directory entry needing an offset
       #
       set ifdEntryValueOffset [expr {$stripOffset + $stripByteCount + (($stripOffset + $stripByteCount) % 4)}];
 
       for {set i 0} {$i < $ifdEntryCount} {incr i} {
          if {$ifdEntries($i.size) > [tiffSizes ifd.entry.value]} {
             set ifdEntries($i.offset) $ifdEntryValueOffset;
 
             incr ifdEntryValueOffset [expr {int(pow(2, int(ceil(log($ifdEntries($i.size))/log(2)))))}];
          } else {
             set ifdEntries($i.offset) 0;
          }
 
       }
 
       # writing the image file directory
       #
       seek $fid $ifhIfdOffset;
 
       putb $ifhByteOrder $fid Short $ifdEntryCount;
 
       for {set i 0} {$i < $ifdEntryCount} {incr i} {
          putb $ifhByteOrder $fid Short $ifdEntries($i.tag);
          putb $ifhByteOrder $fid Short [tiffIfdTagTypes $ifdEntries($i.type)];
          putb $ifhByteOrder $fid Long  $ifdEntries($i.count);
 
          # test if image file directory entry value must be offsetted
          #
          if {!$ifdEntries($i.offset)} {
             # image file directory entry value can be stored inside the
             # image file directory entry
             #
             switch -exact -- $ifdEntries($i.type) {
                Byte  {putb $ifhByteOrder $fid Byte  $ifdEntries($i.value) [tiffSizes ifd.entry.value];}
                Ascii {putb $ifhByteOrder $fid Ascii $ifdEntries($i.value) [tiffSizes ifd.entry.value];} 
                Short {putb $ifhByteOrder $fid Short $ifdEntries($i.value) [tiffSizes ifd.entry.value];}
                Long  {putb $ifhByteOrder $fid Long  $ifdEntries($i.value) [tiffSizes ifd.entry.value];}
             }
          } else {
             # the offset to the image file directory entry value
             # is stored inside the image file directory entry
             #
             putb $ifhByteOrder $fid Long $ifdEntries($i.offset);
          }
       }
 
       putb $ifhByteOrder $fid Long $ifdNextIfdOffset [tiffIfdTagBytes Long];
 
       # writing the rgb data
       #
       seek $fid $stripOffset;
 
       putb $ifhByteOrder $fid Byte $buffer;
 
       # writing the offsetted image file directory entry values
       #
       for {set i 0} {$i < $ifdEntryCount} {incr i} {
          if {$ifdEntries($i.offset) > 0} {
             seek $fid $ifdEntries($i.offset);
 
             switch -glob -- $ifdEntries($i.type) {
                Ascii     {putb $ifhByteOrder $fid Ascii $ifdEntries($i.value);}
                *Rational {
                   # writing each rational as two following unsigned longs
                   #
                   foreach rational $ifdEntries($i.value) {
                      foreach {numerator denominator} $rational {break;}
 
                      putb $ifhByteOrder $fid Long $numerator;
                      putb $ifhByteOrder $fid Long $denominator;
                   }
                }
                default {
                   foreach value $ifdEntries($i.value) {
                      putb $ifhByteOrder $fid $ifdEntries($i.type) $value;
                   }
                }
             }
          }
       }
 
       # finishing and closing the TIFF image file
       #
       close $fid;
 
       return;
    }
 
    # ========================================================================== #
    # tiff2raw                                                                   #
    # ========================================================================== #
    # - reads a TIFF image and extracts its data into the given variables        #
    # - the image file header (ifh) will be stored into the array given with     #
    #   ifhVar                                                                   #
    # - the image file directory (ifh) will be stored into the array given with  #
    #   ifdVar                                                                   #
    # - the image file directory array will contain one element per found entry  #
    #   holding a list: value type count offset                                  #
    # - the raw data, representing the image data no matter if compressed, in    #
    #   JPEG style or what ever, will be stored as list of stripes into the      #
    #   variable given wiht bufferVar                                            #
    # ========================================================================== #
    #
    proc tiff2raw {fileName ifhVar ifdVar {bufferVar ""}} {
       upvar $ifhVar ifh;
       upvar $ifdVar ifd;
 
       if {$bufferVar != ""} {
          upvar $bufferVar buffer;
       }
       
       catch {unset ifh ifd buffer;};
 
       array set ifh {};
       array set ifd {};
 
       # opening the TIFF image file to read as binary
       #
       if {[catch {set fid [open $fileName r];} reason]} {
          error "couldn't load TIFF image file \"$fileName\": $reason" $::errorInfo $::errorCode;
       }
 
       fconfigure $fid -translation binary -buffersize 1000000 -buffering full;
 
       # reading the image file header
       #
       binary scan [binary format s [getb MM $fid Short]] a2 ifh(byteOrder);
 
       set ifh(version)    [getb $ifh(byteOrder) $fid Short];
       set ifh(ifd.offset) [getb $ifh(byteOrder) $fid Long];
 
       # reading the image file directory
       #
       seek $fid $ifh(ifd.offset) start;
       
       set ifd(.entryCount) [getb $ifh(byteOrder) $fid Short];
 
       for {set i 0} {$i < $ifd(.entryCount)} {incr i} {
          set ifd($i.tag)   [getb $ifh(byteOrder) $fid Short];
 
          set ifd($i.type)  [tiffIfdTagTypes [getb $ifh(byteOrder) $fid Short]];
          set ifd($i.count) [getb $ifh(byteOrder) $fid Long];
          set ifd($i.bytes) [tiffIfdTagBytes $ifd($i.type)];
          set ifd($i.size)  [expr {$ifd($i.bytes) * $ifd($i.count)}];
 
          if {$ifd($i.size) <= [tiffSizes ifd.entry.value]} {
             switch -glob -- $ifd($i.type) {
                Ascii {
                   set ifd($i.value) [getb $ifh(byteOrder) $fid Ascii [tiffSizes ifd.entry.value]];
                }
                *Byte  -
                *Short -
                *Long  {
                   set ifd($i.value) {};
 
                   for {set ii 0} {$ii < $ifd($i.count)} {incr ii} {
                      lappend ifd($i.value) [getb $ifh(byteOrder) $fid $ifd($i.type) $ifd($i.count) [tiffSizes ifd.entry.value]];
                   }
                }
             }
          } else {
             # value is the offset to the original value
             #
             set ifd($i.value) [getb $ifh(byteOrder) $fid Long];
          }
       }
 
       set ifd(.nextIfdOffset) [getb $ifh(byteOrder) $fid Long];
 
       # reading all image file directory entry having an offset
       #
       for {set i 0} {$i < $ifd(.entryCount)} {incr i} {
          if {$ifd($i.size) > [tiffSizes ifd.entry.value]} {
             set ifd($i.offset) $ifd($i.value);
 
             if {($ifd($i.offset) < [tiffSizes ifh]) || (($ifd($i.offset) > $ifh(ifd.offset)) && ($ifd($i.offset) < $ifh(ifd.offset) + [tiffSizes ifd $ifd(.entryCount)])) || ($ifd($i.offset) > [file size $fileName])} {
                puts stderr "warning: unable to get offsetted tag $ifd($i.tag) value @ $ifd($i.offset): offset out of range";
 
                set ifd($i.offset) "<out of range>";
 
                continue;
             }
 
             seek $fid $ifd($i.offset) start;
 
             switch -glob -- $ifd($i.type) {
                Ascii {
                   set ifd($i.value) [getb $ifh(byteOrder) $fid Ascii $ifd($i.count)];
                }
                Float  -
                Double -
                *Byte  -
                *Short -
                *Long  {
                   set ifd($i.value) {};
 
                   for {set ii 0} {$ii < $ifd($i.count)} {incr ii} {
                      lappend ifd($i.value) [getb $ifh(byteOrder) $fid $ifd($i.type)];
                   }
                }
                *Rational {
                   set ifd($i.value) {};
 
                   for {set ii 0} {$ii < $ifd($i.count)} {incr ii} {
                      set rational {}
 
                      lappend rational [getb $ifh(byteOrder) $fid Long];
                      lappend rational [getb $ifh(byteOrder) $fid Long];
                      lappend ifd($i.value) $rational;
                   }
                }
             }
 
             set ifd($i.offset) [format "0x%X/%ld" $ifd($i.offset) $ifd($i.offset)];
          } else {
             set ifd($i.offset) "<ifd>";
          }
       }
 
       # reading/collecting image file directory tag values
       #
       for {set i 0} {$i < $ifd(.entryCount)} {incr i} {
          set varName   [tiffIfdTags $ifd($i.tag)];
 
          switch -exact -- $varName {
             compression {set value [compression $ifd($i.value)];}
             photometric {set value [photometric $ifd($i.value)];}
             xResolution -
             yResolution {
                set value   {};
                
                foreach fraction $ifd($i.value) {
                   foreach {numerator denominator} $fraction {break;};
 
                   if {!$denominator} {
                      lappend value "$numerator / $denominator => divide by zero";
                   } else {
                      lappend value [expr {$numerator / $denominator}];
                   }
                }
             }
             resolutionUnit {set value   [resolutionUnit $ifd($i.value)];}
             default        {set value   $ifd($i.value);}
          }
 
          set $varName      $value;
          set ifd($varName) [list $value $ifd($i.type) $ifd($i.count) $ifd($i.offset)];
       }
       
       set bitsPerPixel 0;
       
       foreach sampleBits $bitsPerSample {
          incr bitsPerPixel $sampleBits;
       }
 
       set ifd(bitsPerPixel) [list $bitsPerPixel Short 1 "<calculated>"];
       
       array unset ifd {.*};
       array unset ifd {[0-9]*.*};
 
       # reading the rgb data
       #
       if {[info exists stripOffset]} {
          set ifd(stripCount) [list [llength $stripOffset] Short 1 "<calculated>"];
       } else {
          set ifd(stripCount) [list 0 Short 1 "<calculated>"];
          set stripOffset     {};
          set stripByteCount  {};
       }
 
       if {$bufferVar != ""} {
          set buffer   {};
 
          foreach offset $stripOffset byteCount $stripByteCount {
             seek $fid $offset start;
 
             lappend buffer [getb $ifh(byteOrder) $fid Byte $byteCount];
          }
       }
 
       # finishing and closing the TIFF image file
       #
       close $fid;
 
       return;
    }
 
    proc dumpTiff {tiffFileName {out ""} {saveRawData 0}} {
       if {$saveRawData} {
          set rawDataVar rawData
       } else {
          set rawDataVar "";
       }
 
       if {[catch {tiff2raw $tiffFileName ifh ifd $rawDataVar;} reason]} {
          error "couldn't dump TIFF image file \"$tiffFileName\": $reason" $::errorInfo $::errorCode;
       }
        
       if {$saveRawData} {
          set f   [open $tiffFileName.raw w];
          fconfigure $f \
             -translation binary \
             -buffering   full \
             -buffersize  1000000;
          puts -nonewline $f [join $rawData ""];
          close $f;
       }
 
       set names [linsert [lsort -dictionary [array names ifd]] -1 "fileName" "byteOrder"];
 
       set ifd(fileName) $tiffFileName;
 
       if {$ifh(byteOrder) == "MM"} {
          set ifd(byteOrder) "big endian";
       } else {
          set ifd(byteOrder) "little endian";
       }
 
       set nameWidth 0;
 
       foreach name $names {
          if {[string length $name] > $nameWidth} {
             set nameWidth [string length $name];
          }
       }
 
       set labelWidth 0;
 
       foreach name $names {
          if {($name == "fileName") || ($name == "byteOrder")} {
             continue;
          }
 
          foreach {value type count offset} $ifd($name) {break;};
 
          set ifd($name) [list [set label [format "%-${nameWidth}s <%s\[%s\]> @ %s" $name $type $count $offset]] $value];
 
          if {[string length $label] > $labelWidth} {
             set labelWidth [string length $label];
          }
       }
 
       if {$out == ""} {
          set out $tiffFileName.dump.txt;
       }
 
       if {[file channels $out] == ""} {
          if {[catch {set out [open $out w];} reason]} {
             error "couldn't dump TIFF image file \"$tiffFileName\": $reason" $::errorInfo $::errorCode;
          }
       }
 
       foreach name $names {
          if {($name == "fileName") || ($name == "byteOrder")} {
             set label $name;
             set value $ifd($name);
          } else {
             foreach {label value} $ifd($name) {break;};
          }
 
          puts $out [format "%-${labelWidth}s = '%s'" $label $value];
       }
 
       close $out;
 
       return;
    }
    
    proc photo2raw {photo rawDataVar} {
       if {[info commands tk] == {}} {
          upvar $photo imgPhotoData;
       } elseif {[lsearch -exact [image names] $photo] < 0} {
          error "couldn't convert the tk photo \"$photo\" to raw image data: no such photo";
       } else {
          set imgPhotoData [$photo data];
       }
 
       upvar $rawDataVar rawData;
 
       set rawData "";
       set width   [llength [lindex $imgPhotoData 0]];
       set height  [llength $imgPhotoData];
 
       foreach row $imgPhotoData {
          foreach pixel $row {
             scan $pixel "#%02x%02x%02x" red green blue;
 
             append rawData [binary format ccc $red $green $blue]
          }
       }
 
       return [list $width $height];
    }
 
    proc photo2tiff {photo tiffFileName description xdpi ydpi} {
       if {[info commands tk] == {}} {
          upvar $photo imgPhotoData;
 
          if {[catch {foreach {width height} [photo2raw imgPhotoData buffer] {break;};} reason]} {
             error "couldn't convert the tk photo \"$photo\" to TIFF image file \"$tiffFileName\": $reason";
          }
       } elseif {[lsearch -exact [image names] $photo] < 0} {
          error "couldn't convert the tk photo \"$photo\" to TIFF image file \"$tiffFileName\": no such photo";
       } else {
          if {[catch {foreach {width height} [photo2raw $photo buffer] {break;};} reason]} {
             error "couldn't convert the tk photo \"$photo\" to TIFF image file \"$tiffFileName\": $reason";
          }
       }
 
       if {[catch {raw2tiff $tiffFileName $description $width $height $xdpi $ydpi buffer;} reason]} {
          error "couldn't convert the tk photo \"$photo\" to TIFF image file \"$tiffFileName\": $reason" $::errorInfo $::errorCode;
       }
 
       return;
    }
 
    proc tiff2photo {tiffFileName photo {ifdVar ""}} {
       if {[catch {tiff2raw $tiffFileName ifh ifd rawData;} reason]} {
          error "couldn't convert TIFF image file \"$tiffFileName\" to the tk photo \"$photo\": $reason" $::errorInfo $::errorCode;
       }
        
       set bitsPerSample   [lindex $ifd(bitsPerSample)   0];
       set samplesPerPixel [lindex $ifd(samplesPerPixel) 0];
 
       switch -exact -- [lindex $ifd(photometric) 0] {
          RGB {
             if {($samplesPerPixel == 3) &&
                 ($bitsPerSample   == "8 8 8")} {
                set export 1;
             } else {
                set export 0;
             }
          }
          "RGB Palette" {
             if {($samplesPerPixel == 1) &&
                 ($bitsPerSample   == 8)} {
                set export 2;
             } else {
                set export 0;
             }
 
             set colourMap   [lindex $ifd(colorMap) 0];
          }
          whiteIsZero {
             if {($samplesPerPixel == 1) &&
                 (($bitsPerSample == 1) ||
                  ($bitsPerSample == 8))} {
                set export 3;
             } else {
                set export 0;
             }
 
             set bitNotZero "#000000";
             set bitZero    "#FFFFFF";
          }
          blackIsZero {
             if {($samplesPerPixel == 1) &&
                 (($bitsPerSample == 1) ||
                  ($bitsPerSample == 8))} {
                set export 4;
             } else {
                set export 0;
             }
 
             set bitNotZero "#FFFFFF";
             set bitZero    "#000000";
          }
          default {set export 0;}
       }
 
       if {$export &&
           ([lindex $ifd(compression) 0] == "Uncompressed") &&
           ![info exists ifd(tileLength)]} {
          set bytesPerRow  [expr {int(ceil([lindex $ifd(bitsPerPixel) 0] * [lindex $ifd(width) 0] / 8))}];
          set rowsPerStrip [lindex $ifd(rowsPerStrip) 0];
          set imgPhotoData {};
          set stripIdx     0;
 
          foreach stripData $rawData stripByteCount [lindex $ifd(stripByteCount) 0] {
             for {set rowIdx 0; set byteCount 0} {($rowIdx < $rowsPerStrip) && ($byteCount < $stripByteCount)} {incr rowIdx; incr byteCount   $bytesPerRow} {
                set strip1stIdx [expr {$rowIdx*$bytesPerRow}];
                set strip2ndIdx [expr {$strip1stIdx + $bytesPerRow - 1}];
 
                set imgPhotoRowData {};
 
                switch -exact -- $export {
                   1   {
                      binary scan [string range $stripData $strip1stIdx $strip2ndIdx] c* rowData;
 
                      foreach {red green blue} $rowData {
                         set red   [expr {$red   & 0xFF}];
                         set green [expr {$green & 0xFF}];
                         set blue  [expr {$blue  & 0xFF}];
 
                         lappend imgPhotoRowData [format "#%02X%02X%02X" $red $green $blue];
                      }
                   }
                   2   {
 
                      binary scan [string range $stripData $strip1stIdx $strip2ndIdx] c* rowData;
 
                      foreach colourIdx $rowData {
                         foreach {red green blue} [lrange $colourMap [set colourIdx [expr {($colourIdx & 0xFF) * 3}]] [incr colourIdx 2]] {break;};
 
                         set red   [expr {int($red   / 256) & 0xFF}];
                         set green [expr {int($green / 256) & 0xFF}];
                         set blue  [expr {int($blue  / 256) & 0xFF}];
 
                         lappend imgPhotoRowData [format "#%02X%02X%02X" $red $green $blue];
                      }
                   }
                   3   -
                   4   {
                      switch -exact -- $bitsPerSample {
                         1 {
                            binary scan [string range $stripData $strip1stIdx $strip2ndIdx] b* rowData;
 
                            foreach bit [split $rowData {}] {
                               if {$bit} {
                                  lappend imgPhotoRowData $bitNotZero;
                               } else {
                                  lappend imgPhotoRowData $bitZero
                               }
                            }
                         }
                         8 {
                            binary scan [string range $stripData $strip1stIdx $strip2ndIdx] c* rowData;
 
                            foreach gray $rowData {
                               set gray [expr {$gray & 0xFF}];
 
                               # if black backround is set, invert colour value
                               #
                               if {$export == 4} {
                                  set gray [expr {0xFF - $gray}];
                               }
                               
                               lappend imgPhotoRowData [format "#%02X%02X%02X" $gray $gray $gray];
                            }
                         }
                      }
                   }
                }
 
                lappend imgPhotoData $imgPhotoRowData;
             }
 
             incr stripIdx;
          }
 
          if {[info commands tk] == {}} {
             upvar $photo var;
 
             set var $imgPhotoData;
 
             return;
          }
 
          if {[lsearch -exact [image names] $photo] >= 0} {
             $photo blank;
          } else {
             image create photo $photo;
          }
 
          $photo put $imgPhotoData;
 
          upvar $ifdVar newIfd;
 
          array set newIfd [array get ifd];
       } else {
          error "couldn't convert TIFF image file \"$tiffFileName\" to the tk photo \"$photo\": non-exportable TIFF image file, must be an uncompressed black/white-, grayscale-, or RGB(-Palette) image, with maximum 24bit colour depth, without extra samples and not tiled";
       }
 
       return;
    }
 
    namespace export -clear tiff2raw raw2tiff dumpTiff photo2raw photo2tiff tiff2photo;
 }
 
 uplevel #0 {
    namespace import -force ::tiff::*;
 }