Patch title: Release 85 bulk changes
Abstract:
File: /pliant/graphic/image/packed.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
submodule "prototype.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/util/encoding/pack4.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/misc/int.pli"


method p fast_save filename -> status
  oarg_rw ImagePacked p ; arg Str filename ; arg Status stat
  if p:disk
    return failure
  while p:shrink=failure
    void
  if trace
    var DateTime dt := datetime
  (var Stream s) open "gzip:"+filename+".tmp" out+safe
  if s=failure
    return failure
  file_delete filename
  s writeline "pliant image packed"
  s writeline "x0 "+(string p:x0)
  s writeline "y0 "+(string p:y0)
  s writeline "x1 "+(string p:x1)
  s writeline "y1 "+(string p:y1)
  s writeline "size_x "+(string p:size_x)
  s writeline "size_y "+(string p:size_y)
  s writeline "tile_x "+(string p:tile_x)
  s writeline "tile_y "+(string p:tile_y)
  s writeline "gamut "+(string p:gamut:name)
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
submodule "prototype.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/util/encoding/pack4.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/misc/int.pli"


method p fast_save filename -> status
  oarg_rw ImagePacked p ; arg Str filename ; arg Status stat
  if p:disk
    return failure
  while p:shrink=failure
    void
  if trace
    var DateTime dt := datetime
  (var Stream s) open "gzip:"+filename+".tmp" out+safe
  if s=failure
    return failure
  file_delete filename
  s writeline "pliant image packed"
  s writeline "x0 "+(string p:x0)
  s writeline "y0 "+(string p:y0)
  s writeline "x1 "+(string p:x1)
  s writeline "y1 "+(string p:y1)
  s writeline "size_x "+(string p:size_x)
  s writeline "size_y "+(string p:size_y)
  s writeline "tile_x "+(string p:tile_x)
  s writeline "tile_y "+(string p:tile_y)
  s writeline "gamut "+(string p:gamut:name)
  s writeline "pixel_size "+(string p:gamut:pixel_size)
  if p:options<>""
    s writeline "options "+(string p:options)
  s writeline ""
  for (var Int i) 0 p:nb_x*p:nb_y-1
    var Pointer:PackedTile t :> p:tiles i
    t:sem request
    var Int32 csize := t packed_size ; s raw_write addressof
    s raw_write t:packed csize
    t:sem release
  if s:close=failure
    file_delete filename+".tmp"
    return failure
  status := file_move filename+".tmp" filename
  if trace
    console "saved " filename " in " (cast datetime:seconds-


method p fast_load filename options -> status
  oarg_rw ImagePacked p ; arg Str filename ; arg Str options
  if trace
    var DateTime dt := datetime
  (var Stream s) open "gzip:"+filename in+safe
  if s=failure
    return failure
  if s:readline<>"pliant image packed"
    return failure
  var ImagePrototype proto 
  while { var Str l := s readline ; l<>"" }
    l parse word:"x0" proto:x0
    l parse word:"y0" proto:y0
    l parse word:"x1" proto:x1
    l parse word:"y1" proto:y1
    l parse word:"size_x" proto:size_x
    l parse word:"size_y" proto:size_y
    l parse word:"tile_x" (var Int tile_x)
    l parse word:"tile_y" (var Int tile_y)
    l parse word:"gamut" (var Str gamut_name)
  s writeline ""
  for (var Int i) 0 p:nb_x*p:nb_y-1
    var Pointer:PackedTile t :> p:tiles i
    t:sem request
    var Int32 csize := t packed_size ; s raw_write addressof
    s raw_write t:packed csize
    t:sem release
  if s:close=failure
    file_delete filename+".tmp"
    return failure
  status := file_move filename+".tmp" filename
  if trace
    console "saved " filename " in " (cast datetime:seconds-


method p fast_load filename options -> status
  oarg_rw ImagePacked p ; arg Str filename ; arg Str options
  if trace
    var DateTime dt := datetime
  (var Stream s) open "gzip:"+filename in+safe
  if s=failure
    return failure
  if s:readline<>"pliant image packed"
    return failure
  var ImagePrototype proto 
  while { var Str l := s readline ; l<>"" }
    l parse word:"x0" proto:x0
    l parse word:"y0" proto:y0
    l parse word:"x1" proto:x1
    l parse word:"y1" proto:y1
    l parse word:"size_x" proto:size_x
    l parse word:"size_y" proto:size_y
    l parse word:"tile_x" (var Int tile_x)
    l parse word:"tile_y" (var Int tile_y)
    l parse word:"gamut" (var Str gamut_name)
    l parse word:"options" proto:options
  if (gamut_name search ":" -1)=(-1) and (gamut_name 0 3)<>"
    gamut_name := "pantone:"+gamut_name
  proto gamut :> color_gamut gamut_name
  if proto:gamut=failure
    return failure
  proto complete
  if (p setup proto options+" tile_x "+string:tile_x+" tile_
    return failure
  p disk := options option "disk"
  if p:disk
    if trace
      console "leave " filename " on disk" eol
    if p:disk_file=""
      p disk_file := file_temporary
    p:disk_stream open p:disk_file in+out+safe
  for (var Int i) 0 p:nb_x*p:nb_y-1
    var Pointer:PackedTile t :> p:tiles i
    s raw_read addressof:(var Int32 csize) Int32:size
    t packed_size := csize
    if p:disk
      if not ((p:disk_stream query "seek") parse t:disk_offs
        p:disk_stream error "failed to get position"
      if (raw_copy s p:disk_stream csize csize)<>csize
        p:disk_stream error "failed to copy"
    else
      t packed := memory_allocate csize addressof:p
      s raw_read t:packed csize
      p packed_size += csize
  status := s:close
  if p:disk and p:disk_stream=failure
    status := failure
  if trace
    console "loaded " filename " in " (cast datetime:seconds


export ImagePacked '. packed_size' '. shrink' '. fast_save' 
  if (gamut_name search ":" -1)=(-1) and (gamut_name 0 3)<>"
    gamut_name := "pantone:"+gamut_name
  proto gamut :> color_gamut gamut_name
  if proto:gamut=failure
    return failure
  proto complete
  if (p setup proto options+" tile_x "+string:tile_x+" tile_
    return failure
  p disk := options option "disk"
  if p:disk
    if trace
      console "leave " filename " on disk" eol
    if p:disk_file=""
      p disk_file := file_temporary
    p:disk_stream open p:disk_file in+out+safe
  for (var Int i) 0 p:nb_x*p:nb_y-1
    var Pointer:PackedTile t :> p:tiles i
    s raw_read addressof:(var Int32 csize) Int32:size
    t packed_size := csize
    if p:disk
      if not ((p:disk_stream query "seek") parse t:disk_offs
        p:disk_stream error "failed to get position"
      if (raw_copy s p:disk_stream csize csize)<>csize
        p:disk_stream error "failed to copy"
    else
      t packed := memory_allocate csize addressof:p
      s raw_read t:packed csize
      p packed_size += csize
  status := s:close
  if p:disk and p:disk_stream=failure
    status := failure
  if trace
    console "loaded " filename " in " (cast datetime:seconds


export ImagePacked '. packed_size' '. shrink' '. fast_save'