# $Id: primaimage.pd,v 1.4 2003/02/28 17:18:29 dk Exp $

use strict;
pp_addpm({At=>'Top'},<<'EOD');

BEGIN { 
$VERSION = '1.01'; 
} 

=head1 NAME

PDL::PrimaImage - interface between PDL scalars and Prima images 

=head1 DESCRIPTION

Converts a 2D or 3D PDL scalar into Prima image and vice versa.

=head1 SYNOPSIS

  use PDL;
  use Prima;
  use PDL::PrimaImage;

  my $x = byte([ 10, 111, 2, 3], [4, 115, 6, 7]);
  my $i = PDL::PrimaImage::image( $x);
  $i-> type( im::RGB);
  $x = PDL::PrimaImage::piddle( $i);


=head2 image PDL, %OPTIONS

Converts 2D or 3D piddle into Prima image. The resulting
image pixel format depends on the piddle type and dimension.
The 2D array is converted into one of C<im::Byte>, C<im::Short>,
C<im::Long>, C<im::Float>, or C<im::Double> pixel types.

For 3D arrays each pixel is an array on values. 
C<image> accepts piddles with tuple and triple values.
For tuple, the resulting pixel format is complex ( with C<im::ComplexNumber> bit set),
where each pixel contains 2 values, either C<float> or C<double>, correspondingly
to <im::Complex> and C<im::DComplex> pixel formats.

For triple values, C<im::RGB> pixel format is assumed. In this format,
each image pixel is represented as a single combined RGB value.

To distinguish the degenerate cases, like ([1,2,3],[4,5,6]), where
it is impossible to guess whether the piddle is a 3x2 gray pixel image
or a 1x2 RGB image, C<%OPTIONS> hash is used. When either C<rgb> or
C<complex> boolean value is set, C<image> assumes the piddle is a 3D
array.  If neither option is set, C<image> favors 2D array semantics.
NB: These hints are neither useful nor are checked when piddle format is
explicit, and should only be used for hinting an ambiguous data representation. 

=head2 piddle IMAGE, %OPTIONS

Converts Prima image into a piddle. Depending on image pixel type,
the piddle type and dimension is selected. The following table depicts
how different image pixel formats affect the piddle type:


   Pixel format      PDL type    PDL dimension 
   --------------------------------------------
   im::bpp1            byte            2       
   im::bpp4            byte            2       
   im::bpp8            byte            2
   im::Byte            byte            2
   im::Short           short           2
   im::Long            long            2
   im::Float           float           2
   im::Double          double          2
   im::RGB             byte            3
   im::Complex         float           3
   im::DComplex        double          3
   im::TrigComplex     float           3
   im::TrigDComplex    double          3

Image in pixel formats C<im::bpp1> and C<im::bpp4> are converted to C<im::bpp8>
before conversion to piddle, so if raw, non-converted data stream is needed,
in correspondingly 8- and 2- pixels perl byte format, C<raw> boolean option
must be specified in C<%OPTIONS>. In this case, the resulting piddle width is
aligned to 4-byte boundary.

=head1 CONSIDERATIONS

Prima image coordinate origin is located in lower left corner. 
That means, that an image created from a 2x2 piddle ([0,0],[0,1]) will contain
pixel with value 1 in the upper right corner.

See L<Prima::Image> for more.

=cut

use PDL::Core;

package PDL::PrimaImage;

sub image
{
   my ( $piddle, %options) = @_;
   die "image: invalid parameter\n" unless defined $piddle;
   my $i = Prima::Image-> create();
   my ( $t0, $t2) = ( $piddle->getdim(0), $piddle->getdim(2));
   my $mpixel = 0;
   $mpixel = 1 if 
      ( $t2 == 1 && $t0 < 3 && ( $options{complex} || $options{rgb})) ||
      $t2 > 1;
   PDL::PrimaImage::image2piddle( $piddle, $i, 0, $mpixel);
   return $i;
}

sub piddle
{
   my ( $image, %options) = @_;
   die "piddle: invalid parameter\n" unless defined $image;
   my $piddle;
   my ( $x, $y) = $image-> size;
   my $itype = $image-> type;
   my $z = 1;
   my $ptype;
   if ( $itype & (im::ComplexNumber|im::TrigComplexNumber)) {
      $ptype = ( $itype == im::Complex || $itype == im::TrigComplex) ? float : double;
      $z = 2;
   } elsif ( $itype & im::RealNumber) {
      $ptype = ( $itype == im::Float) ? float : double;
   } elsif ( $itype & im::GrayScale) {
      if ( $itype == im::Long) {
         $ptype = long;
      } elsif ( $itype == im::Short) {
         $ptype = short;
      } elsif ( $itype == im::Byte) {
         $ptype = byte;
      } else {
         $image = $image-> dup;
         $image-> type( im::Byte);
         $ptype = byte;
      }
   } elsif ( $itype == im::RGB) {
      $ptype = byte;
      $z = 3;
   } elsif ( $itype == 8) {
      $ptype = byte;
   } else {
      if ( $options{raw}) {
         $x = int(( $x * ( $itype & im::BPP) + 31) / 32) * 4;
      } else {
         $image = $image-> dup;
         $image-> type( im::bpp8);
      }
      $ptype = byte;
   }
   
   $piddle = ( $z > 1) ? zeroes( $ptype, $z, $x, $y) : zeroes( $ptype, $x, $y);
   PDL::PrimaImage::image2piddle( $piddle, $image, 1, ( $z > 1) ? 1 : 0);
   return $piddle;
}

