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 >
Encoding:
Perl POD Document  |  1999-01-20  |  3.6 KB  |  153 lines
  1. package RISCOS::DrawFile::Sprite;
  2. @ISA = 'RISCOS::DrawFile::Object';
  3.  
  4. require RISCOS::DrawFile::Object;
  5. use RISCOS::Units qw(pack_transform_block unpack_transform_block);
  6. use RISCOS::Sprite 'sprite_size';
  7.  
  8. $VERSION = 0.02;
  9. # 0.01 adds Translate
  10. # 0.02 adds sprite_size
  11.  
  12. ### use SelfLoader;
  13. sub RISCOS::DrawFile::Sprite::new ($$);
  14. sub RISCOS::DrawFile::Sprite::Type ;
  15. sub RISCOS::DrawFile::Sprite::BBox_Calc ;
  16. sub RISCOS::DrawFile::Sprite::Translate ($$$$);
  17. sub RISCOS::DrawFile::Sprite::Size ;
  18. sub RISCOS::DrawFile::Sprite::Pack ($$);
  19. sub RISCOS::DrawFile::Sprite::Write ;
  20. 1;
  21. ### __DATA__
  22. sub new ($$) {
  23.     my $proto = shift;
  24.     my $class = ref($proto) || $proto;
  25.  
  26.     my ($self, $type) = $class->SUPER::new (@_);
  27.     return $self if ref ($self) eq 'ARRAY';
  28.  
  29.     my ($sprite, $trans, $data);
  30.     return wantarray ? () : undef unless defined $_[0];
  31.     if (ref ($_[0]) eq 'ARRAY') {
  32.     ($sprite, $trans) = @{$_[0]};
  33.     } else {
  34.     # Time to unpack data
  35.     if (ref ($_[0]) eq 'SCALAR' or ref ($_[0]) eq 'LVALUE') {
  36.         # Has bounding box stripped
  37.         $data = ${$_[0]};
  38.     } else {
  39.         ($length, @{$self->{'__BBOX'}}) = unpack 'x4Ii4', $_[0];
  40.         return undef unless length ($_[0]) == $length or $length & 3;
  41.         $data = substr $_[0], 24;
  42.     }
  43.     if ($type == 13) {
  44.         $trans = [];
  45.         $trans = unpack_transform_block substr ($data, 0, 24);
  46.         $data = substr ($data, 24);
  47.     }
  48.     }
  49.  
  50.     $self->{'__TRANSFORM'} = $trans if defined $trans;
  51.     $self->{'__SPRITE'} = $data;
  52.  
  53.     wantarray ? ($self, $type) : $self;
  54. }
  55.  
  56. sub Type {
  57.     my $self = shift;
  58.     return 13 if defined $self->{'__TRANSFORM'};
  59.     5
  60. }
  61.  
  62. sub BBox_Calc {
  63.     my $self = shift;
  64.     # Can't calculate BBox for untransformed sprites
  65.     return $self->{'__BBOX'}
  66.       unless defined (my $trans = $self->{'__TRANSFORM'});
  67.     my ($h, $w, $x, $y);
  68.     return unless (($h, $w) = sprite_size ($self->{'__SPRITE'}));
  69.  
  70.     my $bbox = [0, 0, 0, 0];
  71.  
  72.     foreach ([$w, 0], [$w, $h], [0, $h]) {
  73.     $x = $$_[0] * $$trans[0] + $$_[1] * $$trans[1];
  74.     $y = $$_[0] * $$trans[2] + $$_[1] * $$trans[3];
  75.     $$bbox[0] = $x if $x < $$bbox[0];
  76.     $$bbox[1] = $y if $y < $$bbox[1];
  77.     $$bbox[2] = $x if $x > $$bbox[2];
  78.     $$bbox[3] = $y if $y > $$bbox[3];
  79.     }
  80.     $$bbox[0] += $$trans[4];
  81.     $$bbox[1] += $$trans[5];
  82.     $$bbox[2] += $$trans[4];
  83.     $$bbox[3] += $$trans[5];
  84.     $self->{'__BBOX'} = $bbox;
  85. }
  86.  
  87. sub Translate ($$$$) {
  88.     my $self = $_[0];
  89.     my $trans = $self->{'__TRANSFORM'};
  90.     my $bbox = $self->{'__BBOX'};
  91.     if (defined $bbox) {
  92.     $$bbox[0] += $_[1];
  93.     $$bbox[1] += $_[2];
  94.     $$bbox[2] += $_[1];
  95.     $$bbox[3] += $_[2];
  96.     } else {
  97.     warn "Cannot translate $_[0] by ($_[1], $_[2])\n" unless defined $trans;
  98.     }
  99.     if (defined $trans) {
  100.     $$trans[4] += $_[1];
  101.     $$trans[5] += $_[2];
  102.     }
  103.     ();
  104. }
  105.  
  106. sub Size {
  107.     my $self = shift;
  108.     # 24 for transform & flags if present
  109.     # 24 for type, length and bbox
  110.     (($self->Type == 13) ? 48 : 24) + length $self->{'__SPRITE'};
  111. }
  112.  
  113. sub Pack ($$) {
  114.     my $self = shift;
  115.     my $type = $self->Type;
  116.     $self->PackTypeSizeBBox($type)
  117.       . (($type == 13) ? (pack_transform_block ($self->{'__TRANSFORM'})) : '')
  118.       . $self->{'__SPRITE'};
  119. }
  120.  
  121. sub Write {
  122.     my $self = shift;
  123.     my $type = $self->Type;
  124.     print {$_[0]} $self->PackTypeSizeBBox($type),
  125.           (($type == 13)
  126.             ? (pack_transform_block ($self->{'__TRANSFORM'}))
  127.             : ''),
  128.           $self->{'__SPRITE'};
  129. }
  130.  
  131. 1;
  132. __END__
  133.  
  134. =head1 NAME
  135.  
  136. RISCOS::DrawFile::Sprite
  137.  
  138. =head1 SYNOPSIS
  139.  
  140. Class to handle sprite objects in DrawFiles
  141.  
  142. =head1 DESCRIPTION
  143.  
  144. C<RISCOS::DrawFile::Sprite> provides a class that stores sprites.
  145.  
  146. =head1 BUGS
  147.  
  148. None known.
  149.  
  150. =head1 AUTHOR
  151.  
  152. Nicholas Clark <F<nick@unfortu.net>>
  153.