# -*- perl -*-

# Basic attribute creation, modification, and retrieval tests

package Foo;

use strict;
use warnings;

sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self;
}

sub bar {
    my ($foo, $bar) = @_;
    if (defined($bar)) { $foo->{bar} = $bar } else { $foo->{bar} }
}

package main;

use strict;
use warnings;
use Test;

BEGIN { $| = 1; plan tests => 55 }

use Games::Object;
use Games::Object::Manager;

# Define a subroutine to check to see if a value is within a very small
# range of a target. This is needed for some Perl 5.8 floating point
# precision problems.
sub in_range {
    my ($num, $target, $range) = @_;
    my $diff = abs($num - $target);
    $diff <= $range;
}

# Create object to use.
my $man = Games::Object::Manager->new();
my $obj = Games::Object->new();
ok( defined($obj) && defined($man->add($obj)) );

# Integers
eval('$obj->new_attr(
	-name	=> "AnInteger",
	-type	=> "int",
	-value	=> 10,
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr('AnInteger') == 10 );
eval('$obj->mod_attr(
	-name	=> "AnInteger",
	-value	=> 12,
)');
ok ( $obj->attr('AnInteger') == 12 );
eval('$obj->mod_attr(
	-name	=> "AnInteger",
	-modify	=> -4,
)');
ok ( $obj->attr('AnInteger') == 8 );

# Fractional-handling with integers
eval('$obj->new_attr(
	-name	=> "AnIntegerFractional",
	-type	=> "int",
	-value	=> 10.56,
	-track_fractional => 1,
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr('AnIntegerFractional') == 10 );
ok ( in_range($obj->raw_attr('AnIntegerFractional'), 10.56, 0.0001) );
ok ( $obj->attr('AnInteger') == 8 );
eval('$obj->mod_attr(
	-name	=> "AnIntegerFractional",
	-modify	=> 0.43,
)');
ok ( $obj->attr('AnIntegerFractional') == 10 );
ok ( in_range($obj->raw_attr('AnIntegerFractional'), 10.99, 0.0001) );
eval('$obj->mod_attr(
	-name	=> "AnIntegerFractional",
	-modify	=> 0.02,
)');
ok ( $obj->attr('AnIntegerFractional') == 11 );
ok ( in_range($obj->raw_attr('AnIntegerFractional'), 11.01, 0.0001) );
eval('$obj->new_attr(
	-name	=> "AnIntegerFractional2",
	-type	=> "int",
	-value	=> 10.56,
	-track_fractional => 1,
	-on_fractional => "ceil",
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr('AnIntegerFractional2') == 11 );
ok ( in_range($obj->raw_attr('AnIntegerFractional2'), 10.56, 0.0001) );
eval('$obj->mod_attr(
	-name	=> "AnIntegerFractional2",
	-modify	=> -0.07,
)');
ok ( $obj->attr('AnIntegerFractional2') == 11 );
ok ( in_range($obj->raw_attr('AnIntegerFractional2'), 10.49, 0.0001) );

# Numbers
eval('$obj->new_attr(
	-name	=> "ANumber",
	-type	=> "number",
	-value	=> 25.67,
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr("ANumber") == 25.67 );

# Strings
eval('$obj->new_attr(
	-name	=> "AString",
	-type	=> "string",
	-value	=> "How now brown cow?",
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr('AString') eq 'How now brown cow?' );

# Picklists
eval('$obj->new_attr(
	-name	=> "APicklist",
	-type	=> "string",
	-value	=> "the_other",
	-values  => [ "this", "that", "the_other", "something_or_other" ],
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr('APicklist') eq 'the_other' );

# Picklists with mapping
eval('$obj->new_attr(
	-name	=> "APicklistWithMapping",
	-type	=> "string",
	-value	=> "that",
	-values  => [ "this", "that", "the_other", "something_or_other" ],
	-map	=> {
	    this	=> "This one right here.",
	    that	=> "That one over there.",
	    the_other	=> "The other one way over there.",
	},
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr('APicklistWithMapping') eq 'That one over there.' );
ok ( $obj->raw_attr('APicklistWithMapping') eq 'that' );

# Split-value numbers
eval('$obj->new_attr(
	-name	=> "ASplitNumber",
	-type	=> "number",
	-value	=> 25.67,
	-tend_to_rate	=> 1,
	-real_value => 100.0,
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr("ASplitNumber") == 25.67 );
ok ( $obj->attr("ASplitNumber", "real_value") == 100.0 );
$obj->process();
ok ( $obj->attr("ASplitNumber") == 26.67 );

