view release on metacpan or  search on metacpan

bin/morec2  view on Meta::CPAN

#! /usr/bin/perl -w
use strict;
use warnings;
use Prima qw(Application Buttons Outlines Label MsgBox Utils ImageViewer Sliders);
use Prima::IPA qw(Point Misc);
use Time::HiRes qw(time);

my $image_buf;
my $live_video = 1;
my $w;
my $counter  = 0;
my $exp_path = "/home/visitor/Desktop/Exp";
my $disable_check_dir;
my $fps = 0;
my $last_time = time;

sub mask_to_filename
{
	my ($number, $msk, $ct)= @_;
	my $prev = 0;
	for (my $i = 0; $i < $number; $i++ ){
		my $r = int(($ct-$prev)/(10**($number-$i-1)));
		$prev += ($r *(10**($number-$i-1)));
		$msk =~ s|#|$r|o;
	}
	return $msk;
}

sub init_video
{
	system "v4l2-ctl ".
		"-s 3 ". # pal bg
		"-i 1 ". # composite
		"-v width=768,height=576,pixelformat=GREY ". # pixelformat
		"";
	unless (open VIDEO, '<', '/dev/video0') {
		message("Error initializing video:$!");
		exit;
	}
	binmode VIDEO;
	local $/;

	$image_buf = Prima::Image->new(
		width => 768,
		height => 576,
		type => im::Byte,
	);
	$w->Video->image($image_buf);
}

sub read_frame
{
	my $c = '';
	if ( $w->menu->AverageVideo->checked) {
		my @img;
		for ( 1 .. $w->average->value) {
			my $img = $image_buf->dup;
			my $n = sysread VIDEO, $c, 768*576;
			warn "$n:$!" if $n != 768*576;
			$img->data($c);
			push @img, $img;
		}
		my $aimg = Prima::IPA::Point::average(\@img);
		$image_buf->data($aimg->data);
	} else {
		my $n = sysread VIDEO, $c, 768*576;
		warn "$n:$!" if $n != 768*576;
		$image_buf->data($c);
	}
	$image_buf->size(768,-576);
	if ($w->equalize->checked) {
		my $p = Prima::IPA::Point::equalize($image_buf);
		$image_buf->data($p->data);
	}
}

sub do_save
{
	my $path = $w->DirList->path;
	return message("Can't find # in the mask of files") unless $w->ipl1->text =~ /#/;

	# count number of #s
	my $mask   = $w->ipl1->text;
	my $number = ($mask=~ tr /#/#/);
	my $max    = 10 ** $number;
	return message("Recorded $max images already") if $counter >= $max;

	my $file = mask_to_filename($number, $mask, $counter);
	if (-f $w->DirList->path.'/'.$file) {
		return if message_box($file, "file $file already exists! Overwrite?", mb::YesNo) == mb::No;
	}

	$w->msg->text("Recorded $file file");

	$counter++;
	if ($counter < $max) {
		my $next = mask_to_filename($number, $w->ipl1->text, $counter);
		$w->will->text("Will record $next file");
	} else {
		$w->will->text('');