#!perl
# Stcs Channel
use strict;
use Test::More;
BEGIN {
use Starlink::AST;
if ( Starlink::AST::Version() < 5002000 ) {
plan skip_all => "Not supported. Please upgrade to AST Version > 5.2";
exit;
} else {
plan tests => 13;
}
};
# Implement astShow
my $obj = new Starlink::AST::UnitMap( 1, "" );
my $ch = new Starlink::AST::StcsChan ( sink => sub {print "# $_[0]\n" } );
isa_ok($ch, 'Starlink::AST::StcsChan');
isa_ok($ch, 'Starlink::AST::Channel');
$ch->Write( $obj );
ok(1, "Write complete");
# Try again, but storing to an array
my @cards;
{
$ch = new Starlink::AST::StcsChan ( sink => sub {push(@cards, $_[0]) } );
$ch->Write( $obj );
}
for (@cards) {
print "# $_\n";
}
ok(1, "Write to internal array complete");
# This test taken from pyast
my @buffin = (
"StartTime 1900-01-01 Circle ICRS 148.9 69.1 2.0",
"SpeCtralInterval 4000 7000 unit Angstrom" );
my @buffout;
my $buffch = new Starlink::AST::StcsChan(
sink => sub {push @buffout, shift},
source => sub {return shift @buffin} );
my $readobj = $buffch->Read();
isa_ok($readobj, 'Starlink::AST::Prism');
cmp_ok($readobj->Get('Naxes'), '==', 4);
my ($lbnd, $ubnd) = $readobj->GetRegionBounds();
cmp_ok($ubnd->[0], '>', 1000000000 ); # shoudl be == max float
ok(nearly_equal($lbnd->[1], 2.50080939227851), 'lbnd[1]');
ok(nearly_equal($ubnd->[1], 2.6967811201606), 'ubnd[1]');
ok(nearly_equal($lbnd->[2], 1.171115928088195), 'lbnd[2]');
ok(nearly_equal($ubnd->[2], 1.24091013301998), 'ubnd[2]');
is($lbnd->[3], 4000.0);
is($ubnd->[3], 7000.0);
sub nearly_equal {
my ($a, $b) = @_;
return ($a - $b) < 0.0000000001;
}