Version 1 of Matthias Hoffmann - PhotoPrinter

Updated 2005-11-23 11:24:18

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...) program's, but the 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.

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 http://wiki.tcl.tk/2548
 }

 ################################################################################
 # Fenster zentrieren; aus mini.net/tcl/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: http://mini.net/tcl/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