# -*- mode: perl; coding: utf-8; tab-width: 4; -*-
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Cv.t'
#########################
# change 'tests => 2' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
#use Test::More tests => 35;
# use Test::Output;
BEGIN {
use_ok('Cv');
}
use File::Basename;
use List::Util qw(max min);
use Data::Dumper;
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
# my $img = Cv->LoadImage(dirname($0).'/'."baboon.jpg");
my $img = Cv->LoadImage(dirname($0).'/'."lena.jpg");
my $gray = $img->CvtColor(CV_RGB2GRAY);
my $dst = Cv->CreateImage([320, 240], 8, 3)->SetZero;
my $hist = Cv->CreateHist([256], CV_HIST_ARRAY);
ok($hist, 'Cv->CreateHist');
# ------------------------------------------------------------
# CreateHist - Creates histogram
# ------------------------------------------------------------
if (1) {
ok(Cv->CreateHist([256], CV_HIST_ARRAY),
'CreateHist(Cv->CreateHist)');
eval { Cv->CreateHist };
like($@, qr/Usage:/, 'CvCreateHist(usage)');
}
# ------------------------------------------------------------
# CalcHist - Calculates histogram of image(s)
# ------------------------------------------------------------
if (1) {
$hist->CalcHist([$gray]);
ok($hist, 'CalcHist');
eval { $hist->CalcHist };
like($@, qr/Usage:/, 'CalcHist(usage)');
}
# ------------------------------------------------------------
# GetMinMaxHistValue - Finds minimum and maximum histogram bins
# ------------------------------------------------------------
if (1) {
$hist->GetMinMaxHistValue(my $min_value, my $max_value);
ok(defined $min_value, 'GetMinMaxHistValue min_value');
ok(defined $max_value, 'GetMinMaxHistValue max_value');
}
# ------------------------------------------------------------
# QueryHistValue_*D - Queries value of histogram bin
# ------------------------------------------------------------
if (1) {
sub rand_int { int rand $_[0]; }
my ($w, $h) = (320, 240);
my @bin_size = (256, 256, 256);
my @planes = map { Cv->CreateImage([$w, $h], 8, 1) } (0..2);
my @values = (rand_int(255), rand_int(255), rand_int(255));
$planes[0]->Fill([ $values[0] ]);
$planes[1]->Fill([ $values[1] ]);
$planes[2]->Fill([ $values[2] ]);
my $h1 = Cv->CreateHist([ $bin_size[0] ], CV_HIST_ARRAY)
->CalcHist([ $planes[0] ]);
isa_ok($h1, "Cv::Histogram");
is($h1->QueryHistValue([ $values[0] ]), $w * $h, 'QueryHistValue(1D)');
my $h2 = Cv->CreateHist([ @bin_size[0 .. 1] ], CV_HIST_ARRAY)
->CalcHist([ @planes[0 .. 1] ]);
is($h2->QueryHistValue([ @values[0 .. 1] ]), $w * $h, 'QueryHistValue(2D)');
my $h3 = Cv->CreateHist([ @bin_size[0 .. 2] ], CV_HIST_ARRAY)
->CalcHist([ @planes[0 .. 2] ]);
is($h3->QueryHistValue([ @values[0 .. 2] ]), $w * $h, 'QueryHistValue(3D)');
}
# ------------------------------------------------------------
# CopyHist - Copies histogram
# ------------------------------------------------------------
if (1) {
my $copy = $hist->CopyHist;
isa_ok($copy, "Cv::Histogram");
ok($copy->CalcHist([ $gray ]), 'CopyHist');
$copy = $hist->Copy;
isa_ok($copy, "Cv::Histogram");
}
# ------------------------------------------------------------
# ThreshHist - Thresholds histogram
# ------------------------------------------------------------
if (1) {
my $copy = $hist->CopyHist->CalcHist([ $gray ]);
isa_ok($copy, "Cv::Histogram");
ok($copy->ThreshHist(1), 'Thresh');
ok($copy->Thresh(0.5), 'Thresh');
}
# ------------------------------------------------------------
# NormalizeHist - Normalizes histogram
# ------------------------------------------------------------
if (1) {
my $copy = $hist->CopyHist->CalcHist([ $gray ]);
isa_ok($copy, "Cv::Histogram");
ok($copy->NormalizeHist(1), 'Normalize');
ok($copy->Normalize(0.5), 'Normalize');
}
# ------------------------------------------------------------
# CompareHist - Compares two dense histograms
# ------------------------------------------------------------
if (1) {
my $copy1 = $hist->CopyHist->CalcHist([ $gray ]);
isa_ok($copy1, "Cv::Histogram");
my $copy2 = $hist->CopyHist->CalcHist([ $gray->PyrDown ]);
isa_ok($copy2, "Cv::Histogram");
my $d = $copy1->CompareHist($copy2, CV_COMP_CORREL);
ok($d, 'CompareHist');
ok($copy1->Compare($copy2, CV_COMP_CORREL), 'Compare');
}
# ------------------------------------------------------------
# ClearHist - Clears histogram
# ------------------------------------------------------------
if (1) {
my $copy = $hist->CopyHist->CalcHist([ $gray ]);
my $b = $copy->QueryHistValue([ 100 ]);
$copy->ClearHist;
my $a = $copy->QueryHistValue([ 100 ]);
ok($b > 0 && $a == 0, 'ClearHist');
$copy->CalcHist([ $gray ]);
$b = $copy->QueryHistValue([ 100 ]);
$copy->Clear;
$a = $copy->QueryHistValue([ 100 ]);
ok($b > 0 && $a == 0, 'Clear');
}
# ------------------------------------------------------------
# CalcBackProject - Calculates back projection
# ------------------------------------------------------------
if (1) {
my $copy = $hist->CopyHist->CalcHist([ $gray ]);
my $backproject = $copy->CalcBackProject([ $gray ], $gray->new);
isa_ok($backproject, "Cv::Image");
}
my ($width, $height) = (256, 100);
my $zero = Cv->CreateImage([$width, $height], 8, 1)->Zero;
my @himages;
foreach ($img->Split) {
my $hist = Cv->CreateHist([256], CV_HIST_ARRAY)->Calc([$_]);
$hist->GetMinMaxHistValue(my $min, my $max);
$hist->bins->ConvertScale($hist->bins, $height / $max) if $max;
my $himage = $zero->Clone;
for my $i (0 .. 255) {
my ($x, $y) = ($i * $width / 256, $height);
my $pt1 = [$x, $y];
my $pt2 = [$x + $width / 256, $y - $hist->QueryHistValue([$i])];
$himage->Rectangle($pt1, $pt2, [$i]);
}
push(@himages, $himage);
}
my $histogram = Cv->CreateImage([$width, 3*$height], 8, 3);
my $blue = [ 0, 0*$height, $width, $height ];
my $green = [ 0, 1*$height, $width, $height ];
my $red = [ 0, 2*$height, $width, $height ];
Cv->Merge([$himages[0], $zero, $zero], $histogram->SetImageROI($blue));
Cv->Merge([$zero, $himages[1], $zero], $histogram->SetImageROI($green));
Cv->Merge([$zero, $zero, $himages[2]], $histogram->SetImageROI($red));
$histogram->ResetImageROI;
my $haswin = Cv->hasGUI;
if ($haswin) {
$histogram->ShowImage('Histogram');
$img->ShowImage('Image');
Cv->WaitKey(1000);
}
exit (0);