Matthias Hoffmann - PhotoPrinter

PhotoPrinter

I'm currently working on a routine, which I haven't found freely available on the internet. I've tested 30 to 40 (including popular commercial ones...) programs, but they all don't fit my (simple) needs. What I want is:

  • Given a directory with JPEG-Files, running a single batch command (or little gui), and let the program produce a nicely formatted picture album without the need for interaction oder dragging and clicking. The album is for printing. You can see a scaled down example of what the output looks like here: [L1 ].

The requirements for the output and design of the "photoalbum" are relatively simple:

  • the order of the photos must not change (with one single exception to better use the page area)
  • the size relations must be kept: landscape photos should not shrink in height or flip to fit on the page
  • the 'incoming' photos are in different sizes, so resizing must take place
  • absolutely no user interaction should be required; the program has to be intelligent enough to handle all the required steps to produce it's output automatically
  • (to be completed)

Comments:

  • I've rewritten the prog to produce one pdf for each album page to work around the memory problem.
  • currently I'm using a special version of pdf4tcl which is not yet available on the download page, but since I overcome the memory problem (see above), it could be readapted to use the original pdf4tcl-version.
  • Later on, I will create a nice gui and pack the whole thing as a wrapped starpack.

In my first steps I tried to use a canvas and planned to produce Postscript from it. But then I found the pdf4tcl tool and found that this was the better way. But since this tool is still in development, there are some problems: Because not all output is immediately written to disk, instead cumulated in memory, after 30-40 3 MByte-JPGs the tclsh crashes with a memory dump.....

