'''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. ---- 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 . { .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} ---- [Category Graphics] - [Category File]