Hello,

I've been dubbed with a task of emulating the output of a Charge-Coupled Device (CCD) camera. The idea is that the CCD chip at hand (Texas Instruments TC255 for those who are interested) outputs 8bit grayscale values for each pixels, one row at a time. This chip has a resolution of 324x243 pixels.

My first task was to actually generate a "random" image and display it for approval. This image could then be saved for the next step in our process. But here's my dillema. Since my data is just a large array of pixel values, I am displaying the data by drawing a rectangle on the canvas to represent each pixel, and for those who are counting, that is 78,732 pixels. My 700MHz Pentium comes to a screaching halt when the program rendering (or for that matter, refreshing) takes place. So, I am wondering if there is a better/faster way of displaying thousands of pixels. Here's my code

use strict;
use Tk;

my (
    $mw,
    $canvas,
    $color,
    $radius,
    $colorLabel,
    $radiusLabel,
    @data,
);

my $TCWidth = 324;
my $TCHeight = 243;
my $size = 1;

$mw = MainWindow->new(-title=>"TC255 Emulator",
              -width=>$TCWidth*$size+100,
              -height=>$TCHeight*$size);
newCanvas();
@data = getData();
drawData(\@data);
$mw->Label(-borderwidth=>'1',
       -text=>"Radius:",
       -width=>'7',
       -font=>"Arial 8 bold")->place(-x=>$TCWidth*$size+10,
                     -y=>'17');
$radiusLabel = $mw->Label(-borderwidth=>'1',
              -text=>$radius,
              -width=>'4',
              -anchor=>"w",
              -font=>"Arial 8")->place(-x=>$TCWidth*$size+55,
                           -y=>'17');
$mw->Label(-borderwidth=>'1',
       -text=>"Color:",
       -width=>'7',
       -anchor=>"e",
       -font=>"Arial 8 bold")->place(-x=>$TCWidth*$size+10,
                     -y=>'37');
$colorLabel = $mw->Label(-borderwidth=>'1',
             -text=>$color,
             -anchor=>"w",
             -width=>'4',
             -font=>"Arial 8")->place(-x=>$TCWidth*$size+55,
                          -y=>'37');
$mw->Button(-text=>"New",
        -width=>5,
        -font=>"Times 8 bold",
        -command=>sub{$canvas->destroy();
              newCanvas();
              @data = getData();
              drawData(\@data);
              $radiusLabel->configure(-text=>$radius);
              $colorLabel->configure(-text=>$color);
             })->place(-x=>$TCWidth*$size+28,-y=>67);
$mw->Button(-text=>"Save",
        -width=>6,
        -font=>"Times 8 bold",
        -command=>sub{saveData(\@data);
             })->place(-x=>$TCWidth*$size+25,-y=>100);
$mw->Button(-text=>"Open",
        -width=>6,
        -font=>"Times 8 bold",
        -command=>sub{$canvas->destroy();
              newCanvas();
              @data = openData();
              drawData(\@data);
             })->place(-x=>$TCWidth*$size+25,-y=>133);
$mw->Button(-text=>"Exit",
        -width=>6,
        -font=>"Times 8 bold",
        -command=>sub{exit;})->place(-x=>$TCWidth*$size+25,-y=>$TCHeig
+ht-50);

MainLoop;

sub saveData{
  my @d = @{$_[0]};
  my $file = $mw->getSaveFile(-defaultextension => ".img",
                  -filetypes        =>
                  [['TC255 Image',     '.img'            ],
                   ['All Files',        '*',             ],
                  ],
                  -initialdir       => ".",
                  -initialfile      => "default.img",
                  -title            => "Save Image",
                 );
  if (!defined($file)){return;}
  open(DAT,">$file") || die "Can't open file: $!\n";
  for (my $y=0; $y<$TCHeight; $y++){
    for (my $x=0; $x<$TCWidth; $x++){
      print DAT "$d[$y][$x],";
    }
    print DAT "\n";
  }
  close(DAT);
}

sub openData{
  my @d;
  my $file = $mw->getOpenFile(-defaultextension => ".img",
                  -filetypes        =>
                  [['TC255 Image',     '.img'            ],
                   ['All Files',        '*',             ],
                  ],
                  -initialdir       => ".",
                  -initialfile      => "default.img",
                  -title            => "Open Image",
                 );
  if (!defined($file)){return;}
  open(DAT,"<$file") || die "Can't open file: $!\n";
  my $y = 0;
  while ($_ = <DAT>){
    chomp;
    my @q = split(/,/,$_);
    for (my $x=0; $x<$TCWidth; $x++){
      $d[$y][$x] = $q[$x];
    }
    $y++;
  }
  close(DAT);
  return @d;
}

sub newCanvas{
  $canvas = $mw->Canvas(-width=>$TCWidth*$size,
            -height=>$TCHeight*$size,
            -relief=>"sunken",
            -borderwidth=>1)->place(-x=>0,-y=>0);
}

sub drawData{
  my @d = @{$_[0]};
  for (my $y=0; $y<$TCHeight; $y++){
    for (my $x=0; $x<$TCWidth; $x++){
      my $c = sprintf("#%02x%02x%02x",$d[$y][$x],$d[$y][$x],$d[$y][$x]
+);
      $canvas->createRectangle($x*$size,$y*$size,($x+1)*$size,($y+1)*$
+size,-fill=>$c,-outline=>$c);
    }
  }
}

sub getData{
  my @d;

  #intensity is a 8 bit value corresponding to grayscale colors
  # 0 = black
  # 255 = white

  $color = int rand(255);
  $radius = int rand(200);

  for (my $y=0; $y<$TCHeight; $y++){
    for (my $x=0; $x<$TCWidth; $x++){
      if((($x-$TCWidth/2)**2 + ($y-$TCHeight/2)**2) < ($radius**2)){ #
+a circle
    $d[$y][$x] = $color;
      } else {
    $d[$y][$x] = 255; #white background
      }
    }
  }
  return @d;
}

[download]

Thank you.

In reply to Many Rectangles in Tk by gri6507

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.