Tk::Photo and GIFs - is a pixel transparent or black?

crazyinsomniac has asked for the wisdom of the Perl Monks concerning the following question:

I was writing something like Kill Your Favorite Monk! using perl Tk, and in an effort to offer more accurate "shot" assement, I figured, if the target image is a transparent gif image, and I wish the actual target to be the non-transparent part of that image, I'd have to figure out if the part of the image the user clicked on was transparent.

According to somewhere in the perl Tk docs, blank or transparent areas of Photos will register as having an RGB value of 0,0,0 and that is indeed what happens. The problem is that RGB 0,0,0 also represents the color black.

What I want to know is, how do I distinguish from a transparent pixel, and a black one?

Is there a Tk way, or will I have to resort to using GD or Image something (which I fear I might if i want this).

It's true, well at least for the default target, that I could remove all black from the image, but that is too constricting.

Here is some code (in readmore tags) demonstrating the "black" v. "transparent" pixel issue (with apologies to OeufMayo):

#!/usr/bin/perl -wl
use strict;
                    #|\    /|
use Tk 8;           #| \  / |
use vars qw/ %OQ /; # \_oO_/
                    # |  > |
                    #  `--'


$OQ{MW} = new Tk::MainWindow(-background=>'black',
                             -width=>300,
                             -height=>300,
                           ,);#:D->pack();
