Category: Tk

Webcam Streaming in Perl/Tk (Linux)

Late last week I started thinking about how to access a webcam device from within Perl. I have no direct need of such capability at the time being but I wanted to know how to do it in case I wanted to do something in the future involving webcams.

A few years ago when I used mostly Windows I found EZTwain, a DLL library for accessing a webcam in Windows using the TWAIN protocol (which as I understand is obsolete by now). The DLL was a pain in the butt to use and I couldn't get it to work how I wanted it to (it insisted on displaying its own GUI windows instead of allowing my Perl script to directly pull a frame from it without a GUI).

Besides that there's pretty much no libraries Perl has been built to use yet that can access a webcam. So, I started looking into using third-party programs such as ffmpeg and mplayer/mencoder to provide the hardware layer for me so that Perl can get just the jpeg images out and do with them what it needs.

Of these programs I wanted to use ffmpeg the most, because I know for sure there's an ffmpeg.exe for Windows, which might mean that whatever code I come up with might be reasonably portable to Windows as well.

After some searching I found some command-line sorcery for using ffmpeg over SSH to activate the camera on a remote computer and stream the video from it over SSH to the local system, and display it in mplayer:

ssh user@remoteip ffmpeg -b 100K -an -f video4linux2 -s 320x240 -r 10 -i /dev/video0 -b 100K -f ogg - | mplayer - -idle -demuxer ogg

Using the basic ffmpeg command in there, along with some hours of research and poking around, I eventually came up with a command that would activate the webcam and output a ton of jpeg images with consecutive file names, of each frame of video that the camera recorded:

ffmpeg -b 100K -an -f video4linux2 -s 640x480 -r 10 -i /dev/video0 -b 100K -f image2 -vcodec mjpeg test%d.jpg

The mjpeg codec (or "motion jpeg"), in ffmpeg, really means it's a bunch of jpeg images all combined together one after the other (the start of each jpeg image can be seen in hex by looking for the magic number, 0xFFD8). The "image2" format here means that each frame from the mjpeg stream gets written to an individual image file, in the format "test%d.jpg" where %d is a number that goes up for each image written.

By changing the image2 to image2pipe instead, the output (all the jpeg images in the mjpeg stream) is sent through the program's standard output, so it can be piped into another program, or read from in Perl.

So in Perl I opened a pipe that executes this command and have the script read from it, reading all the jpeg images and then displaying them in a Perl/Tk window as they come in. In effect: a live webcam stream, where Perl is entirely in control of the jpegs as they come in from ffmpeg and can do with them whatever it wants!

