package RISCOS::Sprite;

use RISCOS::SWI;
require Exporter;
use Carp;
use strict;
# use SelfLoader;
use RISCOS::Units qw(pack_transform_block inch2draw inch2os);
use RISCOS::Mode 'mode_read_vars';

use vars qw (@ISA @EXPORT_OK $VERSION $sprite_op &sprite_op &sprite_info
	     &sprite_size $inch2os);

@ISA = qw(Exporter);
$VERSION = 0.01;
@EXPORT_OK = qw(sprite_op sprite_info sprite_size);

# for ops with R0 < 256
# R1 = undef ->	scalar ref ->	sprite in scalar
#				else system by name
# R1 = 0 or '' -> dummy sprite area, pointer in R2, or ref is data
# R1 defined && true -> sprite area, R2 groked for tr/0-9//c;
#    R1 as ref is sprite area, else taken as a numeric pointer.

$inch2os = inch2os (1);

sub sprite_op {
    my ($op, $area, $name, @args) = @_;
    return unless defined $op;
    return if (($op & 0x300) == 0x300);
    if (($op & 0x300) == 0) {
	unless (defined $area) {
	    # No area, so scalar ref is taken as actual sprite data.
	    if (ref $name) {
		return kernelswi ($op | 0x200, 0x200, $$name, @args);
	    }
	    return kernelswi ($op, 0, $name . '', @args);
	} elsif (!$area) {
	    # Fake a dummy sprite area and do it by pointer
	    return kernelswi ($op | 0x200, 0x200, ref ($name) ? $$name
							      : $name + 0,
			      @args);
	} else {
	    if ($name =~ tr/0-9//c) {
		# It has a non-numeric
		$name .= '';
	    } else {
		$name += 0;
	    }
	    return kernelswi ($op | 0x100, ref ($area) ? $$area
						       : $area + 0,
			      $name, @args);
	}
    } elsif (($op & 0x300) == 0x200) {
	return kernelswi ($op, ref ($area) ? $$area
					   : $area + 0, $name + 0, @args)
    } else {
	return kernelswi ($op, ref ($area) ? $$area
					   : $area + 0, $name . '', @args)
    }
}

sub sprite_decode_type ($) {
    return unless defined $_[0];
    my ($xdpi, $ydpi, $format);

    if ($_[0] & 0x08000000) {
	# New type
	$xdpi = ($_[0] >> 1) & 0x1FFF;
	$ydpi = ($_[0] >> 14) & 0x1FFF;
	$format = ($_[0] >> 27);
    } else {
	($xdpi, $ydpi, $format) = mode_read_vars ( 'XEigFactor', 'YEigFactor',
						   'Log2BPP' );
	return () unless defined $format;
	$xdpi = $inch2os / (1 << $xdpi);
	$ydpi = $inch2os / (1 << $ydpi);
	$format++;
    }
    ($xdpi, $ydpi, $format)
}

sub sprite_info {
    return unless defined (my $result = sprite_op (40, @_));
    unpack 'x12I4', $result;
}

sub sprite_size {
    my ($xpix, $ypix, $mode) = &sprite_info;
    my ($xdpi, $ydpi) = sprite_decode_type ($mode);
    return unless defined $xdpi;
    inch2draw ($xpix / $xdpi, $ypix / $ydpi)
}


$sprite_op = SWINumberFromString('XOS_SpriteOp');
__END__

=head1 NAME

RISCOS::Sprite -- perl interface to Sprites

=head1 SYNOPSIS

    use RISCOS::Sprite 'sprite_size';
    ($hieght, $width) = sprite_size ($sprite)

=head1 DESCRIPTION

C<RISCOS::Draw> provides an interface to

=head2 Subroutines

=over 4

=item what <type> <default> <values...>

=back

=head1 BUGS

Definitely not tested enough yet. Some bits not tested at all, I believe.

=head1 AUTHOR

Nicholas Clark <F<nick@unfortu.net>>

=cut
