#1744 photo image write appears to fail under TclTkAqua

[Anonymous]

TclTkAqua 8.4.7

The ability to use the "write" option for photo images
appears to be broken under 8.4.6.1 and 8.4.7. The
following script from the ActiveState "Cookbook" section
correctly generates three versions of the same simple
canvas under windows 2K, Xp and Linux.

When run under TclTkAqua the image files generated are
identical, but show simply as black boxes, with no detail.
The script generates JPEG, GIF, and PNG files.

# Draw filled rectangle and some text into canvas at
position (x,y).
proc drawInfo { x y color } {
set size 10
set tx [expr $x + $size * 2]
.t.c create rectangle $x $y [expr $x + $size] [expr $y
+ $size] -fill
$color
.t.c create text $tx $y -anchor nw -fill $color -text
"$color box"
}

proc drawTestCanvas { imgVersion} {
if { [catch {toplevel .t -visual truecolor}] } {
toplevel .t
}
wm title .t "Canvas window"
wm geometry .t "+0+0"

canvas .t.c -bg gray -width 300 -height 220
pack .t.c

puts "Drawing text and rectangles into canvas .."
.t.c create rectangle 1 1 299 219 -outline black
.t.c create rectangle 3 3 297 217 -outline green -
width 2

drawInfo 140 10 black
drawInfo 140 30 white
drawInfo 140 50 red
drawInfo 140 70 green
drawInfo 140 90 blue
drawInfo 140 110 cyan
drawInfo 140 130 magenta
drawInfo 140 150 yellow

.t.c create text 160 170 -anchor nw -fill black -text
"Created
with:"
.t.c create text 160 190 -anchor nw -fill black -text
"Tcl
[info
patchlevel] and Img $imgVersion"
update
}

proc canvas2Photo { canvId } {
# The following line grabs the contents of the canvas
canvId into
photo image ph.
set retVal [catch {image create photo -format window
-data $canvId}
ph]
if { $retVal != 0 } {
puts "\n\tFATAL ERROR: Cannot create photo from
canvas
window"
exit 1
}
return $ph
}

set retVal [catch {package require Img} version]
if { $retVal } {
error "Trying to load package Img: $version"
}

if { $tcl_platform(platform) == "windows" } {
catch { console show }
}

wm geometry . "+320+0"
drawTestCanvas $version
set ph [canvas2Photo .t.c]
puts "Writing canvas as JPG image: test.jpg"
$ph write test.jpg -format JPEG
puts "Writing canvas as GIF image: test.gif"
$ph write test.gif -format GIF
puts "Writing canvas as PNG image: test.png"
$ph write test.png -format PNG

button .b -text "Quit" -command exit
pack .b
update

[Jeffrey Hobbs]

Logged In: YES
user_id=72656

This has nothing to do with image write, it has to do with
the inability to grab the window contents without strict
restrictions of viewability on OS X.