# Numbers with limits
eval('$obj->new_attr(
	-name	=> "ALimitedNumber",
	-type	=> "number",
	-value	=> 25.67,
	-minimum	=> 0,
	-maximum	=> 100,
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr("ALimitedNumber") == 25.67 );
eval('$obj->mod_attr(
	-name	=> "ALimitedNumber",
	-modify	=> -0.07,
)');
ok ( $obj->attr("ALimitedNumber") == 25.6 );
print "# $@" if ($@);
eval('$obj->mod_attr(
	-name	=> "ALimitedNumber",
	-modify	=> -30,
)');
ok ( $obj->attr("ALimitedNumber") == 0 );
print "# $@" if ($@);
eval('$obj->mod_attr(
	-name	=> "ALimitedNumber",
	-modify	=> 45.4,
)');
ok ( $obj->attr("ALimitedNumber") == 45.4 );
print "# $@" if ($@);
eval('$obj->mod_attr(
	-name	=> "ALimitedNumber",
	-modify	=> 75,
)');
ok ( $obj->attr("ALimitedNumber") == 100 );
print "# $@" if ($@);
eval('$obj->new_attr(
	-name	=> "AnotherLimitedNumber",
	-type	=> "number",
	-value	=> 25.67,
	-minimum	=> 0,
	-maximum	=> 100,
	-out_of_bounds => "ignore",
)');
ok ( $@ eq '' );
print "# $@" if ($@);
ok ( $obj->attr("AnotherLimitedNumber") == 25.67 );
eval('$obj->mod_attr(
	-name	=> "AnotherLimitedNumber",
	-modify	=> 75,
)');
ok ( $obj->attr("AnotherLimitedNumber") == 25.67 );
print "# $@" if ($@);
eval('$obj->mod_attr(
	-name	=> "AnotherLimitedNumber",
	-modify	=> -75,
)');
ok ( $obj->attr("AnotherLimitedNumber") == 25.67 );
print "# $@" if ($@);

# Object references (a very basic test only; more extensive testing can be found
# in other test scripts; this just tests storage, retrieval, and basic error
# handling)
my $robj1 = Foo->new(); $robj1->bar("SampleObject1");
my $robj2 = Foo->new(); $robj2->bar("SampleObject2");
my $res;
eval('$obj->new_attr(
	-name	=> "ObjectRef1",
	-type	=> "object",
	-value	=> $robj1,
)');
ok( $@ eq '' );
print "# $@" if ($@);
$res = $obj->attr("ObjectRef1");
ok( defined($res) && ref($res) eq 'Foo' && $res->bar() eq 'SampleObject1' );
eval('$obj->mod_attr(
	-name	=> "ObjectRef1",
	-value	=> $robj2,
)');
$res = $obj->attr("ObjectRef1");
ok( defined($res) && ref($res) eq 'Foo' && $res->bar() eq 'SampleObject2' );

# Perform some basic attribute existence tests.
ok( !defined($obj->attr("ThisDoesNotExist")) );
ok( !$obj->attr_exists("ThisDoesNotExist") );
ok( $obj->attr_exists("ObjectRef1") );

# Final test: accessors. Turn on accessors feature and create some more
# attributes.
$Games::Object::AccessorMethod = 1;
eval('$obj->new_attr(
	-name	=> "Accessorized1",
	-type	=> "int",
	-value	=> 42,
);');
ok( $@ eq '' );
print "# $@" if ($@);
eval('$obj->new_attr(
	-name	=> "Accessorized2",
	-type	=> "int",
	-value	=> 8674309,
);');
ok( $@ eq '' );
print "# $@" if ($@);

# Try to access their values via the accessor methods.
my $value;
eval('$value = $obj->Accessorized1();');
ok( $@ eq '' && $value == 42 );
print "# $@" if ($@);
eval('$value = $obj->Accessorized2();');
ok( $@ eq '' && $value == 8674309 );
print "# $@" if ($@);

# Try to use these to set the values.
eval('$obj->Accessorized1(1001);');
ok( $@ eq '' );
print "# $@" if ($@);
eval('$obj->Accessorized2(999);');
ok( $@ eq '' );
print "# $@" if ($@);

# And check that they got set.
eval('$value = $obj->Accessorized1();');
ok( $@ eq '' && $value == 1001 );
print "# $@" if ($@);
eval('$value = $obj->Accessorized2();');
ok( $@ eq '' && $value == 999 );
print "# $@" if ($@);

exit (0);