EOD

pp_addpm({At=>'Bot'},<<'EOD');

=head1 TROUBLESHOOTING

=over

=item Undefinedned symbol "gimme_the_vmt"

The symbol is contained in Prima toolkit. Include 'use Prima;' 
in your code. If the error persists, it is probably Prima
error; try to re-install Prima. If the problem continues,
try to change manually value in 'sub dl_load_flags { 0x00 }'
string to 0x01 in Prima.pm - this flag is used to control
namespace export ( see L<Dynaloader> for more ).

=item 

=back

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.

=head1 SEE ALSO

PDL-PrimaImage page, http://www.prima.eu.org/PDL-PrimaImage/

The Prima toolkit, http://www.prima.eu.org/

L<PDL>, L<Prima>, L<Prima::Image>.

=cut

EOD

pp_addhdr(<<HEADER);

#undef WORD
#include <apricot.h>
#include <Image.h>

PImage_vmt CImage;

static void
repad( Byte * source, Byte * dest, int h, int srcLineSize, int dstLineSize)
{
   int bsc = srcLineSize > dstLineSize ? dstLineSize : srcLineSize;
   for ( ; h > 0; h--, source += srcLineSize, dest += dstLineSize)
      memcpy(dest, source, bsc); 
}


static void
prima_image_convert( SV * imagesv, void * data, int w, int h, int image2piddle, int z, int mpixel, int type)
{
   int bsz = (type & imBPP)/8;
   PImage image;
   if ( !(( image = ( PImage) gimme_the_mate( imagesv)) && kind_of(( Handle) image, CImage)))
      croak("Invalid image object passed");
   if ( !mpixel) {
      h = w;
      w = z;
      z = 1;
   }
   if ( image2piddle) {
      repad(image-> data, ( Byte *) data, h, image-> lineSize, bsz * w * z);
   } else {
      if ( w * z != image-> w || h != image-> h || image-> type != type)
         image-> self-> create_empty(( Handle) image, w * z, h, type);
      repad(( Byte *) data, image-> data, h, bsz * w * z, image-> lineSize); 
      if ( z == 2) {
         if ( type != imFloat && type != imComplex)
            image-> self-> reset(( Handle) image, imFloat, nil, 0);
         image-> type = imComplexNumber | imGrayScale | ( image-> type & imBPP) * 2;
         image-> w /= 2;
      } else if ( z == 3) {
         if ( type != imByte)
            image-> self-> reset(( Handle) image, imByte, nil, 0);
         image-> type = imRGB;
         image-> w /= 3;
      }
      image-> self-> update_change((Handle)image);
   }
}


#define byte_prima_image_convert(a,b,c,d,e,f,g) prima_image_convert(a,b,c,d,e,f,g,imByte)
#define short_prima_image_convert(a,b,c,d,e,f,g) prima_image_convert(a,b,c,d,e,f,g,imShort)
#define long_prima_image_convert(a,b,c,d,e,f,g) prima_image_convert(a,b,c,d,e,f,g,imLong)
#define float_prima_image_convert(a,b,c,d,e,f,g) prima_image_convert(a,b,c,d,e,f,g,imFloat)
#define double_prima_image_convert(a,b,c,d,e,f,g) prima_image_convert(a,b,c,d,e,f,g,imDouble)
HEADER


pp_add_boot(<<'BOOT');
PRIMA_VERSION_BOOTCHECK;
CImage = (PImage_vmt)gimme_the_vmt( "Prima::Image");
BOOT

pp_def('image2piddle',
        Pars => 'data(z,w,h)',
        OtherPars => 'SV * imagesv; int image2piddle; int mpixel',
        GenericTypes => ['B','S','L','F','D'],
        Code => <<CODE,
\$TBSLFD(byte,short,long,float,double)_prima_image_convert(
    \$COMP(imagesv),\$P(data),\$SIZE(w),\$SIZE(h),
    \$COMP(image2piddle),\$SIZE(z),\$COMP(mpixel));
CODE
);

pp_done();