| Category: | GUI Programming |
| Author/Contact Info | Arjen Wiersma (arjen@wiersma.org) |
| 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);
}
|
|
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Webcam 0.2
by Beatnik (Parson) on Jan 17, 2001 at 03:45 UTC | |
by peschkaj (Pilgrim) on Aug 08, 2001 at 00:01 UTC | |
by Beatnik (Parson) on Aug 08, 2001 at 00:28 UTC |