home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Non-RPC
/
!Perl
/
riscos
/
RISCOS
/
DrawFile
/
Sprite.pm
< prev
next >
Wrap
Text File
|
1999-01-20
|
4KB
|
153 lines
package RISCOS::DrawFile::Sprite;
@ISA = 'RISCOS::DrawFile::Object';
require RISCOS::DrawFile::Object;
use RISCOS::Units qw(pack_transform_block unpack_transform_block);
use RISCOS::Sprite 'sprite_size';
$VERSION = 0.02;
# 0.01 adds Translate
# 0.02 adds sprite_size
### use SelfLoader;
sub RISCOS::DrawFile::Sprite::new ($$);
sub RISCOS::DrawFile::Sprite::Type ;
sub RISCOS::DrawFile::Sprite::BBox_Calc ;
sub RISCOS::DrawFile::Sprite::Translate ($$$$);
sub RISCOS::DrawFile::Sprite::Size ;
sub RISCOS::DrawFile::Sprite::Pack ($$);
sub RISCOS::DrawFile::Sprite::Write ;
1;
### __DATA__
sub new ($$) {
my $proto = shift;
my $class = ref($proto) || $proto;
my ($self, $type) = $class->SUPER::new (@_);
return $self if ref ($self) eq 'ARRAY';
my ($sprite, $trans, $data);
return wantarray ? () : undef unless defined $_[0];
if (ref ($_[0]) eq 'ARRAY') {
($sprite, $trans) = @{$_[0]};
} else {
# Time to unpack data
if (ref ($_[0]) eq 'SCALAR' or ref ($_[0]) eq 'LVALUE') {
# Has bounding box stripped
$data = ${$_[0]};
} else {
($length, @{$self->{'__BBOX'}}) = unpack 'x4Ii4', $_[0];
return undef unless length ($_[0]) == $length or $length & 3;
$data = substr $_[0], 24;
}
if ($type == 13) {
$trans = [];
$trans = unpack_transform_block substr ($data, 0, 24);
$data = substr ($data, 24);
}
}
$self->{'__TRANSFORM'} = $trans if defined $trans;
$self->{'__SPRITE'} = $data;
wantarray ? ($self, $type) : $self;
}
sub Type {
my $self = shift;
return 13 if defined $self->{'__TRANSFORM'};
5
}
sub BBox_Calc {
my $self = shift;
# Can't calculate BBox for untransformed sprites
return $self->{'__BBOX'}
unless defined (my $trans = $self->{'__TRANSFORM'});
my ($h, $w, $x, $y);
return unless (($h, $w) = sprite_size ($self->{'__SPRITE'}));
my $bbox = [0, 0, 0, 0];
foreach ([$w, 0], [$w, $h], [0, $h]) {
$x = $$_[0] * $$trans[0] + $$_[1] * $$trans[1];
$y = $$_[0] * $$trans[2] + $$_[1] * $$trans[3];
$$bbox[0] = $x if $x < $$bbox[0];
$$bbox[1] = $y if $y < $$bbox[1];
$$bbox[2] = $x if $x > $$bbox[2];
$$bbox[3] = $y if $y > $$bbox[3];
}
$$bbox[0] += $$trans[4];
$$bbox[1] += $$trans[5];
$$bbox[2] += $$trans[4];
$$bbox[3] += $$trans[5];
$self->{'__BBOX'} = $bbox;
}
sub Translate ($$$$) {
my $self = $_[0];
my $trans = $self->{'__TRANSFORM'};
my $bbox = $self->{'__BBOX'};
if (defined $bbox) {
$$bbox[0] += $_[1];
$$bbox[1] += $_[2];
$$bbox[2] += $_[1];
$$bbox[3] += $_[2];
} else {
warn "Cannot translate $_[0] by ($_[1], $_[2])\n" unless defined $trans;
}
if (defined $trans) {
$$trans[4] += $_[1];
$$trans[5] += $_[2];
}
();
}
sub Size {
my $self = shift;
# 24 for transform & flags if present
# 24 for type, length and bbox
(($self->Type == 13) ? 48 : 24) + length $self->{'__SPRITE'};
}
sub Pack ($$) {
my $self = shift;
my $type = $self->Type;
$self->PackTypeSizeBBox($type)
. (($type == 13) ? (pack_transform_block ($self->{'__TRANSFORM'})) : '')
. $self->{'__SPRITE'};
}
sub Write {
my $self = shift;
my $type = $self->Type;
print {$_[0]} $self->PackTypeSizeBBox($type),
(($type == 13)
? (pack_transform_block ($self->{'__TRANSFORM'}))
: ''),
$self->{'__SPRITE'};
}
1;
__END__
=head1 NAME
RISCOS::DrawFile::Sprite
=head1 SYNOPSIS
Class to handle sprite objects in DrawFiles
=head1 DESCRIPTION
C<RISCOS::DrawFile::Sprite> provides a class that stores sprites.
=head1 BUGS
None known.
=head1 AUTHOR
Nicholas Clark <F<nick@unfortu.net>>