$OQ{MW}->title("OeufMayo draw ++ ~ image altered and used without perm
+ission");
$OQ{MW}->resizable(0,0);

use vars qw/ $DEFTARGET/; # why this not in %OQ, I don't know

$DEFTARGET = q{
R0lGODlhhQDEAPcAAAAAAAAAQAAAgAAA/wAgAAAgQAAggAAg/wBAAABAQABAgABA/wBgAA
+BgQABg
gABg/wCAAACAQACAgACA/wCgAACgQACggACg/wDAAADAQADAgADA/wD/AAD/QAD/gAD//y
+AAACAA
QCAAgCAA/yAgACAgQCAggCAg/yBAACBAQCBAgCBA/yBgACBgQCBggCBg/yCAACCAQCCAgC
+CA/yCg
ACCgQCCggCCg/yDAACDAQCDAgCDA/yD/ACD/QCD/gCD//0AAAEAAQEAAgEAA/0AgAEAgQE
+AggEAg
/0BAAEBAQEBAgEBA/0BgAEBgQEBggEBg/0CAAECAQECAgECA/0CgAECgQECggECg/0DAAE
+DAQEDA
gEDA/0D/AED/QED/gED//2AAAGAAQGAAgGAA/2AgAGAgQGAggGAg/2BAAGBAQGBAgGBA/2
+BgAGBg
QGBggGBg/2CAAGCAQGCAgGCA/2CgAGCgQGCggGCg/2DAAGDAQGDAgGDA/2D/AGD/QGD/gG
+D//4AA
AIAAQIAAgIAA/4AgAIAgQIAggIAg/4BAAIBAQIBAgIBA/4BgAIBgQIBggIBg/4CAAICAQI
+CAgICA
/4CgAICgQICggICg/4DAAIDAQIDAgIDA/4D/AID/QID/gID//6AAAKAAQKAAgKAA/6AgAK
+AgQKAg
gKAg/6BAAKBAQKBAgKBA/6BgAKBgQKBggKBg/6CAAKCAQKCAgKCA/6CgAKCgQKCggKCg/6
+DAAKDA
QKDAgKDA/6D/AKD/QKD/gKD//8AAAMAAQMAAgMAA/8AgAMAgQMAggMAg/8BAAMBAQMBAgM
+BA/8Bg
AMBgQMBggMBg/8CAAMCAQMCAgMCA/8CgAMCgQMCggMCg/8DAAMDAQMDAgMDA/8D/AMD/QM
+D/gMD/
//8AAP8AQP8AgP8A//8gAP8gQP8ggP8g//9AAP9AQP9AgP9A//9gAP9gQP9ggP9g//+AAP
++AQP+A
gP+A//+gAP+gQP+ggP+g///AAP/AQP/AgP/A////AP//QP//gP///yH5BAEAAOAALAAAAA
+CFAMQA
AAj/AMEJHEiwoMGDCBMqXMiwocOHECNKnEixosWLGDNq3Mixo8ePIEOKHEmypMmTKFOqXM
+mypcuX
HpPIhEkzpkyZJHKSaFOzJ8WcSeQIHZqEBACePpMyvNlmqFOhOZEqnUqwjdWnWIUWlUS169
+WsYHN2
nRoUrNk2AJKM9SnTrFuja3uWdWs2bVyYc+mCBQDgrsu2es0mses3ZRvAgcGi7Vv45M3Ebg
+czbkwS
ceI2JLJKpjzyMWQ5fPliXcw5pOXERkOP5lv64+nAi0Nndpq6dUeZTT+D5rtTNG3WtjUy1Z
+0agFDf
Q0MHF/4VcuyyyI8DX24xSW7doY3XnU594uvEst0q/+9O0bpurarFAyBB3rv589mvY5XdPu
+L3wMWj
O40ttX7DvNhll9Zq4/n3n3wBCjibHLFxZ6BC98EmW1EC8lbggxAi+JlkAEiC22Hv7TYZhg
+hFiB9f
XGGm4W5qkViiiXrx1SI4ki0ooosJWbciZHz1R+NgOYU2I44FhXgegw4KdJNMhBFZkIc7Jj
+YYVwlZ
5WSJUYLH3pUSwagXWltyCZGRRxo1pJhLSXLkU0mimeGaTrXpJpZwCoXWmXO+WCdUHea5VJ
+bgjegn
nXvKOaiSAB5J2qGE1jkYnowqCeiJPkb6457SWWqQl18aOuhhk3YqqKVFhUpXbZoimuiRF0
+YKJabo
Qb46KKdSrpcqjaYGBmSqtNY66qy5Svhrnr1CBlekuMH61LGMkqnso806C+tmsxb72aJ+eq
+bsfp46
mey2y3brorbgDoXqnD2W+xS1bt6p7lPYolnqu+HOSS69crDL5aP47sfsvkf1+5ubRQnMLZ
+X7roqv
uPV9a3CmCT/827AGviqxuRT75/DF/46rsMDxYjhYsOBSiGPBF2N1roEbp6xVxw1/rJfMzg
+X54L08
aocphRm31vJlAz47GMvS6kUCzeeF/0ydtXbupK4kPVOmY5lIK8qwXz/jR7KxURfGNIM2lq
+u0z1Wr
HDa4HnZ9V9F0BU2vvmRbXfaah6nt1by68dsvWsExyRvbWOGNL9Rkcyib0zOf/e7VbN3Em1
+U8Iy6Y
znvbXdOHK2LG21uU98s4TTpmqfnH+uHLt9eHwaaexGNTNXXS15WO79BYz82mzrLT27pSlh
+UF42K5
5X6tqbSvPdffR5uVWvCdo1ah25Nb/ldZhq+n8PLS5Vr9euEZ/XlLqecbpE7Jqyxj9idml4
+Qk2/yz
zeaJS88SZkHpaJ0tkqQGoJDSfay5+v8IoAD/gT26oKVSU/EQkyRhlfYFkD/JOZ8cUv+jGQ
+ulxRYD
zGBxOoVApeQvJ1DLSQa3wSHrdK+A6PmbJDLIQgKmp20dTIotjMIe7rWQhM+zE/LWszwHtl
+CDLxSP
rKZyFHDY8Ie2qF4EFUQCH/5wgNsoDqDuxBkePjGA24jNErOzwiuyMH+S6VSYCpMWEmDQix
+SUjoC8
2MKcQAZalEliWthIP6IIKAlsHOF6cjbErngoJ05kIQlDVLfQdDGPD4Re25rkF6tgZidXTC
+Ih/QaA
MyIyiorbTgzJAhSgXFGB8mkD1FCEyADqTUtSs16QnhhFRTZlMXjMY/72+BlbNQZEIAJAIA
+U4SgA1
ZZYkYGMrhacYRhovdJW8IZCy0hT/IO1SgLZ4ZPk2VMRGmsmR+WtDC2epsEJaMoOjXM/WJj
+jGuGDP
KnIMZNqa5xQKxTKDHJIcccq5lscxaH1AGqAc5akyd+pTfXX6nkt0ch1RLqaLs1Sk2fRnCx
+zaM6AC
XUlR+CmJXhZSoVkJ0vNsV8yIqqSO8GIgzyRoNI3KZpzzsWVcBDcUUa6TpPgpzjQx5VGVfD
+BzI2Xn
lzIJUazNFF5g42jl5LeS0bmMpjVFCQqPajWV3o2fTIWPU6cCIqFGNVybpAlQruqopJZkmV
+yFE9yU
stWwrmmsPqGhWcXqVZEACaVrPQw9a7IYnq41cXOlSRDvmrejkSVdfD1SqTwIv8Ce/2ewPk
+moYc86
k54odrFr8mtNEmpVyJJTLjC17GfEApN1wtWyjXWJZwPLQKgS5yWFtKvL7vePJFqiTpxdSU
+JNe1QG
fjOaXVVIg9pKkBpVVmxt2GVzklZNgjyPN3n1TmajKsofeugSdHNqhdZV3Is88rPPOiQUo/
+lTX1Uo
NYo7jHCIKbEObZeBjiyrd0+Kmj4+RDLYxVQTBZjFm1TUFjOcW3wim9yH8I+rRwngB48miY
+a6zyjC
wijXMPLfq47skev7Zgi9R8tCEbUq4jQrDXfyzX+MMjCAxdTpLEJejsmIfdvYRjQVvC7V6g
+YzDO7Q
XXdrSPz8VjH9dYh6Z+xIU4WvZJjubcgjNWs6wIk3Izsm8p62l52ovDZfQdZxWuJL5Pwc92
+/NjLKU
b0xkJl8ZvBdOiE64vNjjLqQ4HkmtknMmILzgZLlrnlirXoKbh8a5ndnpit9oC9n/hTklhq
+Nyv9Dc
mPx0966GC04CCEAAwB2VQ+QhQGgEvaeVkScBAGA0nw2G1vpI2s4P09yVEoBpAqTA0SKG2Z
+UEROl2
xj92UOobLt2MkoBbNRnVYJFJE25lkOykQNaKkUkKas1rhGTn0zIyXE4IQOpi+/fKc3a2tK
+dN7Wpb
+9rYzrZBAgIAOw==};

    $OQ{MW}->bind( 'Tk::Canvas',
                   '<ButtonPress>' =>
                  [ sub { print sprintf " TARG:|@_| R:%s G:%s B:%s",
                         $DEFTARGET->get(@_[2,3]);
                       },
                    Ev('b'),
                    Ev('x'),
                    Ev('y'),
                  ,]
                ,);

$OQ{C} = $OQ{MW}->Canvas(-width => 500,
                            -height =>460,
                            -background => 'pink',
                           ,)->pack();


$DEFTARGET = $OQ{C}->Photo(-data => $DEFTARGET);


$OQ{HEAD} = $OQ{C}->create('image',
                    $DEFTARGET->width()/2,  #x
                    $DEFTARGET->height()/2, #y
                    -image => $DEFTARGET,
                   ,); # debugging purposes


&MainLoop();
[download]

___crazyinsomniac_______________________________________
Disclaimer: Don't blame. It came from inside the void
perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

Comment on Tk::Photo and GIFs - is a pixel transparent or black? Download Code


No such thing as a small change
	PerlMonks