home *** CD-ROM | disk | FTP | other *** search
- package RISCOS::DrawFile::JPEG;
- @ISA = 'RISCOS::DrawFile::Object';
-
- use strict;
- require RISCOS::DrawFile::Object;
- use RISCOS::Units qw(pack_transform_block unpack_transform_block inch2draw);
- use RISCOS::JPEG 'jpeg_info';
- use vars '$VERSION';
- $VERSION = 0.01;
- # 0.01 adds Translate
-
- ### use SelfLoader;
- sub RISCOS::DrawFile::JPEG::new ($$);
- sub RISCOS::DrawFile::JPEG::Type ;
- sub RISCOS::DrawFile::JPEG::BBox_Calc ;
- sub RISCOS::DrawFile::JPEG::Size ;
- sub RISCOS::DrawFile::JPEG::__pack ($);
- sub RISCOS::DrawFile::JPEG::Pack ($$);
- sub RISCOS::DrawFile::JPEG::Write ;
- sub RISCOS::DrawFile::JPEG::Translate ($$$$);
- 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 ($height, $width, $xdpi, $ydpi, $trans, $length, $jpeg, $data);
- return wantarray ? () : undef unless defined $_[0];
- if (ref ($_[0]) eq 'ARRAY') {
- # [JPEG, dpi, dpi, transform], x, y
- # only if transform absent default from x, y
- ($jpeg, $xdpi, $ydpi, $trans) = @{$_[0]};
- my ($x, $y, $ratio);
- ($width, $height, $x, $y, undef, undef, $ratio) = jpeg_info $jpeg;
- return () unless defined $height; # doesn't smell like a JPEG.
- if (defined $xdpi) {
- unless (defined $ydpi) {
- $ydpi = $xdpi * $y / $x;
- } # else they are both forced
- } else {
- if (defined $ydpi) {
- $xdpi = $ydpi * $x / $y;
- } else {
- # Neither was given.
- if ($ratio) {
- # Wing it.
- $xdpi = 90;
- $ydpi = 90 * $y / $x
- } else {
- $xdpi = $x;
- $ydpi = $y;
- }
- }
- }
- ($width, $height) = inch2draw ($width / $xdpi, $height / $ydpi);
- # Copy it if needs be.
- $trans = $trans ? [@$trans] : [1, 0, 0, 1, $_[1] || 0, $_[2] || 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;
- }
- ($height, $width, $xdpi, $ydpi, $length) = unpack 'I4x24I', $data;
- $trans = unpack_transform_block substr ($data, 16, 24);
- $jpeg = substr ($data, 44, $length);
- }
-
- $self->{'__H'} = $height;
- $self->{'__W'} = $width;
- $self->{'__XDPI'} = $xdpi;
- $self->{'__YDPI'} = $ydpi;
- $self->{'__TRANSFORM'} = $trans;
- $self->{'__JPEG'} = $jpeg;
- wantarray ? ($self, $type) : $self;
- }
-
- sub Type { 16 }
-
- sub BBox_Calc {
- my $self = shift;
- my $trans = $self->{'__TRANSFORM'};
- my ($h, $w, $x, $y) = ($self->{'__H'}, $self->{'__W'});
- 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 Size {
- my $self = shift;
- # 24 for transform & flags if present
- # 24 for type, length and bbox
- (68 + 3 + length $self->{'__JPEG'}) & ~3;
- }
-
- sub __pack ($) {
- my $self = shift;
- $self->PackTypeSizeBBox(16) . pack ('I4', $self->{'__H'}, $self->{'__W'},
- $self->{'__XDPI'}, $self->{'__YDPI'})
- . pack_transform_block ($self->{'__TRANSFORM'})
- . pack 'I', length $self->{'__JPEG'}
- }
-
- sub Pack ($$) {
- my $self = $_[0];
- &__pack . $self->{'__JPEG'} . ("\0" x (-length ($self->{'__JPEG'}) & 3))
- }
-
- sub Write {
- my $self = $_[0];
- print {$_[1]} &__pack, $self->{'__JPEG'},
- ("\0" x (-length ($self->{'__JPEG'}) & 3))
- }
-
- sub Translate ($$$$) {
- my $self = $_[0];
- my $bbox = $self->{'__BBOX'};
- if (defined $bbox) {
- $$bbox[0] += $_[1];
- $$bbox[1] += $_[2];
- $$bbox[2] += $_[1];
- $$bbox[3] += $_[2];
- }
- my $trans = $self->{'__TRANSFORM'};
- if (defined $trans) {
- $$trans[4] += $_[1];
- $$trans[5] += $_[2];
- }
- ();
- }
-
- 1;
- __END__
-
- =head1 NAME
-
- RISCOS::DrawFile::JPEG
-
- =head1 SYNOPSIS
-
- Class to handle JPEG objects in DrawFiles
-
- =head1 DESCRIPTION
-
- C<RISCOS::DrawFile::JPEG> provides a class that stores JPEGs.
-
- =head1 BUGS
-
- None known.
-
- =head1 AUTHOR
-
- Nicholas Clark <F<nick@unfortu.net>>
-