This program is still very experimental, but it works. I know, this program is much too big for the wiki, but I actualy could not access my personal home page (later, I will post some example output and the .tcl-file itself there. Later I will post a .kit and .exe version, too, if the problems with pdf4tcl are solved...)


 ################################################################################
 #
 # Skript: PPTEST12P.TCL
 # Stand:  14.08.2005 - Variante zur Erzeugung einer PDF Datei per Seite
 #                      (da PDF-Lib immer noch fehlerhaft)
 # Zweck:  Einlesen, Skalieren und Positionieren von Bildern, Ausgabe als PDFs
 # Status: in Arbeit
 #
 # Weitere Kommentare, Ideen: siehe PPTEST12 und Vorgängerscripts
 #
 # Frage: Tk erforderlich? (allein wg. Tk scaling?) Sonst rewrite als reines
 #        Cmdline-Tool (mit wahlweise -verbose-Output) & jpegsize möglich.
 #
 # ToDo:
 #  - PDF4TCL für sofortige Dateiausgabe patchen (ok im Test, aber jetzt wieder
 #    ohne ProgressBar-Callback; stürzt nach wie vor ab...!)
 #  - Schalter -onepdfperpage (-oppp)
 #  - (wahlweise) Headings, Seiten#, Dateinamen ausgeben
 #  - Papierformat wählbar, z.B. A4L. Dann PageW(A4L), PageH(A4L) etc. verwenden!
 #  - ZIP-Package: bringt es tatsächlich etwas (vergleichen mit schwach komr. JPGs)
 #  - GUI rund machen
 #  - Aufräumen Überflüssiges
 #  - Weitere Umstellung auf PUNKT (1/72 inch) (->PDF), um Umrechnungen zu verm.?
 #  - Fehlerhandling (CATCHes)
 #  - set set set vs. array set: beides gleich schnell, nur evtl. umstellen
 #
 ################################################################################
 # Seiteneinteilung (Bezugsbereiche für Positionierung):
 #
 #    1       3
 #        5
 #    2       4
 #
 # ACHTUNG: PDF-Koordinatensystem beginnt LINKS UNTEN!
 ################################################################################

 ################################################################################
 # Standardmodule (später Fehler evtl. selbst melden, wenn nicht verfügbar)
 ################################################################################

 package require jpeg;        # aus tcllib (Abfrage von JPEG-Parametern)
 package require pdf4tcl;     # http://truckle.in-chemnitz.de/pdf4tcl/
 package require progressbar; # etwas Optik
 package require zlib;        # schon hier, damit Fehler sichtbar werden

 ################################################################################
 # Hilfsprozeduren - nicht benötigtes ggF. noch entfernen
 # Verwendung von ROUND() hier oder anderswo führt teilweise zu Fehlern, klären!
 ################################################################################

 proc pixel2mm {px} {
      return [expr {$px / $::ppm}]
 }
 proc mm2pixel {mm} {
      return [expr {$mm * $::ppm}]
 }
 proc mm2pt {mm} {
      return [expr {$mm / 25.4 * 72}]
 }
 proc pt2mm {pt} {
      return [expr {$pt / 72 * 25.4}]
 }
 proc pixel2pt {px} {
      return [expr {$px / $::ppi * 72}]
 }
 proc pt2pixel {pt} {
      return [expr {$pt / 72 * $::ppi}]
 }
 proc min {eins zwei} {
      return [expr {$eins <= $zwei ? $eins : $zwei}]
 }
 proc swap {eins zwei} {
      upvar $eins a
      upvar $zwei b
      foreach {a b} [list $b $a] break; # siehe https://wiki.tcl-lang.org/2548
 }

 ################################################################################
 # Fenster zentrieren; aus https://wiki.tcl-lang.org/1254 modifiziert (aus RECEIVE.TCL)
 #
 proc center_window {w} {
      wm withdraw $w
      update idletasks
      set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2]
      set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2]
      wm geom $w +$x+$y
      wm deiconify $w
 }

 ################################################################################
 # Ermitteln der skalierten Grösse eines Bildes, in Pt (für PDF) und Px (Resize)
 #  Eingabe: width height (in Pixeln) orientation (landscape|portrait)
 ################################################################################

 proc scalePic {args} {

      set imgW [lindex $args 0]; # Breite des Bildes in Pixeln (von ::jpeg::dimensions)
      set imgH [lindex $args 1]; # Höhe des Bildes in Pixeln (von ::jpeg::dimensions)
      set imgF [lindex $args 2]; # Orientierung

      # kleine Bilder normalerweise nicht vergrössern!
      if {$::ExpandSmallImages == 0 && \
          $imgW <= $::maxImgW       && \
          $imgH <= $::maxImgH} {
          set newImgW [expr {round([pixel2pt $imgW])}]
          set newImgH [expr {round([pixel2pt $imgH])}]
          # Dims zurückgeben (Pt)
          # Dims zurückgeben (Pt UND Pixel, falls Resizing)
          return [list $newImgW $newImgH $imgW $imgH]
      }

      if {[string equal $imgF "portrait"]} {
         # Für weitere Berechnungen unten das Bild gedanklich drehen
         swap imgH imgW
      }
      # Zunächst Skalierungsfaktor durch das Verhältnis der Breiten bestimmen.
      # D.h., wenn das Bild um den Faktor fW in der Breite verkleinert wird,
      # wird es xxxmm breit. Ebensolches für die Höhe.
      # Da das Bild nicht verzerrt werden darf, muss ein einheitlicher Skalierungs-
      # faktor verwendet werden, nämlich der kleinere von beiden, sonst würde entweder
      # die Höhe oder Breite den vorgegebenen Rahmen sprengen.
      set fW [expr {$::maxImgW / $imgW}]
      set fH [expr {$::maxImgH / $imgH}]
      set fX [min $fW $fH]
      # Korrektur von oben rückgängig machen
      if {[string equal $imgF "portrait"]} {
         swap imgH imgW
      }
      # Berechnen der neuen Dimensionen durch Skalierung mit dem eben
      # ermittelten Faktor fX
      set imgW [expr {$imgW*$fX}]
      set imgH [expr {$imgH*$fX}]
      # Ergebnis in Pt (á 1/72 inch) umrechnen
      set newImgW [expr {round([pixel2pt $imgW])}]
      set newImgH [expr {round([pixel2pt $imgH])}]
      # Dims zurückgeben (Pt UND Pixel, falls Resizing)
      return [list $newImgW $newImgH $imgW $imgH]
 }

 ################################################################################
 # Bild resizen, wenn gewünscht, und als TempKopie auf Platte ablegen unmittel-
 # bar vor der Einbinding ins PDF.
 #  (in PDF einzufügende JPG-Grössen reduzieren, verhindert allerdings auch
 #   vernünftiges Zoomen im PDF-Reader...). Für PreView-PDF (Layout-Kontrolle).
 # Liefert Originalnamen oder, falls Resizing aktiv, TmpNamen.
 ################################################################################

 proc getPic {nr} {
      set name $::photo($nr,name)
      if {$::resizePics == 0} {
         return $name
      }
      .info configure -text "Resizing [file tail $name]..."
      update
      set img [image create photo -file $name -format jpeg]; # Foto von Disk
      # ACHTUNG: `resize` benötigt GANZZahlen! Deshalb diese doch wieder aus
      # `ScalePic` zurückgeben
      set w [lindex $::photo($nr,newDim) 2]; # Pixel
      set h [lindex $::photo($nr,newDim) 3]; # Pixel
      set w [expr round($w)]; # ist das runden hier ein Problem?
      set h [expr round($h)]; # führt es zu weiteren PDF-Skalierungsversuchen?
    # set img [resize $img $w $h]; # ist leider laaaangsam, aber bessere Qualität
    # Alternative: Suchenwirth's schnelle Skalierung (benötigt FAKTOR):
      set faktor [expr {$w*1.0/[image width $img]}]
 # tk_messageBox -message "[image width $img]:$w -> $faktor"; exit
      scaleImage $img $faktor
      $img write $::tmpFile -format jpeg
      image delete $img; # Speicher freigeben!!!!
      # damit nun PDF nicht nochmals resizen muss, die exakten Pt-Dimensionen
      # im Bildarray manipulieren, falls diese durch Rundung abweichen!
      set ::photo($nr,newDim) [list \
          [pixel2pt $w] [pixel2pt $h] $w $h]
      return $::tmpFile
 }

 # Schnellere Alternative zu `resize` unten, benötigt aber einen FAKTOR:
 # Aus: wiki.tcl.tk/8448 (RS)
 proc scaleImage {im xfactor {yfactor 0}} {
      set mode -subsample
      if {abs($xfactor) < 1} {
         set xfactor [expr round(1./$xfactor)]
      } elseif {$xfactor>=0 && $yfactor>=0} {
          set mode -zoom
      }
      if {$yfactor == 0} {set yfactor $xfactor}
      set t [image create photo]
      $t copy $im
      $im blank
      $im copy $t -shrink $mode $xfactor $yfactor
      image delete $t
 }

 # Aus: https://wiki.tcl-lang.org/11196    (es fehlt: pbar-keep-alive)
 #
 ################################################################################
 #
 #  Name:         resize
 #
 #  Decsription:  Copies a source image to a destination
 #                image and resizes it using linear interpolation
 #
 #  Parameters:   newx   - Width of new image
 #                newy   - Height of new image
 #                src    - Source image
 #                dest   - Destination image (optional)
 #
 #  Returns:      destination image
 #
 ################################################################################

 proc resize {src newx newy {dest ""} } {

     set mx [image width $src]
     set my [image height $src]

     if { "$dest" == ""} {
         set dest [image create photo]
     }
     $dest configure -width $newx -height $newy

     # Check if we can just zoom using -zoom option on copy
     if { $newx % $mx == 0 && $newy % $my == 0} {

         set ix [expr {$newx / $mx}]
         set iy [expr {$newy / $my}]
         $dest copy $src -zoom $ix $iy
         return $dest
     }

     set ny 0
     set ytot $my

     for {set y 0} {$y < $my} {incr y} {

         #
         # Do horizontal resize
         #

         foreach {pr pg pb} [$src get 0 $y] {break}

         set row [list]
         set thisrow [list]

         set nx 0
         set xtot $mx

         for {set x 1} {$x < $mx} {incr x} {

             # Add whole pixels as necessary
             while { $xtot <= $newx } {
                 lappend row [format "#%02x%02x%02x" $pr $pg $pb]
                 lappend thisrow $pr $pg $pb
                 incr xtot $mx
                 incr nx
             }

             # Now add mixed pixels

             foreach {r g b} [$src get $x $y] {break}

             # Calculate ratios to use

             set xtot [expr {$xtot - $newx}]
             set rn $xtot
             set rp [expr {$mx - $xtot}]

             # This section covers shrinking an image where
             # more than 1 source pixel may be required to
             # define the destination pixel

             set xr 0
             set xg 0
             set xb 0

             while { $xtot > $newx } {
                 incr xr $r
                 incr xg $g
                 incr xb $b

                 set xtot [expr {$xtot - $newx}]
                 incr x
                 foreach {r g b} [$src get $x $y] {break}
             }

             # Work out the new pixel colours

             set tr [expr {int( ($rn*$r + $xr + $rp*$pr) / $mx)}]
             set tg [expr {int( ($rn*$g + $xg + $rp*$pg) / $mx)}]
             set tb [expr {int( ($rn*$b + $xb + $rp*$pb) / $mx)}]

             if {$tr > 255} {set tr 255}
             if {$tg > 255} {set tg 255}
             if {$tb > 255} {set tb 255}

             # Output the pixel

             lappend row [format "#%02x%02x%02x" $tr $tg $tb]
             lappend thisrow $tr $tg $tb
             incr xtot $mx
             incr nx

             set pr $r
             set pg $g
             set pb $b
         }

         # Finish off pixels on this row
         while { $nx < $newx } {
             lappend row [format "#%02x%02x%02x" $r $g $b]
             lappend thisrow $r $g $b
             incr nx
         }

         #
         # Do vertical resize
         #

         if {[info exists prevrow]} {

             set nrow [list]

             # Add whole lines as necessary
             while { $ytot <= $newy } {

                 $dest put -to 0 $ny [list $prow]

                 incr ytot $my
                 incr ny
             }

             # Now add mixed line
             # Calculate ratios to use

             set ytot [expr {$ytot - $newy}]
             set rn $ytot
             set rp [expr {$my - $rn}]

             # This section covers shrinking an image
             # where a single pixel is made from more than
             # 2 others.  Actually we cheat and just remove
             # a line of pixels which is not as good as it should be

             while { $ytot > $newy } {

                 set ytot [expr {$ytot - $newy}]
                 incr y
                 continue
             }

             # Calculate new row

             foreach {pr pg pb} $prevrow {r g b} $thisrow {

                 set tr [expr {int( ($rn*$r + $rp*$pr) / $my)}]
                 set tg [expr {int( ($rn*$g + $rp*$pg) / $my)}]
                 set tb [expr {int( ($rn*$b + $rp*$pb) / $my)}]

                 lappend nrow [format "#%02x%02x%02x" $tr $tg $tb]
             }

             $dest put -to 0 $ny [list $nrow]

             incr ytot $my
             incr ny
         }

         set prevrow $thisrow
         set prow $row

         update idletasks
     }

     # Finish off last rows
     while { $ny < $newy } {
         $dest put -to 0 $ny [list $row]
         incr ny
     }
     update idletasks

     return $dest
 }

 ################################################################################
 # Dateien einlesen (später globx benutzen, Fehlermeldung)
 #  LSORT erforderlich?
 ################################################################################

 proc getFiles {path} {
      return [lsort [glob -nocomplain -directory $path -- *.jpg *.jpeg]]
 }

 ################################################################################
 # Callback für gepatchte pdf4tcl-Routine write2 (momentan nicht benutzt)
 ################################################################################

 proc cbWritePDF {val} {
     set ::pbarV $val
     update
 }

 ################################################################################
 # Berechnet Abstände nach oben, unten und ggf. zwischen den Elementen
 ################################################################################

 proc computeDistV {args} {
      set consumed 0
      set elems    1
      foreach a $args {
              incr elems
              incr consumed [lindex $::photo($a,newDim) 1]
      }
      return [expr {round(($::pageH-$consumed)/$elems)}]
 }

 ################################################################################
 # Berechnet Abstände nach links, rechts und zwischen linker/rechter Hälfte
 ################################################################################

 proc computeDistH {args} {
      set consumed 0
      set elems    1
      foreach a $args {
              incr elems
              incr consumed [lindex $::photo($a,newDim) 0]
      }
      return [expr {round(($::pageW-$consumed)/$elems)}]
 }

 ################################################################################
 # Berechnet die maximalen Bildmasse WxH unter Berücksichtigung folgender
 # Rahmenbedingungen:
 #    - Ränder
 #    - Papierformat
 #    - Bildverhältnis sollte optimal sein, d.h. 1:1,5 (24x36!) bzw.
 #      Verhältnisses der üblichen DigiCam-Formate angepasst werden
 #    - Annahme: Höhe 2xLS ist immer grösser als 1xP (ist bei 1:1,5 gegeben)
 # Vorteil: ohne weiteren Eingriff anderes Papierformat wählbar, z.B. A5L
 ################################################################################

 proc calcMaxPhotoDims {minMarLR minMarTB {scaling 100}} {
      # (Wo) RUNDEN ????????????????
      set minMarLR [mm2pt $minMarLR]
      set minMarTB [mm2pt $minMarTB]
      set maxW [expr {($::pageW-($minMarLR*3))/2}]
      set maxH [expr {($::pageH-($minMarTB*3))/2}]
    # tk_messageBox -message "(1-vor Justierung und Skalierung) W x H := [pt2mm $maxW] x [pt2mm $maxH]" -title Debug -icon info
      # Justierung 1.5:1
      if {[expr {$maxH*1.5}] > $maxW} {
         # Höhe reduzieren, um Breitenüberschreitung zu verhindern
         set maxH [expr {$maxW/3*2}]
      } elseif {[expr {$maxW/3*2}] > $maxH} {
         # Breite reduzieren, um Höhenüberschreitung zu verhindern
         set maxW [expr {$maxH*1.5}]
      }
    # tk_messageBox -message "(3-nach 2:3-Justierung) W x H := [pt2mm $maxW] x [pt2mm $maxH]" -title Debug -icon info
      # Skalierung
      set maxW [expr {$maxW/100*$scaling}]
      set maxH [expr {$maxH/100*$scaling}]
    # tk_messageBox -message "(3-nach 2:3-Just und Skalierung) W x H := [pt2mm $maxW] x [pt2mm $maxH]" -title Debug -icon info
    # exit
    # bis hierhin ok!
      # wir brauchen das Ergebnis momentan noch in Pt !!!! PRÜFEN !!!!!!!!!
      set maxW [pt2pixel $maxW]
      set maxH [pt2pixel $maxH]
      return [list $maxW $maxH]
 }

 ################################################################################
 ################################################################################
 ###                                                                          ###
 ###                             M A I N                                      ###
 ###                                                                          ###
 ################################################################################
 ################################################################################

 ################################################################################
 # Einige globale Variablen (noch aufräumen)
 # Später Teile dieser Werte über die Kommandozeile einlesen (SPAR)
 #  (PPI mittels NVU justieren!)
 #  >>>> sinnvolle maximale Fotogrösse noch anpassen an Digi-Gegebenheiten
 #  >>>> Pt vs. Px vs. mm!!
 ################################################################################

 set s   [tk scaling]      ; # liefert 'Pixel per Point'; 1 Pt = 1/72 inch
 set ppi [expr {$s*72}]    ; # 'Pixel per Inch' (DPI); Windows zeigt momentan 96
 set ppm [expr {$ppi/25.4}]; # 'Pixel per mm' (1 Inch lt. Lexikon = 25,4 mm)
 set pageW [mm2pt    298]  ; # DINA4-Quer--Breite
 set pageH [mm2pt    210]  ; # DINA4-Quer--Höhe
 foreach {maxImgW maxImgH} [calcMaxPhotoDims 10 10] {break;}
 set ExpandSmallImages 0   ; # kleine Bilder standardmässig belassen
 set resizePics        0   ; # Bilder physisch auf Ausgabeformat herunterskalieren
                           ; # (langsam; kleine PDFs; nur für Preview!!!)
 if {$resizePics} {
     package require img::jpeg
 }
 set tmpFile [file join $::env(temp) &&_temp[pid]_.jpg]; # für evtl. Resizing
 # tk_messageBox -message "(3-nach 2:3-Just und Skalierung) W x H := [pixel2mm $maxImgW] x [pixel2mm $maxImgH]" -title Debug -icon info
 # exit

 ################################################################################
 # GUI-Optionen
 ################################################################################

 option add *Button.font {-family {Tahoma}  -size 8 -weight bold}
 option add *Button.activeBackground blue
 option add *Button.activeForeground white
 option add *Button.background lightgray
 option add *Label.font  {-family {Tahoma} -size 8 -weight normal}

 ################################################################################
 # Mini-GUI-aufbauen (später mehr Statusinformationen)
 ################################################################################

 wm title . {JPAlbum 0.1 02.06.2005 © Matthias Hoffmann}
 wm minsize . 400 80
 update
 label .what
 ::progressbar::progressbar .pbar -variable ::pbarV -width [expr {[winfo width .]-20}]
 label .name
 label .info
 button .abbr -text "Abbrechen" -command [list exit]; # später YN etc.
 # .pbar configure -width [expr {[winfo width .]-10}]; # bei Resize anpassen!
 pack .what -anchor nw -padx 10 -pady 10
 pack .pbar -anchor nw -padx 10 -expand 1 -fill x
 pack .name -anchor nw -padx 10 -pady 5
 pack .info -anchor nw -padx 10 -pady 5
 pack .abbr -anchor se -padx 15 -pady 5 -ipadx 10 -side right
 center_window .
 focus -force .

 ################################################################################
 # Bindings
 ################################################################################

 # funktioniert noch nicht korrekt!
 bind . <ResizeRequest> {
    .pbar configure -width [expr {%w-20}]
    update
 }

 # Kommandozeile vorbesetzen (später SPAR benutzen)
 if {![string length $argv]} {
    set argv ./
 }

 .what configure -text {1. Ermitteln von Grunddaten je Bilddatei...}
 update

 set jpgs [getFiles $argv]
 set jcnt [llength $jpgs]
 set nr 0; # PhotoNummer
 foreach jpg $jpgs {
         if {[::jpeg::isJPEG $jpg]} {
            incr nr
            # Kosmetik-Start
            .name configure -text [file tail $jpg]
            set ::pbarV [expr {$nr*100/$jcnt}]
            update
            # Kosmetik-Ende
            foreach {wPx hPx} [::jpeg::dimensions $jpg] break;
            set photo($nr,name) [file normalize $jpg]
            set photo($nr,dims) [list $wPx $hPx]; # Breite x Höhe in Pixeln original
            # einfügen weiterer Infos nach Bedarf, z.B.aus Exif (Vorsicht)
            set photo($nr,orientation) [expr {$wPx < $hPx ? "portrait" : "landscape"}]
            # neue Dimensionen ermitteln (Bilder können wechselnde Grösse haben)
            set photo($nr,newDim) [scalePic $wPx $hPx $photo($nr,orientation)]
         }; # später: Hinweis, falls kein JPEG!
 }
 set photoCount $nr;

 .info configure -text "$photoCount Bilder"
 .what configure -text {2. Ermitteln der Bildanordnung (Bildlayout)...}
 update

 # tk_messageBox -message "Photos: $photoCount" -type ok -icon info -title Kontrolle-1

 set nr 0; # PageNummer
 ### this 0
 set next 0 ;# nächstes Bild (wenn da)
 set anex 0 ;# übernächstes Bild (wenn da)
 set aane 0 ;# über-übernächstes Bild (wenn da)
 set photo(0,orientation) "-" ; # Dummy für Konstruktion des Testpatterns
 for {set this 1} {$this <= $photoCount} {incr this} {
     incr nr
     set next [expr {$this < $photoCount   ? $this+1 : 0}]
     set anex [expr {$this < $photoCount-1 ? $this+2 : 0}]
     set aane [expr {$this < $photoCount-2 ? $this+3 : 0}]
     # welche Photos enthalten die einzelnen Bereiche der Seite? 0 := keines
     set page($nr,1)  0
     set page($nr,2)  0
     set page($nr,3)  0
     set page($nr,4)  0
     set page($nr,5)  0
     # wird zur Berechung der Bildpositionen unten benötigt:
     # vSpcL = vertiakle Abstände oben/unten/Rand linke Hälfte
     # vSpcR = vertiakle Abstände oben/unten/Rand rechte Hälfte
     # hSpc  = horizontale Abstände zwischen links/rechts/Rand
     set test [list $photo($this,orientation) \
                    $photo($next,orientation) \
                    $photo($anex,orientation) \
                    $photo($aane,orientation)]
     # Designsteuerung/Regelwerk (geht das nicht eleganter - ohne SWITCH -
     # nur mittels regexp-Schablonen? Erwischt man alle Fälle?!)
     switch -regexp -- $test {
            {^portrait portrait} {
                 # tk_messageBox -message {portrait portrait}
                 # 2 Hochkant-Bilder -> Seite ist voll, weiter
                 set page($nr,2) $this
                 set page($nr,4) $next
                 set page($nr,vSpcL) [computeDistV $this]
                 set page($nr,vSpcR) [computeDistV $next]
                 set page($nr,hSpc)  [computeDistH $this $next]
                 incr this 1;
            }
            {^landscape landscape landscape landscape} {
                 # tk_messageBox -message {landscape landscape landscape landscape}
                 # 4 Quer-Bilder -> Seite ist voll, weiter
                 set page($nr,1) $this
                 set page($nr,2) $next
                 set page($nr,3) $anex
                 set page($nr,4) $aane
                 set page($nr,vSpcL) [computeDistV $this $next]
                 set page($nr,vSpcR) [computeDistV $anex $aane]
                 # Achtung: NUR DIE OBEREN BILDER ZÄHLEN!!! wenn die unteren beiden
                 # breiter sind, kommt es zu Überlappung, da diese einen geringeren
                 # Abstand erfordern! Also den KLEINEREN der beiden Abständer heran-
                 # ziehen! (gilt auch weiter unten teilweise)
                 set page($nr,hSpc) [min [computeDistH $this $anex] \
                                         [computeDistH $next $aane]]
                 incr this 3;
            }
            {^landscape landscape landscape (portrait|-)} {
                 # tk_messageBox -message {landscape landscape landscape (portrait|-)}
                 # 3 Querfotos und nix folgt oder Portrait ->
                 # Seite ist voll, rechtes Bild vertikal zentrieren
                 set page($nr,1) $this
                 set page($nr,2) $next
                 set page($nr,4) $anex
                 set page($nr,vSpcL) [computeDistV $this $next]
                 set page($nr,vSpcR) [computeDistV $anex]
                 set page($nr,hSpc) [min [computeDistH $this $anex] \
                                         [computeDistH $next $anex]]
                 incr this 2;
            }
            {^landscape landscape portrait} {
                 # tk_messageBox -message {landscape landscape portrait}
                 # 2 Quer-, 1 Hochkantbild -> Seite ist voll
                 set page($nr,1) $this
                 set page($nr,2) $next
                 set page($nr,4) $anex
                 set page($nr,vSpcL) [computeDistV $this $next]
                 set page($nr,vSpcR) [computeDistV $anex]
                 set page($nr,hSpc) [min [computeDistH $this $anex] \
                                         [computeDistH $next $anex]]
                 incr this 2;
            }
            {^landscape portrait landscape} {
                 # tk_messageBox -message {landscape portrait landscape}
                 # Quer, Hochkant, Quer -> Seite ist voll
                 # SONDERFALL: Reihenfolgenänderung: 3. Bild nach links unten,
                 # um das Papier besser auszunutzen! (sonst müsste 3.Bild auf
                 # nächste Seite)
                 set page($nr,1) $this
                 set page($nr,4) $next
                 set page($nr,2) $anex
                 set page($nr,vSpcL) [computeDistV $this $anex]
                 set page($nr,vSpcR) [computeDistV $next]
                 set page($nr,hSpc) [min [computeDistH $this $next] \
                                         [computeDistH $anex $next]]
                 incr this 2;
            }
            {^portrait landscape landscape} {
                 # tk_messageBox -message {portrait landscape landscape}
                 # Hochkannt + 2 Quer -> Seite ist voll
                 set page($nr,2) $this
                 set page($nr,3) $next
                 set page($nr,4) $anex
                 set page($nr,vSpcL) [computeDistV $this]
                 set page($nr,vSpcR) [computeDistV $next $anex]
                 set page($nr,hSpc) [min [computeDistH $this $anex] \
                                         [computeDistH $this $next]]
                 incr this 2;
            }
            {^portrait landscape (portrait|-)} {
                 # tk_messageBox -message {portrait landscape (portrait|-)}
                 # Hochkant + Quer -> Seite ist voll, Querbild rechts v. mittig
                 set page($nr,2) $this
                 set page($nr,4) $next
                 set page($nr,vSpcL) [computeDistV $this]
                 set page($nr,vSpcR) [computeDistV $next]
                 set page($nr,hSpc)  [computeDistH $this $next]
                 incr this 1;
            }
            {^landscape portrait (portrait|-)} {
                 # tk_messageBox -message {landscape portrait (portrait|-)}
                 # Quer + Hochkant -> Seite voll, Querbild links vertikal mittig
                 set page($nr,2) $this
                 set page($nr,4) $next
                 set page($nr,vSpcL) [computeDistV $this]
                 set page($nr,vSpcR) [computeDistV $next]
                 set page($nr,hSpc)  [computeDistH $this $next]
                 incr this 1;
            }
            {^landscape landscape - -} {
                 # tk_messageBox -message {landscape landscape - -}
                 # Sonderfall: zwei einzelne Landscapes auf der letzen Seite
                 set page($nr,2) $this
                 set page($nr,4) $next
                 set page($nr,vSpcL) [computeDistV $this]
                 set page($nr,vSpcR) [computeDistV $next]
                 set page($nr,hSpc)  [computeDistH $this $next]
                 incr this 1;
            }
            {^(landscape|portrait) -} {
                 # tk_messageBox -message {(landscape|portrait) -}
                 # Sonderfall: letztes und einziges Bild in der Blattmitte
                 set page($nr,5) $this
                 # wird unten gesondert zentriert!
            }
            default {
                 # tk_messageBox -message default
                 tk_messageBox \
                    -message "Unvorhergesehene Bildfolge/Konstellation:
                              $test\nProgrammlogik korrigieren/ergänzen?!
                              Seite: $nr Bild: $this" \
                    -icon error \
                    -title Fehler:
                 exit 1; # führt sonst weiter hinten zu Fehlern!
            }
     }
     # Kosmetik-Start
     .name configure -text "Seite: $nr"
     set ::pbarV [expr {$this*100/$photoCount}]
     update
     # Kosmetik-Ende
     # theoretisch liegt hier eine Seite vor, sie könnte bereits in PDF ausgegeben werden
 }
 set pageCount $nr

 # tk_messageBox -message "Pages: $pageCount" -type ok -icon info -title Kontrolle-2

 .info configure -text "$photoCount Bilder, $pageCount Seiten"
 update

 if {[tk_messageBox -message {PDF jetzt erzeugen?} -type yesno -icon question \
                    -title {Achtung:}] == "no"} {
    exit
 }

 .what configure -text {3. Erzeugen des PDF-Outputs...}
 update
 set outfile [file tail [file normalize $argv]]

 # compress hat definitiv keine Auswirkung auf die PDF-Grösse, vermutlich, weil
 # die JPGs bereits komprimiert sind. Auch der Absturz (./testbilder3) kommt mit
 # und ohne Compression.-

 for {set pNr 1} {$pNr <= $pageCount} {incr pNr} {

     if {$pNr > 1} {
        p1 endPage
        # p1 write2 -file test_xxx.pdf -callback cbWritePDF; # Patch 'write2', sonst Blockaden!
        # p1 write -file test_xxx.pdf; # ungepatchte, aktualisierte Version
        # wegen `directout` stattdessen:
        p1 finish
        p1 cleanup
     }

     pdf4tcl::new p1 -compress 1 -paper a4 -file [format "${outfile}_%03i.pdf" $pNr]
     # (-orient 1 ist bei ::new nicht vorgesehen!)
     p1 setFont 8 "Times-Roman"
     p1 startPage 842 595 0;# momentan einziger "offizieller" Weg für A4-quer

     # Pt-Angaben noch verifizieren!!!
     # Noch: Seitennummer (x von y) ausgeben (rechts oben), "Projekt"name
     # Kosmetik-Start
     set ::pbarV [expr {$pNr*100/$pageCount}]
     update
     # Kosmetik-Ende

     # die 1 bis max. 4 Photos positionieren
     # Irgendwie eleganter zu lösen?

     if {$page($pNr,1) != 0} {

        # später diese Folgen in einem PROC zusammenfassen !!!!!!!!!!
        set x $page($pNr,hSpc)
        set y [expr {$pageH/2+$page($pNr,vSpcL)/2}]
        set p $page($pNr,1)
        set w [lindex $photo($p,newDim) 0]
        set h [lindex $photo($p,newDim) 1]
        # tk_messageBox -message [time {#}]
        p1 addJpeg [getPic $p] $p
        p1 putImage $p $x $y -width $w -height $h
        p1 drawTextAt $x [expr {$y-10}] $p

     }

     if {$page($pNr,2) != 0} {

        # später diese Folgen in einem PROC zusammenfassen !!!!!!!!!!
        set x $page($pNr,hSpc)
        set y $page($pNr,vSpcL)
        set p $page($pNr,2)
        set w [lindex $photo($p,newDim) 0]
        set h [lindex $photo($p,newDim) 1]
        p1 addJpeg [getPic $p] $p
        p1 putImage $p $x $y -width $w -height $h
        p1 drawTextAt $x [expr {$y-10}] $p

     }

     if {$page($pNr,3) != 0} {

        # später diese Folgen in einem PROC zusammenfassen !!!!!!!!!!
        set p $page($pNr,3)
        set w [lindex $photo($p,newDim) 0]
        set h [lindex $photo($p,newDim) 1]
        set x [expr {$pageW-$w-$page($pNr,hSpc)}]
        set y [expr {$pageH/2+$page($pNr,vSpcR)/2}]
        p1 addJpeg [getPic $p] $p
        p1 putImage $p $x $y -width $w -height $h
        p1 drawTextAt $x [expr {$y-10}] $p

     }

     if {$page($pNr,4) != 0} {

        # später diese Folgen in einem PROC zusammenfassen !!!!!!!!!!
        set p $page($pNr,4)
        set w [lindex $photo($p,newDim) 0]
        set h [lindex $photo($p,newDim) 1]
        set x [expr {$pageW-$w-$page($pNr,hSpc)}]
        set y $page($pNr,vSpcR)
        p1 addJpeg [getPic $p] $p
        p1 putImage $p $x $y -width $w -height $h
        p1 drawTextAt $x [expr {$y-10}] $p

     }

     if {$page($pNr,5) != 0} {

        # Sonderfall: einzelnes Bild exakt in der Mitte zentrieren, keine weiteren
        # Infos erforderlich
        set p $page($pNr,5)
        set w [lindex $photo($p,newDim) 0]
        set h [lindex $photo($p,newDim) 1]
        set x [expr {($pageW-$w)/2}]
        set y [expr {($pageH-$h)/2}]
        p1 addJpeg [getPic $p] $p
        p1 putImage $p $x $y -width $w -height $h
        p1 drawTextAt $x [expr {$y-10}] $p

     }

 }

 p1 endPage
 # p1 write2 -file test_xxx.pdf -callback cbWritePDF; # Patch 'write2', sonst Blockaden!
 # p1 write -file test_xxx.pdf; # ungepatchte, aktualisierte Version
 # wegen `directout` stattdessen:
 p1 finish
 p1 cleanup

 # etwas Speicher sparen (ein Tropfen auf dem heissen Stein..., evtl. noch anderes?)
 # array unset photo
 # array unset page

 .what configure -text {Fertig!}
 update
 catch {file delete -force $tmpFile}; # existiert nur mit $::ResizePics == 1

UK well, it's not tcl but for batchjobs you could use the netpbm tools.

Fitting the images into a bounding box is easy and fast:

 #!/bin/bash

 BBOX="100 100"
 FILE="$1"
 STEM="${FILE%.*}"
 EXT=${FILE#${STEM}.}
 FFILE="${STEM}.fit.${EXT}"

 # echo $FILE $STEM $EXT $FFILE

 jpegtopnm ${FILE} \
        | pnmscale -xysize $BBOX \
        | pnmtojpeg \
 > ${FFILE}

and generating a same size index is even easier:

 #!/bin/bash

 while [ -n "$1" ] ; do 
     FILE="$1"
     STEM="${FILE%.*}"
     EXT=${FILE#${STEM}.}
     FFILE="${STEM}.fit.${EXT}"

     # echo $FILE $STEM $EXT $FFILE

     jpegtopnm ${FILE} \
     > ${FFILE}.pnm

     shift
 done
 pnmindex *pnm \
 |pnm2jpeg \
 >index.jpg

MHo Thanks. Currently I'm still working on M$-Windows. Tried to escape many times....


UK Here is your chance: NetPBM for Windows: http://gnuwin32.sourceforge.net/packages/netpbm.htm