I added a button to my GUI for taking a snapshot and saving it to disk (in actuality, as each complete image is read and displayed, it's kept around in memory until the next image is read and displayed... so this button just saves the last full image to disk).

Here's my proof of concept Perl code:

#!/usr/bin/perl -w

# Perl/Tk Webcam Streamer and Snapshot Taker
# Proof of Concept
# Author: Noah Petherbridge, http://www.kirsle.net/

use Tk;
use Tk::JPEG;
use MIME::Base64 "encode_base64";

# Some things that might need to be configured.
my $device = shift(@ARGV) || "/dev/video0";
if ($device =~ /^\// && !-e $device) {
    die "Can't see video device: $device";
}

# Tk MainWindow
my $mw = MainWindow->new (
    -title => 'Tk Stream',
);
$mw->protocol (WM_DELETE_WINDOW => \&onExit);

# A label to display the photos.
my $photo = $mw->Label ()->pack();

# A button to capture a photo
my $capture = $mw->Button (
    -text => "Take Picture",
    -command => \&snapshot,
)->pack();

$mw->update();

my $cmd = "ffmpeg -b 100K -an -f video4linux2 -s 320x240 -r 10 -i $device -b 100K -f image2pipe -vcodec mjpeg - "
    . "| perl -pi -e 's/\\xFF\\xD8/KIRSLESEP\\xFF\\xD8/ig'";
open (PIPE, "$cmd |");

my ($image,$lastimage);

my $i = 0;
my $jpgBuffer = ""; # last complete jpg image
my $buffer = ""; # bytes read
my $lastFrame = ""; # last complete jpg (kept until another full frame was read; for capturing to disk)
while (read(PIPE, $buffer, 2048)) {
    my (@images) = split(/KIRSLESEP/, $buffer);
    shift(@images) if length $images[0] == 0;
    if (scalar(@images) == 1) {
        # Still the old image.
        my $len = length $images[0];
        $jpgBuffer .= $images[0];
    }
    elsif (scalar(@images) == 2) {
        # We've completed the old image.
        $jpgBuffer .= shift(@images);
        my $len = length $images[0];
        next if length $jpgBuffer == 0;

        # Put this into the last frame received, in case the user
        # wants to save this snapshot to disk.
        $lastFrame = $jpgBuffer;

        # Create a new Photo object to hold the jpeg
        eval {
            $image = $mw->Photo (
                -data => encode_base64($jpgBuffer),
                -format => 'JPEG',
            );
        };
        # Update the label to display the snapshot
        eval {
            $photo->configure (-image => $image);
        };
        # Delete the last image to free up memory leaks,
        # then copy the new image to it.
        $lastimage->delete if ($lastimage);
        $lastimage = $image;

        # Refresh the GUI
        $mw->update();

        # Start reading the next image.
        $jpgBuffer = shift(@images);
    }
    else {
        print "Weird error: 3 items in array!\n";
        exit(1);
    }
}

sub snapshot {
    # Make up a capture filename.
    my $i = 0;
    my $fname = "capture" . (sprintf("%04d",$i)) . ".jpg";
    while (-f $fname) {
        $fname = "capture" . (sprintf("%04d",++$i)) . ".jpg";
    }

    # Save it.
    open (WRITE, ">$fname");
    binmode WRITE;
    print WRITE $lastFrame;
    close (WRITE);
    print "Frame capture saved as $fname\n";
}

sub onExit {
    # Close ffmpeg.
    print "Exiting!\n";
    close (PIPE);
}

You can download it here. It should run on any Linux distribution and it depends on having Perl/Tk and ffmpeg installed, and the video4linux2 system (any modern distro will have that).

In the ffmpeg command here you'll see I also piped the output into a quick Perl script that substitutes all the jpeg headers so that they begin with "KIRSLESEP" -- this was to make it easier to split the jpegs up while reading from the stream.

Since this uses ffmpeg and there's an ffmpeg.exe for Windows, this might work on Windows (you'll definitely need to modify the arguments sent to the ffmpeg command, though). I don't currently have access to a Windows machine with a webcam, though, so I can't work on that just yet.

Anyway, here it is: webcam access in Perl!

Tk::StyleDialog

Since there was enough interest in my two-year-old program, ErrorGen, I've created a Perl/Tk module that does basically what ErrorGen does.

Here's a screenshot:

It's only a module so far that can be included in other Perl/Tk applications. But it's one very large step closer to me creating a simplified tool to spawn error boxes which could be provoked from batch files or scripts. It will probably have a syntax similar to the GNOME program, Zenity.

CPAN takes a few hours to index module updates but the new module will be available at Tk::StyleDialog on CPAN.org.

UPDATE: I've thrown together a quick program called ZenMsg (a name derived from GNOME's Zenity, but since my program only does dialog boxes, it's called ZenMsg).

I've added it as a new tab to the ErrorGen page. Let me know if it can be improved. I had to use ActiveState PerlApp to compile it because PAR::Packer (which I usually prefer to use) was giving me trouble and I didn't have the time or motivation to setup a clean new compiling environment for it. PerlApp may be a bit too limiting.

Tk::HyperText Uploaded

Finally, I've shipped Tk::HyperText version 0.06 on its way to CPAN's network. It won't be up immediately but in the next few hours the following link will go to the page for version 0.06:

Tk::HyperText.

Here's a screenshot of the demo program that comes with it:

Tk::HyperText Rewrite

Today I've begun reprogramming my Tk::HyperText widget. The old module didn't use any "real" HTML parsers, so it was reading the HTML code in as plain text and trying to figure out how to display it that way. The new module is going to use HTML::TokeParser, which will make the code cleaner and also more efficient and less buggy.

I've only been working on it for a couple of hours so far, and all it supports so far is the font tag, bold, italic, underline, and line breaks. Here's a screenshot:

The functionality of the module when it's done is going to be drastically different to what's currently on CPAN. I don't know if anyone has actually used Tk::HyperText in their programs yet, but the new module will definitely break programs that were relying on the methods provided by the old module. I'm thinking I'll have the module use similar methods and handlers to Wx::ActiveX::Mozilla.

Update (4:54 PM EDT) - The module now supports pretty much all the markup tags (not links, lists, or obscure tags like abbr and acronym though). Something else of interest is that only the first body tag found will recolorize the widget as a whole; any additional body tags will only override the colors of the current text style, so you can get the "AIM effect" with it (where each message can have its own background color which covers its entire horizontal space).

I'll probably have the new module on CPAN within a few days.

Update (5/9) - It supports tables now!