| Hi Janos, The currently included Tiff IO code (and all other Pic code) is 8 bit only. A better interface would use libtiff for I/O but that is non-trivial due to the variety of TIFFs one encounters in the field. I once made a very simplistic 16bit TiFF reader for PDL. Somebody sufficiently knowledgeable could write a 16bit writer I suppose. Christian |
package PDL::IO::Tiff; # use strict; # strict results in trouble with barewords when using Inline :( # no strict 'vars'; our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
require PDL::Exporter;
@ISA = qw(PDL::Exporter);
# functions you want to export into the caller's name space
@EXPORT_OK = qw(rtiff16);
%EXPORT_TAGS = (Func=>[EMAIL PROTECTED]);
BEGIN { # in BEGIN to make sure we can use $VERSION in the
# 'use Inline...' call below
$VERSION = '0.10'; # Inline requires this to be a *string* that matches
# /^\d\.\d\d$/
# see Inline-FAQ for more info
}
use Inline C => Config =>
LIBS => '-ltiff';
use Inline C => DATA => # inlined C code is below in DATA section
NAME => PDL::IO::Tiff, # required info for module installation
VERSION => $VERSION; # ditto, see Inline-FAQ for more info
# quirk 2 follows
Inline->init; # you need this if you want to 'use' your module
# from within perldl and your inlined code resides
# in the DATA section (as in this example)
use PDL::LiteF;
use PDL::Types;
use PDL::NiceSlice;
sub PDL::mkmypiddle {
my ($class,$datar,$wx,$wy) = @_;
my $pdl = $class->new;
$pdl->set_datatype($PDL_US);
my @dims = ($wx,$wy);
$pdl->setdims([EMAIL PROTECTED]);
my $dref = $pdl->get_dataref();
$$dref = $$datar;
$pdl->upd_data();
return $pdl;
}
use Carp;
sub rtiff16 {
my ($file) = @_;
croak "can't find tiff file $file" unless -f $file;
my ($data,$wx,$wy) = open_tiff16($file);
my $pdl = PDL->mkmypiddle(\$data,$wx,$wy);
return $pdl;
}
1;
__DATA__
__C__
#include "tiffio.h"
#define IODEBUG 0
#define IFDEBUG(a) if (IODEBUG) a
void open_tiff16(char *imgfile)
{
TIFF* tif;
uint16 bps = 0, spp = 0, photomet = 0;
tdata_t buf;
uint32 rows, cols, col, row;
ushort *img = NULL, *imp;
uint16 *bufp;
SV *data, *wx, *wy;
Inline_Stack_Vars;
data = &PL_sv_undef;
tif = TIFFOpen(imgfile,"r");
if (!tif)
croak("TIFFOpen: can't open file '%s'",imgfile);
if ( ! TIFFGetField( tif, TIFFTAG_BITSPERSAMPLE, &bps ) )
bps = 1;
if ( ! TIFFGetField( tif, TIFFTAG_SAMPLESPERPIXEL, &spp ) )
spp = 1;
if ( ! TIFFGetField( tif, TIFFTAG_PHOTOMETRIC, &photomet ) )
photomet = -1;
TIFFGetField(tif, TIFFTAG_IMAGELENGTH, &rows);
TIFFGetField(tif, TIFFTAG_IMAGEWIDTH, &cols );
if (bps == 16) {
img = malloc(rows*cols*sizeof(ushort));
IFDEBUG(printf("allocated %d bytes\n",rows*cols*sizeof(ushort)));
} else {
croak("can only open 16bit image files, got %u",bps);
}
if (spp != 1) {
croak("can only deal with 1 spp, got %u",spp);
}
buf = _TIFFmalloc(TIFFScanlineSize(tif));
imp = img;
IFDEBUG(printf(
"Bits per sample: %u, Samples per pixel: %u, Photometric: %u\n",
bps,spp,photomet));
IFDEBUG(printf("Rows: %u, Scanline size: %d\n",
rows,TIFFScanlineSize(tif)));
for (row = 0; row < rows; row++) {
TIFFReadScanline(tif, buf, row, 0);
if (img) {
bufp = (uint16 *) buf;
for (col=0;col<cols;col++)
*imp++ = *bufp++;
}
}
_TIFFfree(buf);
if (img) {
data = newSVpv((char *) img, rows*cols*sizeof(ushort));
free(img);
}
TIFFClose(tif);
wx = newSViv(cols);
wy = newSViv(rows);
Inline_Stack_Reset;
Inline_Stack_Push(sv_2mortal(data));
Inline_Stack_Push(sv_2mortal(wx));
Inline_Stack_Push(sv_2mortal(wy));
Inline_Stack_Done;
}
On 13/12/2007, at 6:34 AM, János Gonzales wrote:
-- Christian Soeller PhD Dept. of Physiology +64 9 3737599 x82770 University of Auckland Auckland, New Zealand fax +64 9 3737499 |
_______________________________________________ Perldl mailing list [email protected] http://mailman.jach.hawaii.edu/mailman/listinfo/perldl
