Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/filter/tiff.pli
Key:
    Removed line
    Added line
   
module "/pliant/graphic/filter/prototype.pli"
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"

constant tifflib "libtiff.so.4"

public

  function TIFFOpen name mode -> handle
    arg CStr name mode ; arg Address handle
    external tifflib "TIFFOpen"
  
  function TIFFGetField handle tag value
    arg Address handle ; arg Int tag ; arg_w Int value
    external tifflib "TIFFGetField"
  
  function TIFFScanlineSize handle -> size
    arg Address handle ; arg Int size
    external tifflib "TIFFScanlineSize"
  
  function TIFFReadScanline handle buf row plan -> err
    arg Address handle ; arg Address buf ; arg Int row plan ; arg Int err
    external tifflib "TIFFReadScanline"
    # err=1 means ok, err=(-1) means error

  function TIFFClose handle
    arg Address handle
    external tifflib "TIFFClose"


#-------------------------------------------------------------------------


method s write16 v
  arg_rw Stream s ; arg Int v
  var uInt16_li v16 := v ; s raw_write addressof:v16 uInt16_li:size

method s write32 v
  arg_rw Stream s ; arg Int v
  var uInt32_li v32 := v ; s raw_write addressof:v32 uInt32_li:size

method s tiff_field tag type_ count value
  arg_rw Stream s ; arg Int tag type_ count ; arg Int value
  s write16 tag
  s write16 type_
  s write32 count
  s write32 value

function write_tiff_header options s
  arg Str options ; arg_rw Stream s
  constant nb 8
  s write16 4949h # low_indian
  s write16 2Ah
  s write32 8
  s write16 nb # nb fields
  var Int offset := 8+2+nb*12+4
  # console "initial offset is " offset eol
  var CBool rgb := (options option "line_size" Int)=3*(options option "size_x" Int)
  s tiff_field 256 4 1 (options option "size_x" Int 1)
  s tiff_field 257 4 1 (options option "size_y" Int 1)
  if rgb
    s tiff_field 258 3 3 offset ; offset += 3*uInt16:size
  else
    s tiff_field 258 3 1 (options option "bpc" Int)
  s tiff_field 259 3 1 (options option "compression" Int 1) # compression
  s tiff_field 262 3 1 (shunt rgb 2 1) # color model
  s tiff_field 273 4 1 offset # bitmap offset 
  s tiff_field 277 3 1 (shunt rgb 3 1) # nb components
  s tiff_field 279 4 1 (options option "size" Int) # bitmap length
  s write32 0
  # console "final offset is " (s query "seek") eol
  if rgb
    s write16 8 ; s write16 8 ; s write16 8
  
export write_tiff_header


#-------------------------------------------------------------------------


type ImageReadFilterTiff
  field Str temp
  field Address handle
  field Int current_y

ImageReadFilter maybe ImageReadFilterTiff


method f open stream options h -> status
  arg_rw ImageReadFilterTiff f ; arg_rw Stream stream ; arg Str options ; arg_w ImagePrototype h ; arg ExtendedStatus status
  f temp := file_temporary
  (var Stream tmp) open f:temp out+safe
  if (options option "write_tiff_header")
    write_tiff_header options tmp
  while (raw_copy stream tmp 1 2^24)<>0
    void
  tmp close
  f handle := TIFFOpen (file_os_name f:temp) "rb"
  if f:handle=null
    file_delete f:temp
    return failure:"not a TIFF image"
  TIFFGetField f:handle 256 (var Int i) ; h size_x := i
  TIFFGetField f:handle 257 (var Int i) ; h size_y := i
  TIFFGetField f:handle 258 (var Int bpp)
  f current_y := 0
  status := success

method f readline adr -> status
  arg_rw ImageReadFilterTiff f ; arg Address adr ; arg Status status
  TIFFReadScanline f:handle adr f:current_y 0
  f current_y += 1
  status := success

method f close -> status
  arg_rw ImageReadFilterTiff f ; arg ExtendedStatus status
  TIFFClose f:handle
  file_delete f:temp
  status := success


image_record_filters ".tiff" ImageReadFilterTiff true Void false