Forum OpenACS Development: photo-album with tclmagick

Collapse
Posted by Malte Sussdorff on
I managed to get photo-album to use tclmagick instead of calling convert manually. Here is the patch and I am happy for any suggestions to make it easier (especially the part on keeping the ratio).

@@ -9,6 +9,8 @@
@cvs-id $Id: photo-album-procs.tcl,v 1.17 2006/08/08 21:27:08 donb Exp $
}

+package require TclMagick
+
# mailto:wtem@olywa.net, 2001-09-19
# there are several procs that we may be able to replace
# with standard cr procs now that it handles file system storage of images
@@ -370,8 +372,29 @@
if {[regexp {^[0-9]+$} $geometry]} {
set geometry ${geometry}x${geometry}
}
- ns_log debug "pa_make_new_image: Start convert, making $new_image geometry $geometry"
- exec [ad_parameter ImageMagickPath]/convert -geometry $geometry -interlace None -sharpen 1x2 $base_image $new_image
+
+ ns_log Debug "pa_make_new_image: Start convert, making $new_image geometry $geometry"
+
+ set wand [magick create wand]
+ $wand ReadImage $base_image
+ set width "[$wand width].0"
+ set height "[$wand height].0"
+ set ratio [expr $width / $height]
+ set geo_list [split $geometry "x"]
+ if {$ratio >1} {
+ set new_width [lindex $geo_list 0]
+ set new_height [expr [lindex $geo_list 0] / $ratio]
+ } else {
+ set new_height [lindex $geo_list 1]
+ set new_width [expr [lindex $geo_list 1] * $ratio]
+ }
+
+ $wand resize [expr int($new_width)] [expr int($new_height)]
+ $wand contrast 1
+ $wand interlace none
+ $wand WriteImage $new_image
+ magick delete $wand
+
if {[catch {exec jhead -dt $new_image} errmsg]} {
ns_log Warning "pa_make_new_image: jhead failed with error - $errmsg"
}
@@ -906,7 +929,7 @@
set thumb_size [parameter::get -parameter ThumbnailSize -package_id $package_id]
set thumb_filename [pa_make_file_name -ext $BaseExt $thumb_rev_id]
set full_thumb_filename [file join $tmp_path $thumb_filename]
- pa_make_new_image ${full_viewer_filename} ${full_thumb_filename} $thumb_size
+ pa_make_new_image $image_file ${full_thumb_filename} $thumb_size
foreach {thumb_bytes thumb_width thumb_height thumb_type thumb_mime thumb_colors thumb_quantum thumb_sha256} [pa_file_info $full_thumb_filename] {}

# copy the tmp file to the cr's file-system

Collapse
Posted by Dave Bauer on
Malte,

This looks good.

Any interest in making this reusable by updating the image-procs.tcl in the content repository to use this (conditionall, and fall back to exec convert when tclmacgick is not available)?

If you can't do it, I'll put it on my list (eventually some of the things on there get done!)

Collapse
Posted by Malte Sussdorff on
Hmm... I won't get around to it the next few days, but I will keep this in mind and whoever has it first can post on this thread.

I will also update the installation instructions for AOLserver on cognovis website to include tclmagick.