Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Tk photo pixel colors

by zentara (Archbishop)
on Sep 25, 2006 at 15:09 UTC ( #574745=snippet: print w/ replies, xml ) Need Help??

Description: I saw this type of app in the Gtk2 examples, and thought it would be nice to have a Tk version. It loads a bmp, gif, jpg, or png and gives the pixel position, decimal rgb color, hex rgb color, and a color swatch.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use Tk::PNG;

my $file = shift || die "need a bmp, gif,jpg or png as arg 1\n";

my $mw  = Tk::MainWindow->new;

my $topframe = $mw->Frame(-bg => 'black')->pack(-fill=>'x');
my $tf1 = $topframe->Frame(-bg => 'black')->pack(-side=>'left',-fill=>
+'x');

my $xy = $tf1->Label(-text => '  X - Y  ',
                       -fg => 'hotpink',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);

my $rgb = $tf1->Label(-text => 'R - G - B',
                       -fg => 'hotpink',
               -bg => 'black',
                  )->pack(-side => 'top', -padx=>2);

my $hex = $tf1->Label(-text => '   HEX   ',
                       -fg => 'hotpink',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);

my $tf2 = $topframe->Frame(-bg => 'black')->pack(-side=>'left',-fill=>
+'x');

my $xycurrent;
my $xyr = $tf2->Label(-textvariable => \$xycurrent,
                       -fg => 'lightgreen',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);
my $rgbcurrent;
my $rgbr = $tf2->Label(-textvariable => \$rgbcurrent,
                       -fg => 'lightgreen',
               -bg => 'black',
                  )->pack(-side => 'top', -padx=>2);

my $hexcurrent;
my $hexr = $tf2->Label(-textvariable => \$hexcurrent,
                       -fg => 'lightgreen',
               -bg => 'black',
                  )->pack(-side => 'top',-padx=>2);

my $swatch = $topframe->Label(
                     -text => '       ',
                     -bg=>'black',
                    )->pack(-side=>'left',-fill=>'y',-pady => 5); 

my $tf3 = $mw->Frame(-bg => 'hotpink')->pack(-fill=>'x');
my $divider = $tf3->Label(
                     -text => '       ',
                     -bg=>'hotpink',
                    )->pack(-side=>'left',-fill=>'y',-pady => 1); 


my $can = $mw->Scrolled('Canvas',
                 -height => 400,
         -width  => 400,
         -scrollbars => 'osoe',
                 -highlightthickness=>0,
         -borderwidth =>0,
                 )->pack( -fill =>'both',-expand=>1);

my $realcan = $can->Subwidget('scrolled');

my $img = $mw->Photo( -file => "$file", 
              -palette => '256/256/256' );

$can->createImage(0,0,  #hardcoded offset
                  -image => $img, 
          -anchor => 'nw',
          -tags => ['img'],
           );

my @bbox = $can->bbox( 'img'  );

$can->configure(-scrollregion => [@bbox] );

$realcan->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]);

$realcan->Tk::bind("<Leave>", sub{
            $xycurrent  = '';
            $rgbcurrent = '';
        $hexcurrent = '';
       });


MainLoop();
###########################################################
# a cheap hack to prevent the Tk Photo object from issuing
# an out of bounds error if the window is expanded bigger 
# than the photo
sub Tk::Error { }
#####################################################
sub print_xy {
  my ($canv, $x, $y) = @_;
  $xycurrent = $canv->canvasx($x).' - '.$canv->canvasy($y);    
 
   my($r,$g,$b) = $img->get($canv->canvasx($x), $canv->canvasy($y) );

   $rgbcurrent = sprintf('%.3d', $r).'-'.sprintf('%.3d', $g).'-'.sprin
+tf('%.3d', $b); 

  #convert to hex from decimal
   $r = sprintf('%.2x', $r);
   $g = sprintf('%.2x', $g);
   $b = sprintf('%.2x', $b);
   $hexcurrent = $r.'-'.$g.'-'.$b; 

$swatch->configure(-bg=>"#$r$g$b");

}

Comment on Tk photo pixel colors
Download Code
Re: Tk photo pixel colors
by chanio (Priest) on Nov 12, 2006 at 18:38 UTC
        Right! Very illuminating.

        Some friends used to paint complementary colors as borders of some images to make them shine!

        On the other hand, when doing this effect inside a color symphony (or color salad) the results are difficult to predict...

        Perhaps, doing a 'weird' color average of an image it could be possible to know the resulting ghost-layer's color? It is not a color competition, but a color symphony. There is taste involved. Or human perception ( or limitation of perception ). Just adding and substracting colors through all the image, I guess (not sure)...

Re: Tk photo pixel colors
by parv (Priest) on Nov 13, 2006 at 03:35 UTC
    What chanio said; ++zentara.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://574745]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (7)
As of 2014-08-30 13:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (293 votes), past polls