################################################################
# proc blueScreen {imageName newImageName {slop 1}}--
# Make a pure-blue bluescreened image.
# Pixels which are more blue than (R+G) * slop
# get turned pure blue in the modified image.
# Arguments
# imageName The name of a disk file with the original image
# newImageName The name of the file to receive the true-blue image
# slop A multiiplier for the R+G
# Results
# A new image is written to disk.
# The new file is named foo-BL.gif for foo.gif
proc blueScreen {imageName newImageName slop} {
set im [image create photo -file $imageName]
set im2 [image create photo -width [image width $im] \
-height [image height $im]]
# Creating the canvas is unnecessary,
# but it shows what's going on and helps tune the slop
canvas .c -width [image width $im] \
-height [expr ([image height $im] * 2)]
pack .c
.c create image 0 0 -anchor nw -image $im
.c create image 0 [image height $im] -anchor nw -image $im2
for {set y 0} {$y < [image height $im]} {incr y} {
for {set x 0} {$x < [image width $im]} {incr x} {
foreach {r1 g1 b1} [$im get $x $y] {break;}
if {$b1 > (($r1 + $g1) * $slop)} {
set b1 255; set r1 0; set g1 0
}
set color [format {#%02x%02x%02x} $r1 $g1 $b1]
$im2 put $color -to $x $y
}
update; update idle;
}
$im2 write $newImageName
}
if {$argc == 0} {
puts "bluescreen.tcl imageName.gif ?slop?"
exit
}
# Set the sloppiness value.
set slop 1
if {$argc > 1} {
set slop [lindex $argv 1]
}
# Get the image file name and generate a new image name.
set imageName [lindex $argv 0]
set base [file root [file tail $imageName]]-BL[file extension $imageName]
set newImageName [file join [file dirname $imageName] $base]
puts "slop: $slop"
blueScreen $imageName $newImageName $slop
exit