view release on metacpan or  search on metacpan

t/10_opengl_array.t  view on Meta::CPAN

use strict;
use Acme::MITHALDU::BleedingOpenGL qw(GL_FLOAT GL_INT GL_UNSIGNED_BYTE);
use Test::More tests => 141;

my $o1 = OpenGL::Array->new(5, GL_FLOAT);
ok($o1, "O::A->new");
is($o1->elements, 5, '$o1->elements');
ok($o1->length, '$o1->length');

my $o2 = OpenGL::Array->new(5, GL_INT, GL_INT, GL_INT, GL_INT, GL_INT);
ok($o2, "O::A->new");
is($o2->elements, 25, '$o2->elements');
ok($o2->length, '$o->length');

###----------------------------------------------------------------###

sub init { OpenGL::Array->new_list(GL_FLOAT, 1..9) }

sub fmt {
   my @val = ref($_[0]) ? $_[0]->retrieve(0, $_[0]->elements) : @_;
   push @val, 0 while @val < 9;
   return sprintf "%2d %2d %2d    %2d %2d %2d    %2d %2d %2d", @val;
}

sub lfmt { qr/^ \d  \d  \d     \d  \d  \d     \d  \d  \d$/ }

$o1 = init();
$o2 = init();
ok($o1, "O::A->new_list");
is(fmt($o1), fmt(1,2,3,4,5,6,7,8,9), '$o1->retrieve');
is(fmt($o2), fmt(1,2,3,4,5,6,7,8,9), '$o2->retrieve');

$o1->assign(2, 7);
is(fmt($o1), fmt(1,2,7,4,5,6,7,8,9), '$o1->assign(2,7)');

###----------------------------------------------------------------###

my $ptr = $o2->ptr();
ok($ptr, '$o2->ptr()');
$o1 = OpenGL::Array->new_pointer(GL_FLOAT, $ptr, 4);
ok($o1, 'O::A->new_pointer');
is(fmt($o1), fmt(1,2,3,4,0,0,0,0,0), '$o1->retrieve');

$o2->assign(2, 7);
is(fmt($o1), fmt(1,2,7,4,0,0,0,0,0), '$o1->assign(2,7)');
is(fmt($o2), fmt(1,2,7,4,5,6,7,8,9), '$o1->assign(2,7)');

$o1->assign(1, 7);
is(fmt($o1), fmt(1,7,7,4,0,0,0,0,0), '$o1->assign(2,7)');
is(fmt($o2), fmt(1,7,7,4,5,6,7,8,9), '$o1->assign(2,7)');

$ptr = $o2->offset(5);
ok($ptr, '$o2->offset(5)');
$o1 = OpenGL::Array->new_pointer(GL_FLOAT, $ptr, 4);
ok($o1, 'O::A->new_pointer');
is(fmt($o1), fmt(6,7,8,9,0,0,0,0,0), '$o1->retrieve');

$o1->update_pointer($o2->ptr());
is(fmt($o1), fmt(1,7,7,4,0,0,0,0,0), '$o1->update_pointer($o2->ptr())');

###----------------------------------------------------------------###

$o2 = OpenGL::Array->new_list(GL_UNSIGNED_BYTE, 1..9);
$o1 = OpenGL::Array->new_from_pointer($o2->ptr(), 9);
ok($o1, 'O::A->new_from_pointer');
is(fmt($o1), fmt(1,2,3,4,5,6,7,8,9), '$o1->new_from_pointer');

$o2->assign(2, 7);
is(fmt($o1), fmt(1,2,7,4,5,6,7,8,9), '$o1->assign(2,7)');
is(fmt($o2), fmt(1,2,7,4,5,6,7,8,9), '$o1->assign(2,7)');

$o1->assign(1, 7);
is(fmt($o1), fmt(1,7,7,4,5,6,7,8,9), '$o1->assign(2,7)');
is(fmt($o2), fmt(1,7,7,4,5,6,7,8,9), '$o1->assign(2,7)');

###----------------------------------------------------------------###

my $str = pack 'C*', 1..9;
$o1 = OpenGL::Array->new_scalar(GL_UNSIGNED_BYTE,$str,length($str));
is(fmt($o1), fmt(1,2,3,4,5,6,7,8,9), '$o1->new_scalar');

###----------------------------------------------------------------###

ok($o1->can('bind'), 'can ->bind');
ok(!$o1->bound, '$o1->bound()');

