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:
The requirements for the output and design of the "photoalbum" are relatively simple:
Comments:
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 == 1UK 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.jpgMHo 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