Patch title: Release 91 bulk changes
Abstract:
File: /graphic/image/transparency.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "prototype.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/misc/mtbuffer.pli"


type ImageTransparency
  inherit ImagePrototype
  field Link:ImagePrototype image
  field MtBuffer buffers

ImagePrototype maybe ImageTransparency


method t bind image options -> status
  oarg_rw ImageTransparency t ; oarg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
  if image:gamut:pixel_size<>image:gamut:dimension
    return failure:"the underlying image must have no transparency or padding bytes"
  var Link:ColorGamut g :> color_gamut image:gamut:name+"+transparencies"
  if g=failure
    return g
  if g:pixel_size<>2*image:gamut:pixel_size
    return failure:"failed to build transparency image gamut"
  addressof:t map ImagePrototype := image_prototype image:x0 image:y0 image:x1 image:y1 image:size_x image:size_y g
  t image :> image
  t:buffers size := image line_size
  status := success


method t write x y count adr
  oarg_rw ImageTransparency t ; arg Int x y count ; arg Address adr
  var Int dim := t:gamut dimension ; var Int psize := t pixel_size
  var Address buffer := t:buffers allocate
  t:image read x y count buffer
  var Address src := adr
  var Address dest := buffer
  for (var Int i) 0 count-1
    if processor_is_low_indian
      var Int j := 0
      while j<dim
        var Int transp := (src translate Byte dim+j) map Int
        if transp=0
          j += Int size
        else
          transp := transp .and. 255
          if transp=0
            void
          eif transp=255
            dest map uInt8 j := src map uInt8 j
          else
            error error_id_missing "Partial transparency is not implemented yet"
            dest map uInt8 j := ((255-transp)*(dest map uInt8 j)+transp*(src map uInt8 j))\255
          j += 1
    else
      for (var Int j) 0 dim-1
        var uInt8 transp := src map uInt8 dim+j
        if transp=0
          void
        eif transp=255
          dest map uInt8 j := src map uInt8 j
        else
          error error_id_missing "Partial transparency is not implemented yet"
          dest map uInt8 j := ((255-transp)*(dest map uInt8 j)+transp*(src map uInt8 j))\255
    src := src translate Byte psize
    dest := dest translate Byte dim
  t:image write x y count buffer
  t:buffers free buffer


method t fill x y count pixel
  oarg_rw ImageTransparency t ; arg Int x y count ; arg Address pixel
  var Int dim := t:gamut dimension
  var Address buffer := t:buffers allocate
  t:image read x y count buffer
  for (var Int i) 0 dim-1
    var Int transp := pixel map uInt8 dim+i    
    if transp=0
      void
    eif transp=255
      var Int color := pixel map uInt8 i
      var Address a := buffer translate uInt8 i
      for (var Int j) 1 count
        a map uInt8 := color
        a := a translate uInt8 dim
    else
      error error_id_missing "Partial transparency is not implemented yet"
      var Int transp255 := 255-transp
      var Int color255 := transp*(pixel map uInt8 i)
      var Address a := buffer translate uInt8 i
      for (var Int j) 1 count
        a map uInt8 := (transp255*(a map uInt8)+color255)\255
        a := a translate uInt8 dim
  t:image write x y count buffer
  t:buffers free buffer


method t clip x0 y0 x1 y1
  oarg ImageTransparency t ; arg_rw Int x0 y0 x1 y1
  t:image clip x0 y0 x1 y1


export ImageTransparency '. bind'