###----------------------------------------------------------------###

# affine
my $left   = -800;
my $right  = 800;
my $bottom = -100;
my $top    = 100;
my $zFar   = 5;
my $zNear  = -5;

my $A =  2 / ($right - $left);
my $B =  2 / ($top   - $bottom);
my $C = -2 / ($zFar   - $zNear);
my $tx = -($right + $left) / ($right - $left);
my $ty = -($top + $bottom) / ($top - $bottom);
my $tz = -($zFar + $zNear) / ($zFar - $zNear);

$o2 = OpenGL::Array->new_list(GL_FLOAT,
   $A, 0,  0,  $tx,
   0,  $B, 0,  $ty,
   0,  0,  $C, $tz,
   0, 0,   0,  1);

$o1 = OpenGL::Array->new_list(GL_FLOAT, 1, 1, 0);
$o1->affine($o2);
$o1->calc('1000,*');
is(fmt($o1), fmt(1,10,0,0,0,0,0,0,0), '$o1->affine($o2)');

###----------------------------------------------------------------###

$o1 = init();
$o2 = init();
$o1->calc(1);
is(fmt($o1), fmt(1,1,1,1,1,1,1,1,1), '$o1->calc(1)');

$o1->calc(1,2,3);
is(fmt($o1), fmt(1,2,3,1,2,3,1,2,3), '$o1->calc(1,2,3)');

ok(!eval { $o1->calc(1,2,3,4) }, "Correctly failed because column count wasn't a divisor of total elements");

###----------------------------------------------------------------###

$o1->calc(1);
$o1->assign_data(0, $o2->retrieve_data(0,$o2->length));
is(fmt($o1), fmt(1,2,3,4,5,6,7,8,9), "retrieve_data / assign_data (all)");

my $size = $o2->length / $o2->elements;
for my $i (1 .. $o2->elements) {
   $o1->calc(1);
   $o1->assign_data($i - 1, $o2->retrieve_data($i - 1, $size));
   my @test = (1) x $o2->elements;
   $test[$i-1] = $i;
   is(fmt($o1), fmt(@test), "retrieve_data / assign_data (".($i-1).")");
}

###----------------------------------------------------------------###

$o1->calc(0,4,1,-1,4,0,2,2,4);
$o1->calc('!');
is(fmt($o1), fmt(1,0,0,0,0,1,0,0,0), '$o1->calc("!")');

###----------------------------------------------------------------###

$o1 = init();
$o2 = init();
$o1->calc("-");
is(fmt($o1), fmt(-1,-2,-3,-4,-5,-6,-7,-8,-9), '$o1->calc("-")');
$o1->calc("1,-");
is(fmt($o1), fmt(-1,-1,-1,-1,-1,-1,-1,-1,-1), '$o1->calc("1,-")');

###----------------------------------------------------------------###

$o1 = init();
$o2 = init();
$o2->calc("+");
is(fmt($o2), fmt(1,2,3,4,5,6,7,8,9), '$o2->calc("+")');
$o1->calc("1,+");
is(fmt($o1), fmt(2,3,4,5,6,7,8,9,10), '$o1->calc("1,+")');

$o1 = init();
$o2 = init();
$o2->calc("or");
is(fmt($o2), fmt(1,2,3,4,5,6,7,8,9), '$o2->calc("or")');
$o1->calc("1,or");
is(fmt($o1), fmt(2,3,4,5,6,7,8,9,10), '$o1->calc("1,or")');

$o1 = init();
$o2 = init();
$o2->calc(3);
$o1->calc($o2, "+");
is(fmt($o1), fmt(4,5,6,7,8,9,10,11,12), '$o1->calc($o2, "+")');

###----------------------------------------------------------------###

$o1 = init();
$o2 = init();
$o2->calc("*");
is(fmt($o2), fmt(1,2,3,4,5,6,7,8,9), '$o2->calc("*")');
$o1->calc("2,*");
is(fmt($o1), fmt(2,4,6,8,10,12,14,16,18), '$o1->calc("2,*")');

$o1 = init();
$o2 = init();
$o2->calc("and");
is(fmt($o2), fmt(1,2,3,4,5,6,7,8,9), '$o2->calc("and")');
$o1->calc("2,and");
is(fmt($o1), fmt(2,4,6,8,10,12,14,16,18), '$o1->calc("2,and")');