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

Hi, yesterday a question intrigued me about accessing a video camera directly and saving pictures. Well I went and downloaded Video-Capture-V4l-0.222 from http://cpan.org and started playing with it. As a comparison, I also played with a simple c program called videodog which does a nice job of saving in raw,pnm,or jpg formats.

Now for the perl question. The code below seems to capture raw frames, can anyone point me in the right direction on how to save them as pnm or jpg? The doc in the VideoCapture module are not too clear to me. 

#!/usr/bin/perl

use Video::Capture::V4l;

sub print_picture {
   my $c=shift;
   print "Picture Settings: ";
   print "brightness ",$c->brightness;
   print ", hue ",$c->hue;
   print ", colour ",$c->colour;
   print ", contrast ",$c->contrast;
   print ", whiteness ",$c->whiteness;
   print ", depth ",$c->depth;
   print ", palette ",$c->palette;
   print "\n";
}

$grab = new Video::Capture::V4l
   or die "Unable to open Videodevice: $!";

print_picture $grab->picture;

$|=1;

my $frame=0;
my $fr=$grab->capture ($frame, 640, 480);

my $count=0;
for(1..2) {
   my $nfr = $grab->capture (1-$frame, 640, 480);
   $grab->sync($frame) or die "unable to sync";

   # save $fr now, as it contains the raw BGR data 
   open (JP,">z$count.raw") or die $!;
   print JP $nfr;
   close JP;
   print ".";
   $count++;
   $frame = 1-$frame;
   $fr = $nfr;
}

[download]

Replies are listed 'Best First'.
Re: capturing raw video with v4l
by Mr. Muskrat (Canon) on Jul 03, 2003 at 16:13 UTC

    Here's a way to use Image::Magick to create PNGs from the raw RGB data.

    Untested code:

    #!/usr/bin/perl

die "Usage: $0 image1 .. imageN\nDo not include the .raw extension.\n"
+ unless (@ARGV);

use Image::Magick;

my $depth = 8; # or 16 or 24 or ...
my $size = '640x480';

foreach my $file (@ARGV) {
  my $image = Image::Magick->new;
  my $x;
  $x = $image->Read(
    filename => "rgb:$file.raw",
    size => '640x480',
    depth => $depth
  );
  warn "$x" if "$x"; # from the examples but looks funny to me ;-)
  $x = $image->Write("$file.png"); # or jpg or whatever
  warn "$x" if "$x";
}

    [download]

    Alternately, you could include this in your video capture script. That would enable you to save a step by converting the raw data stored in the $nfr scalar to PNG.

[reply]
[d/l]
      Well thanks, you got me on the right track. As usual, I make advances by making "educated guesses". :-) I noticed that the output of videodog's raw frame, and a pnm frame was the same except for a header. So I added a header to each frame and renamed it pnm. Now another problem arises....the raw data is actually BGR not RGB ( I thought it was a typo, but it's not). So now I need to figure out how to quickly process the frame to change it from BGR to RGB.

      New code which outputs blue-tinted pnm's. 

      #!/usr/bin/perl

use Video::Capture::V4l;

$grab = new Video::Capture::V4l
   or die "Unable to open Videodevice: $!";

$|=1;
my $frame=0;
my $fr=$grab->capture ($frame, 320, 240);

my $count=0;
for(1..5) {
   my $nfr = $grab->capture (1-$frame, 320, 240);
   $grab->sync($frame) or die "unable to sync";

   # save $fr now, as it contains the raw BGR data 
   open (JP,">z$count.pnm") or die $!;
   print JP "P6\n320 240\n255\n";  #header 
   print JP $nfr;
   close JP;
   print ".";
   $count++;
   $frame = 1-$frame;
   $fr = $nfr;
}

      [download]
[reply]
[d/l]
        Don't know how quick it is, but here's my stab at converting from BGR to RGB. 
        sub convert_to_rgb {
  my $bgr = shift;
  my $bgrLen = length($bgr);
    
  #Unpacking the BGR data gives use easy access to individual bytes.
  my @bgrArray = unpack("C$bgrLen",$bgr);
  my @rgbArray;
    
  my $ct=0;
  while ($ct < $bgrLen) {
    $rgbArray[$ct] = $bgrArray[$ct+2];
    $rgbArray[$ct+1] = $bgrArray[$ct+1];
    $rgbArray[$ct+2] = $bgrArray[$ct];
    $ct+=3;
  }

  #Pack the data to match the input format.
  my $rgb = pack("C$bgrLen",@rgbArray);
   
  return $rgb;
}

        [download]
        Pass the code $nfr and the returned value can be written to file in place of $nfr.
[reply]
[d/l]

Back to Seekers of Perl Wisdom