Webcam 0.2

[Arjen]

Category:

GUI Programming

Description:

I created this program when I still lived back in the netherlands. I had a Webcam-II hooked up to my Linux machine and at that time there were not many good programs for webcams, so I created my own.

This program uses Stamp and vidcat as utilities to capture and textstamp the picture.

My original page for links to the above programs.

Cheers

#!/usr/bin/perl -w
use Tk;
use Tk::JPEG;
use Tk::NoteBook;
use Tk::FileSelect;
use Tk::DialogBox;
use File::Copy;
use Net::FTP;

$version = "0.2";
%options = ();

# general data
$first_in_seq = 1;

# No configurable data
$sequence = 0;
$no_config = 0;

    &read_rc;
    &make_stamprc;
    
# The Main screen!
    $main = MainWindow->new();
    $main->title("Webcam II upload util");
    $main->minsize(qw(250 250));

    $menu = $main->Frame(-relief=>'groove',
                -borderwidth=>1)->pack(-side=>'top',-fill=>'x');
    $file_menu = $menu->Menubutton(-text=>'File',-tearoff=>0)->pack(-s
+ide=>'left');
        $file_menu->command(-label=>'Configure',-command=>sub{ &config
+ure });
        $file_menu->separator;
        $file_menu->command(-label=>'Exit',-command=>sub{ &write_rc; e
+xit;  });
    $help_menu = $menu->Menubutton(-text=>'Help',-tearoff=>0)->pack(-s
+ide=>'right');
        $help_menu->command(-label=>'About',-command=>sub{ &about });

