home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Non-RPC
/
!Perl
/
riscos
/
RISCOS
/
Sprite.pm
< prev
next >
Wrap
Text File
|
1998-07-27
|
3KB
|
129 lines
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