Patch title: Release 94 bulk changes
Abstract:
File: /pliant/appli/photo/load.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/admin/file.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/lazy.pli"
module "/pliant/graphic/image/resampling.pli"
module "/pliant/graphic/image/antialiasing.pli"
module "/pliant/graphic/image/rotate.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/image/convert.pli"
module "/pliant/graphic/filter/io.pli"
module "jpeg.pli"


function photo_load filename options photo -> status
  arg Str filename ; arg_w Link:ImagePrototype photo ; arg S
  photo :> new ImagePixmap
  status := photo load filename "resolution 25.4"
  if status=failure
    photo :> null map ImagePrototype
    return
  if photo:gamut:name<>"rgb"
    var Link:ImageConvert conv :> new ImageConvert
    status := conv bind photo color_gamut:"rgb" ""
    if status=success
      photo :> conv
  var Str comment := jpeg_get_comment filename
  var Str commands := options
  if not (options option "reset")
    commands += " "+comment
  commands := replace commands "temperature" "source_tempera
  commands := replace commands "orthogonal" "source_orthogon
  if ((commands (commands option_position "crop" 0) commands
    void
  else
    x0 := photo x0 ; y0 := photo y0 ; x1 := photo x1 ; y1 :=
  if ((commands option "rotate_left") or (commands option "r
    var Link:ImageRotate rotate :> new ImageRotate
    rotate bind photo commands
    photo :> rotate
    swap x0 y0 ; swap x1 y1
    if (commands option "rotate_left")
      swap y0 y1
    if (commands option "rotate_right")
      swap x0 x1
  if ((commands (commands option_position "dimension" 0) com
    var Float scale := min mm_x/(abs x1-x0) mm_y/(abs y1-y0)
    photo x0 *= scale ; photo y0 *= scale ; photo x1 *= scal
    x0 *= scale ; y0 *= scale ; x1 *= scale ; y1 *= scale
  var Int size_x size_y
  if ((commands (commands option_position "resolution" 0) co
    size_x := cast (abs x1-x0)/25.4*dpi_x-0.5 Int
    size_y := cast (abs y1-y0)/25.4*dpi_y-0.5 Int
    x1 := x0+size_x/(dpi_x/25.4)*((x1-x0)/(abs x1-x0))
    y1 := y0+size_y/(dpi_y/25.4)*((y1-y0)/(abs y1-y0))
  else
    if ((commands (commands option_position "resample" 0) co
      void
    else
      size_x := photo size_x ; size_y := photo size_y
    var Float r := min size_x/(abs x1-x0) size_y/(abs y1-y0)
    if not (commands option "stretch")
      r := min r (min photo:size_x/(abs photo:x1-photo:x0) p
    size_x := cast (abs x1-x0)*r Int
    size_y := cast (abs y1-y0)*r Int
  if x0<(min photo:x0 photo:x1) or y0<(min photo:y0 photo:y1
    photo :> null map ImagePrototype
    return failure:"crop area crosses photo boundaries"
  if size_x<1 or size_y<1
    photo :> null map ImagePrototype
    return failure:"final image has null or negative size"
  if not ((options (options option_position "antialiasing" 0
    aa_x := 1 ; aa_y := 1
  if x0<>photo:x0 or y0<>photo:y0 or x1<>photo:x1 or y1<>pho
    var Link:ImageResampling rs :> new ImageResampling
    rs bind photo x0 y0 x1 y1 size_x*aa_x size_y*aa_y
    photo :> rs
  if aa_x<>1 or aa_y<>1
    var Link:ImageAntiAliasing antialiasing :> new ImageAnti
    antialiasing bind photo aa_x aa_y
    photo :> antialiasing
  if not (commands option "no_correction")
    var Link:ImageConvert conv :> new ImageConvert
module "/pliant/language/unsafe.pli"
module "/pliant/admin/file.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/lazy.pli"
module "/pliant/graphic/image/resampling.pli"
module "/pliant/graphic/image/antialiasing.pli"
module "/pliant/graphic/image/rotate.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/image/convert.pli"
module "/pliant/graphic/filter/io.pli"
module "jpeg.pli"


function photo_load filename options photo -> status
  arg Str filename ; arg_w Link:ImagePrototype photo ; arg S
  photo :> new ImagePixmap
  status := photo load filename "resolution 25.4"
  if status=failure
    photo :> null map ImagePrototype
    return
  if photo:gamut:name<>"rgb"
    var Link:ImageConvert conv :> new ImageConvert
    status := conv bind photo color_gamut:"rgb" ""
    if status=success
      photo :> conv
  var Str comment := jpeg_get_comment filename
  var Str commands := options
  if not (options option "reset")
    commands += " "+comment
  commands := replace commands "temperature" "source_tempera
  commands := replace commands "orthogonal" "source_orthogon
  if ((commands (commands option_position "crop" 0) commands
    void
  else
    x0 := photo x0 ; y0 := photo y0 ; x1 := photo x1 ; y1 :=
  if ((commands option "rotate_left") or (commands option "r
    var Link:ImageRotate rotate :> new ImageRotate
    rotate bind photo commands
    photo :> rotate
    swap x0 y0 ; swap x1 y1
    if (commands option "rotate_left")
      swap y0 y1
    if (commands option "rotate_right")
      swap x0 x1
  if ((commands (commands option_position "dimension" 0) com
    var Float scale := min mm_x/(abs x1-x0) mm_y/(abs y1-y0)
    photo x0 *= scale ; photo y0 *= scale ; photo x1 *= scal
    x0 *= scale ; y0 *= scale ; x1 *= scale ; y1 *= scale
  var Int size_x size_y
  if ((commands (commands option_position "resolution" 0) co
    size_x := cast (abs x1-x0)/25.4*dpi_x-0.5 Int
    size_y := cast (abs y1-y0)/25.4*dpi_y-0.5 Int
    x1 := x0+size_x/(dpi_x/25.4)*((x1-x0)/(abs x1-x0))
    y1 := y0+size_y/(dpi_y/25.4)*((y1-y0)/(abs y1-y0))
  else
    if ((commands (commands option_position "resample" 0) co
      void
    else
      size_x := photo size_x ; size_y := photo size_y
    var Float r := min size_x/(abs x1-x0) size_y/(abs y1-y0)
    if not (commands option "stretch")
      r := min r (min photo:size_x/(abs photo:x1-photo:x0) p
    size_x := cast (abs x1-x0)*r Int
    size_y := cast (abs y1-y0)*r Int
  if x0<(min photo:x0 photo:x1) or y0<(min photo:y0 photo:y1
    photo :> null map ImagePrototype
    return failure:"crop area crosses photo boundaries"
  if size_x<1 or size_y<1
    photo :> null map ImagePrototype
    return failure:"final image has null or negative size"
  if not ((options (options option_position "antialiasing" 0
    aa_x := 1 ; aa_y := 1
  if x0<>photo:x0 or y0<>photo:y0 or x1<>photo:x1 or y1<>pho
    var Link:ImageResampling rs :> new ImageResampling
    rs bind photo x0 y0 x1 y1 size_x*aa_x size_y*aa_y
    photo :> rs
  if aa_x<>1 or aa_y<>1
    var Link:ImageAntiAliasing antialiasing :> new ImageAnti
    antialiasing bind photo aa_x aa_y
    photo :> antialiasing
  if not (commands option "no_correction")
    var Link:ImageConvert conv :> new ImageConvert
    status := conv bind photo (color_gamut "rgb" commands) c
    status := conv bind photo (color_gamut "rgb" "convert_adjust "+string:commands) commands
    if status=failure
      return
    photo :> conv



export photo_load photo_cache
    if status=failure
      return
    photo :> conv



export photo_load photo_cache