sourcecode Arjen <CODE> #!/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(-side=>'left'); $file_menu->command(-label=>'Configure',-command=>sub{ &configure }); $file_menu->separator; $file_menu->command(-label=>'Exit',-command=>sub{ &write_rc; exit; }); $help_menu = $menu->Menubutton(-text=>'Help',-tearoff=>0)->pack(-side=>'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,pady=>3); $single_frm->Label(-text=>'Single shot: ')->pack(-side=>'left'); $save_opts = $single_frm->Menubutton(-text=>'Save',-relief=>'raised',-tearoff=>0)->pack(-side=>'right'); $save_local = $save_opts->command(-label=>'Save local',-command=>sub{ if ($sequence == 0){ &save_single } }); $save_ftp = $save_opts->command(-label=>'Save on FTP',-command=>sub{ 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_seq->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=>'right'); 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{HOME}/webcamII.jpg" }; if (! $options{"ftp_server"} ) { if ($main) { $start_seq->configure(-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 <arjen\@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 ideas 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=>'right'); $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=>'right'); $buttons = $change_win->Frame(-relief=>'groove')->pack(-side=>'top',-fill=>'x'); $buttons->Button(-text=>'Save',-command=>sub{ $options{'top_string'} = $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=>\$options{'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=>\$options{'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=>\$options{'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=>\$options{'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=>\$options{'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=>\$options{'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=>\$options{'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_name'}); $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 failed: $!\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 return 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_name'}\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); } </CODE> 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. <A HREF="http://www.wiersma.org/webcamii.html">My original page</A> for links to the above programs. Cheers GUI Programming Arjen Wiersma (arjen@wiersma.org)