view release on metacpan or  search on metacpan

sample/motempl.pl  view on Meta::CPAN

#!/usr/bin/perl
# -*- mode: perl; coding: utf-8; tab-width: 4; -*-

use strict;
use warnings;
use lib qw(blib/lib blib/arch);
use Cv;
use Time::HiRes qw(gettimeofday);
use Data::Dumper;

# various tracking parameters (in seconds)
use constant {
	MHI_DURATION   => 1,
};

use constant {
	MAX_TIME_DELTA => MHI_DURATION * 0.5,
	MIN_TIME_DELTA => MHI_DURATION * 0.05,
};

# number of cyclic frame buffer used for motion detection
# (should, probably, depend on FPS)
use constant {
	N => 4,
};

my $diff_threshold = 30;

my $start;
my $lastgray;

# temporary images
my $mhi;						# MHI
my $orient;						# orientation
my $mask;						# valid orientation mask
my $segmask;					# motion segmentation map
my $storage;					# temporary storage

# parameters:
#   img - input video frame
#   dst - resultant motion picture
sub update_mhi {
	my ($img, $dst) = @_;
	unless ($start) {
		$start = gettimeofday;
	}
    my $timestamp = gettimeofday - $start; # get current time in seconds
    my $size = cvSize($img->width, $img->height); # get current frame size
	my $gray = $img->CvtColor(CV_BGR2GRAY); # convert frame to grayscale

	unless ($lastgray) {
		$lastgray = $gray;
	}

	unless ($mhi) {
		# temporary images
		$mhi = $gray->new($gray->sizes, CV_32FC1)->Zero;
		$mask = $gray->new;
		$orient = $mhi->new;
		$segmask = $mhi->new;
	}

	# get difference between frames and threshold it
	my $binary = $gray->AbsDiff($lastgray, $gray->new)
		->Threshold($diff_threshold, 1, CV_THRESH_BINARY);
	$binary->UpdateMotionHistory($mhi, $timestamp, MHI_DURATION);
	
	# convert MHI to blue 8u image
	$mhi->CvtScale($mask, 255/MHI_DURATION,
				   (MHI_DURATION - $timestamp)*255/MHI_DURATION);
	$dst->Zero;
	Cv->Merge([$mask], $dst);

	# calculate motion gradient orientation and valid orientation mask
	$mhi->CalcMotionGradient(
		$mask, $orient, MAX_TIME_DELTA, MIN_TIME_DELTA, 3);

	unless ($storage) {
		$storage = Cv::MemStorage->new;
	} else {
		$storage->ClearMemStorage;
	}

	# segment motion: get sequence of motion components segmask is
	# marked motion components map. It is not used further
	my $seq = $mhi->SegmentMotion(
		$segmask, $storage, $timestamp, MAX_TIME_DELTA);

	# iterate through the motion components,
	# One more iteration (i == -1) corresponds to the whole image
	# (global motion)
	foreach my $i (-1 .. $seq->total - 1) {
		my ($comp_rect, $color, $magnitude);
		if ($i < 0) {		# case of the whole image
			$comp_rect = cvRect(0, 0, @$size);
			$color = CV_RGB(255,255,255);
			$magnitude = 100;
		} else {			# i-th motion component
			$comp_rect = [unpack("x8 x32 i4", $seq->GetSeqElem($i))];
			$color = CV_RGB(255,0,0);
			$magnitude = 30;
		}