# lets build a frame for the Picture....
    
    $picture = $main->Frame->pack(-side=>'top',
                      -fill=>'x',
                    padx=>3,
                    pady=>3);
    $snapshot = $picture->Button(-text=>'No Picture Yet',-command=>sub
+{ 
                     if ($sequence == 0){ &take_shot } 
        })->pack(-side=>'top',-fill=>'x');
    if ( ($options{'pic_name'}) && (-r $options{'pic_name'}) ) {
        $snap = $picture->Photo(-format=>'JPEG',-file => $options{'pic
+_name'});
        $snapshot->configure( -image => $snap );
    }

# The buttonbar
    $single_frm = $main->Frame->pack(-side=>'top',-fill=>'x',padx=>3,p
+ady=>3);
    $single_frm->Label(-text=>'Single shot: ')->pack(-side=>'left');
    $save_opts = $single_frm->Menubutton(-text=>'Save',-relief=>'raise
+d',-tearoff=>0)->pack(-side=>'right');
    $save_local = $save_opts->command(-label=>'Save local',-command=>s
+ub{ if ($sequence == 0){ &save_single } });
    $save_ftp = $save_opts->command(-label=>'Save on FTP',-command=>su
+b{ print "Do FTP save\n"; },-state=>'disabled');
    $take_shot = $single_frm->Button(-text=>'Take',-command=>sub{ if (
+$sequence == 0){ &take_shot } })->pack(-side=>'right');
    $change_text = $single_frm->Button(-text=>'Change text',-command=>
+sub{ &change_text })->pack(-side=>'right');

    $seq_frm = $main->Frame->pack(-side=>'top',-fill=>'x',padx=>3,pady
+=>3);
    $seq_frm->Label(-text=>'FTP sequence: ')->pack(-side=>'left');
    $stop_seq = $seq_frm->Button(-text=>'Stop',-command=>sub{ $start_s
+eq->configure(-state=>'normal'); 
                              $sequence = 0; $first_in_seq = 1; 
                            })->pack(-side=>'right');
    $start_seq = $seq_frm->Button(-text=>'Start',-command=>sub{ $start
+_seq->configure(-state=>'disabled'); 
                                    $sequence = 1; 
                                    &take_continuos;})->pack(-side=>'r
+ight');
    
    if ($no_config) { 
                $snapshot->configure(-state=>'disabled');
                $save_local->configure(-state=>'disabled');
                $save_ftp->configure(-state=>'disabled');
                $take_shot->configure(-state=>'disabled');
                $change_text->configure(-state=>'disabled');
                $stop_seq->configure(-state=>'disabled');
                $start_seq->configure(-state=>'disabled');
                &configure; 
            }
    MainLoop;

    &write_rc;

sub read_rc {
    if ( -r "$ENV{HOME}/.webcamII" ) {
        open(RCFILE, "$ENV{HOME}/.webcamII") or die "Can't open/create
+ rc file!\n$ENV{HOME}/.webcamII\n\t$!\n";
        while (<RCFILE>) {
            chomp;
            s/#.*//;
            s/^\s+//;
            s/\s+$//;
            next unless length;
            ($opt,$val) = split(/\s*=\s*/,$_,2);
            $options{$opt} = $val;
        }
        close(RCFILE);
        if (! $options{"pic_name"} ) { $options{"pic_name"} = "$ENV{HO
+ME}/webcamII.jpg"  };
        if (! $options{"ftp_server"} ) { if ($main) { $start_seq->conf
+igure(-state=>'disabled'); $no_config = 1} }
        if (! $options{"dev_name"} ) { warn "No device was configured!
+"; $no_config = 1; };
    } else {
        $no_config = 1;
    }
}

sub write_rc {
    open(RCFILE, ">$ENV{HOME}/.webcamII") or die "Can't open/create rc
+ file!\n$ENV{HOME}/.webcamII\n\t$!\n";
    foreach $key (keys %options) {
        print RCFILE "$key = $options{$key}\n";
    }
    close(RCFILE);
}

sub about {
    $about_win = $main->Toplevel(-title=>"About webcamII.pl");
    $about_win->Label(-text=>"webcamII.pl\n\nAuthor: Arjen Wiersma <ar
+jen\@wiersma.org>\nVersion:" .
                                 "$version\n\ncomments:\nThis program 
+was made to be a wrapper to some\n" . 
                                 "utilities i used to take and modify 
+pictures from my webcam.\n\n" . 
                                 "I would like to have comments and id
+eas as to improving the program.\n")->pack(-side=>'top');
    $about_win->Button(-text=>"Ok, I've seen enough",-command=>[$about
+_win=>'destroy'])->pack(-side=>'top');
}

sub change_text {
    $top = $options{'top_string'};
    $exect = $options{'exec_top'};
    $low = $options{'low_string'};
    $execl = $options{'exec_low'};
    $change_win = $main->Toplevel(-title=>"Change picture text");
    $top_text = $change_win->Frame->pack(-side=>'top',-fill=>'x');
    $top_text->Label(-text=>'Top text: ')->pack(-side=>'left');
    $top_text->Checkbutton(-text=>'execute',-variable=>\$exect)->pack(
+-side=>'right');
    $top_text->Entry(-width=>20,-textvariable=>\$top)->pack(-side=>'ri
+ght');
        $low_text = $change_win->Frame->pack(-side=>'top',-fill=>'x');
    $low_text->Label(-text=>'Low text: ')->pack(-side=>'left');
    $low_text->Checkbutton(-text=>'execute',-variable=>\$execl)->pack(
+-side=>'right');
    $low_text->Entry(-width=>20,-textvariable=>\$low)->pack(-side=>'ri
+ght');
    $buttons = $change_win->Frame(-relief=>'groove')->pack(-side=>'top
+',-fill=>'x');
    $buttons->Button(-text=>'Save',-command=>sub{   $options{'top_stri
+ng'} = $top;
                            $options{'exec_top'} = $exect;
                            $options{'low_string'} = $low;
                            $options{'exec_low'} = $execl;
                            &make_stamprc; 
                            })->pack(-side=>'left');
    $buttons->Button(-text=>'Close',-command=>[$change_win=>'destroy']
+)->pack(-side=>'right');
}

sub configure {
    $con_win = $main->Toplevel(-title=>"webcamII.pl configuration");
    
    $options = $con_win->NoteBook->pack(padx=>3,pady=>3);
# General configuration
    $webcamII_page = $options->add("webcamII",-label=>'webcamII');

    $dev_lbl = $webcamII_page->Label(-text=>'Device: ');
    $dev_ent = $webcamII_page->Entry(-width=>20,-textvariable=>\$optio
+ns{'dev_name'});
    Tk::grid($dev_lbl,-column=>'0',-row=>'0',-sticky=>'e');
    Tk::grid($dev_ent,-column=>'1',-row=>'0');

    $pic_lbl = $webcamII_page->Label(-text=>'Picture: ');
    $pic_ent = $webcamII_page->Entry(-width=>20,-textvariable=>\$optio
+ns{'pic_name'});
        Tk::grid($pic_lbl,-column=>'0',-row=>'1',-sticky=>'e');
    Tk::grid($pic_ent,-column=>'1',-row=>'1');

# FTP configuration
    $FTP_page = $options->add("FTP",-label=>'FTP');
    $FTP_serv_lbl = $FTP_page->Label(-text=>"Server: ");
    $FTP_serv_ent = $FTP_page->Entry(-width=>20,-textvariable=>\$optio
+ns{'ftp_server'});
    Tk::grid($FTP_serv_lbl,-column=>'0',-row=>'0',-sticky=>'e');
    Tk::grid($FTP_serv_ent,-column=>'1',-row=>'0');
        
    $FTP_user_lbl = $FTP_page->Label(-text=>"Username: ");
    $FTP_user_ent = $FTP_page->Entry(-width=>20,-textvariable=>\$optio
+ns{'ftp_user'});
    Tk::grid($FTP_user_lbl,-column=>'0',-row=>'1',-sticky=>'e');
    Tk::grid($FTP_user_ent,-column=>'1',-row=>'1');

    $FTP_pass_lbl = $FTP_page->Label(-text=>"Password: ");
    $FTP_pass_ent = $FTP_page->Entry(-width=>20,-textvariable=>\$optio
+ns{'ftp_pass'});
        Tk::grid($FTP_pass_lbl,-column=>'0',-row=>'2',-sticky=>'e');
    Tk::grid($FTP_pass_ent,-column=>'1',-row=>'2');

    $FTP_cwd_lbl = $FTP_page->Label(-text=>"Directory: ");
    $FTP_cwd_ent = $FTP_page->Entry(-width=>20,-textvariable=>\$option
+s{'ftp_cwd'});
    Tk::grid($FTP_cwd_lbl,-column=>'0',-row=>'3',-sticky=>'e');
    Tk::grid($FTP_cwd_ent,-column=>'1',-row=>'3');
                
    $FTP_delay_lbl = $FTP_page->Label(-text=>"Delay: ")->pack(-side=>'
+left');
    $FTP_delay_ent = $FTP_page->Entry(-width=>5,-textvariable=>\$optio
+ns{'delay_time'});
        Tk::grid($FTP_delay_lbl,-column=>'0',-row=>'4',-sticky=>'e');
    Tk::grid($FTP_delay_ent,-column=>'1',-row=>'4',-sticky=>'w');
# Stamp configuration
    $stamp_page = $options->add("Stamp",-label=>'Stamp');
    $top_lbl = $stamp_page->Label(-text=>"Top string: ");
    $top_ent = $stamp_page->Entry(-width=>20,-textvariable=>\$options{
+'top_string'});
    $top_exec = $stamp_page->Checkbutton(-text=>'execute',-variable=>\
+$options{'exec_top'});
        Tk::grid($top_lbl,-column=>'0',-row=>'0',-sticky=>'e');
    Tk::grid($top_ent,-column=>'1',-row=>'0',-sticky=>'w');
    Tk::grid($top_exec,-column=>'2',-row=>'0',-sticky=>'w');

        $low_lbl = $stamp_page->Label(-text=>"Low string: ");
    $low_ent = $stamp_page->Entry(-width=>20,-textvariable=>\$options{
+'low_string'});
    $low_exec = $stamp_page->Checkbutton(-text=>'execute',-variable=>\
+$options{'exec_low'});
    Tk::grid($low_lbl,-column=>'0',-row=>'1',-sticky=>'e');
    Tk::grid($low_ent,-column=>'1',-row=>'1',-sticky=>'w');
    Tk::grid($low_exec,-column=>'2',-row=>'1',-sticky=>'w');
    $con_win->Button(-text=>'Close',-command=>[$con_win=>'destroy'])->
+pack(-side=>'right');
}

sub take_shot {
    &make_stamprc;
    if (! -r "/tmp/webcamIIrc") { &make_stamprc }
# Take a shot from the camera
    system("vidcat -d $options{'dev_name'} -f jpeg > /tmp/webcamII.jpg
+") == 0 
        or die "vidcat failed: $1\n";
    system("stamp -r /tmp/webcamIIrc") == 0 or die "stamp failed: $!\n
+";
    $snap = $picture->Photo(-format=>'JPEG',-file => $options{'pic_nam
+e'});
    $snapshot->configure(-image=>$snap);
}

sub take_continuos {
    &make_stamprc;
    if (! -r "/tmp/webcamIIrc") { &make_stamprc }
    return unless $sequence;
    if ($sequence) {
        system("vidcat -d $options{'dev_name'} -f jpeg > /tmp/webcamII
+.jpg") == 0 or die "vidcat failed: $1\n";
            system("stamp -r /tmp/webcamIIrc") == 0 or die "stamp fail
+ed: $!\n";
        $snap = $picture->Photo(-format=>'JPEG',-file => $options{'pic
+_name'});
            $snapshot->configure(-image=>$snap);
        if (! &upload ) { 
                    $sequence = 0;
                    $start_seq->configure(-state=>'normal');
                    exit;
                }
        $main->after(($options{'delay_time'} * 1000),\&take_continuos)
+;
    }
}

sub save_single {
    @types = ( ["Jpeg files",['.jpg']] );
    $file= $main->getSaveFile(-filetypes=>\@types,
                  -initialfile=>'snap',
                  -defaultextension=>'.jpg');
    if (defined $file) {
        copy($options{'pic_name'},$file) == 1 or warn "Couldn't copy!\
+n\t$!\n";
    }
}

sub upload {
    $ftp = Net::FTP->new($options{'ftp_server'},-timeout=>60) or retur
+n 1;
    $ftp->login($options{'ftp_user'},$options{'ftp_pass'}) or die;
    if ( $options{'ftp_cwd'} ) { $ftp->cwd($options{'ftp_cwd'}) or die
+; }
    $ftp->type('I');
    $ftp->put($options{'pic_name'}) or die;
    $ftp->quit or return 1;
}

sub make_stamprc {
# make a RC file for STAMP.
    open (STAMP, ">/tmp/webcamIIrc");
    print STAMP "infile\t/tmp/webcamII.jpg\n";
    if ($options{'pic_name'}) { print STAMP "outfile\t$options{'pic_na
+me'}\n"; }
    print STAMP "use3d\t1\n";
    print STAMP "rotate\t0\n";
    if ($options{'low_string'}) { print STAMP "lowerstring\t$options{'
+low_string'}\n"; }
    if ($options{'exec_low'}  ) { print STAMP "lstringexec\t$options{'
+exec_low'}\n"; }
    if ($options{'top_string'}) { print STAMP "upperstring\t$options{'
+top_string'}\n"; }
    if ($options{'exec_top'}  ) { print STAMP "ustringexec\t$options{'
+exec_top'}\n"; }
    print STAMP "upperfont\t/usr/local/share/stamp/fonts/computer.fnt\
+n";
    print STAMP "lowerfont\t/usr/local/share/stamp/fonts/computer.fnt\
+n";
    print STAMP "redfore\t255\n";
    print STAMP "greenfore\t238\n";
    print STAMP "bluefore\t245\n";
    print STAMP "redback\t20\n";
    print STAMP "blueback\t115\n";
    print STAMP "greenback\t6\n";
    print STAMP "shaderate\t10\n";
    print STAMP "usecolors\t1\n";
    close(STAMP);
}

[Beatnik]

When Stamp started Coredumping on me, I hacked this piece of code.



#!/usr/bin/perl

use Net::FTP;
use GD;
# Beatnik (c) 2000 - yadayadayada
# http://stampl.sourceforge.net
$inputfile = "/tmp/me.jpg"; # Local input filename
$outputfile = "/tmp/recent.jpg"; # Local output filename
$remotefile = "recent.jpg"; # Remote filename
$remotedir = ""; # Remote directory
$hostname = "ftp.myhost.com"; # Remote hostname
$username = "user"; # username for remote host
$password = "password"; # password for remote host
$interval = 45; # Amount of seconds to wait before uploading again
$textbot = "StamPL - Test"; # The text that should be added at the bot
+tom

for(;;) {
$texttop = localtime;
$ltop = length($texttop)*8;
$lbot = length($textbot)*8;
$result = qx|cqcam -32+ -a+ -r -j -x 320 -y 240 -q 75 > $inputfile|;
if ($result) { die $result; }
$image = GD::Image->newFromJpeg($inputfile);
$blue = $image->colorClosest(0,0,255);
$shadow = $image->colorClosest(128,128,128);
($width,$height) = $image->getBounds();
$w = $width/2;
$ttop = $w-($ltop/2);
$tbot = $w-($lbot/2);
$image->string(gdMediumBoldFont,$ttop+2,3,$texttop,$blue);
$image->string(gdMediumBoldFont,$ttop,1,$texttop,$shadow);
$image->string(gdMediumBoldFont,$tbot,($height-14),$textbot,$blue);
$image->string(gdMediumBoldFont,$tbot+2,($height-14)+2,$textbot,$shado
+w);
open(FILE,">$outputfile") || die $!;
print FILE $image->jpeg();
close(FILE);
$ftp = Net::FTP->new($hostname);
$ftp->login($username,$password);
$ftp->cwd($remotedir);
$ftp->put($outputfile,$remotefile);
$ftp->quit;
sleep($interval);
}



It uses GD (which limits palette to 256 colors :( ) and Net::FTP. It also uses cqcam (which is also used by Stamp), and it currently on Sourceforge somewhere.
Ofcourse sleep() isnt really a clean way to do it, but I didnt felt like forking :)

Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.

[peschkaj]

Dayum, that's alot of code. I wrote a piece of cam-like software today. I have found a program that works astonishingly well (gqcam) on my linux box. The only problem being that it doesn't auto upload. So, I took it upon myself to write some code for it:

#!/usr/bin/perl -w

use Net::FTP;

my $hostname;
my $username;
my $password;
my $boink;
my $directory;
my $filename;
my $ftp;
my $sleeptime;

$boink = 0;

while ($boink == 0) {
    $ftp = Net::FTP->new($hostname) or die "can't connect: $@\n";
    $ftp->login($username,$password) or die "can't login: $@\n";
    $ftp->cwd($directory) or die "can't cwd to $directory\n";
    $ftp->type(binary) or die "cannot change type to binary\n";
    $ftp->put($filename) or die "cannot put $filename\n";
    $ftp->close;
    sleep($sleeptime);
}

Althogh this is nothing revolutionary, I thought that I might as well post it because it runs under -w, as far as I am aware. I attempted to launch gqcam from the program with: `gqcam &`; but that generated error after error for the cam program. If anyone has any input on this, let me know.

[Beatnik]

The huge amount of code is mostly for GD... the timestamp and footer stuff. I can compact it to a one-liner but then again... :))
The whole purpose was to more or less mimick the Stamp app behaviour (which it kinda does).

Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.