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"

constant advanced true

function photo_load filename options photo -> status
  arg Str filename ; arg_w Link:ImagePrototype photo ; arg Str options ; arg ExtendedStatus status
  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_temperature"
  commands := replace commands "orthogonal" "source_orthogonal"
  if ((commands (commands option_position "crop" 0) commands:len) parse word:"crop" (var Float x0) (var Float y0) (var Float x1) (var Float y1) any) and not (commands option "no_crop")
    void
  else
    x0 := photo x0 ; y0 := photo y0 ; x1 := photo x1 ; y1 := photo y1
  if ((commands option "rotate_left") or (commands option "rotate_right")) and not (commands option "no_rotate")
    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) commands:len) parse word:"dimension" (var Float mm_x) (var Float mm_y) any) or { mm_x := commands option "dimension" Float ; mm_y := mm_x ; mm_x=defined }
    var Float scale := min mm_x/(abs x1-x0) mm_y/(abs y1-y0)
    photo x0 *= scale ; photo y0 *= scale ; photo x1 *= scale ; photo y1 *= scale
    x0 *= scale ; y0 *= scale ; x1 *= scale ; y1 *= scale
  var Int size_x size_y
  if ((commands (commands option_position "resolution" 0) commands:len) parse word:"resolution" (var Float dpi_x) (var Float dpi_y) any) or { dpi_x := commands option "resolution" Float ; dpi_y := dpi_x ; dpi_x=defined }
    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) commands:len) parse word:"resample" size_x size_y any) and not (commands option "no_resample")
      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) photo:size_y/(abs photo:y1-photo:y0))
    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) or x1<(min photo:x0 photo:x1) or y1<(min photo:y0 photo:y1) or x0>(max photo:x0 photo:x1) or y0>(max photo:y0 photo:y1) or x1>(max photo:x0 photo:x1) or y1>(max 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) options:len) parse word:"antialiasing" (var Int aa_x) (var Int aa_y) any)
    aa_x := 1 ; aa_y := 1
  if x0<>photo:x0 or y0<>photo:y0 or x1<>photo:x1 or y1<>photo:y1 or size_x*aa_x<>photo:size_x or size_y*aa_y<>photo:size_y
    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 ImageAntiAliasing
    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) commands
    status := conv bind photo (color_gamut "rgb" "convert_adjust "+string:commands) commands
    if status=failure
      return
    photo :> conv


function photo_cache filename subdir format options -> cache
  arg Str filename subdir format options cache
  if subdir:len=0 or (subdir subdir:len-1)<>"/"
    error "The subdir parameter of 'photo_cache' function must end with a '/'"
  var Int i := (filename search_last "/" -1)+1
  cache := (filename 0 i)+subdir+(filename i filename:len)
  var Str comments := jpeg_get_comment filename
  if (file_query cache standard)=failure or jpeg_get_comment:cache<>comments
    if (photo_load filename options (var Link:ImagePrototype photo))=failure
      return ""
    file_tree_create cache
    if (photo save cache "filter [dq]."+format+"[dq] comment "+string:comments+" "+options)=failure
      return ""


export photo_load photo_cache