Patch title: Release 90 bulk changes
Abstract:
File: /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"
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"
module "/pliant/graphic/misc/filepool.pli"


constant clip true
constant trace false
constant default_tile_x 512
constant default_tile_y 16
# so a tile is roughly (6 coulours image) 512*16*6 = 48 KB
constant minimum_clear_cache 4*2^20
constant maximum_clear_cache 16*2^20
constant advanced_thresholding false


constant trace false
constant default_tile_x 512
constant default_tile_y 16
# so a tile is roughly (6 coulours image) 512*16*6 = 48 KB
constant minimum_clear_cache 4*2^20
constant maximum_clear_cache 16*2^20
constant advanced_thresholding false



type PackedTile
  field ListNode_ clear_node
  field Address clear <- null
  field Address packed <- null
  field Int size_x size_y
  field Int packed_size <- 0
  field CBool modified <- false
  field Sem sem
type PackedTile
  field ListNode_ clear_node
  field Address clear <- null
  field Address packed <- null
  field Int size_x size_y
  field Int packed_size <- 0
  field CBool modified <- false
  field Sem sem
  field Intn disk_offset
  field Intn disk_offset <- undefined
  
function destroy t
  arg_w PackedTile t
  memory_free t:packed
  memory_free t:clear


type ImagePacked
  inherit ImagePrototype
  field Int tile_x tile_y
  field Array:PackedTile tiles ; field Int nb_x nb_y
  field Address cbuf <- null
  field Sem cbuf_sem
  field Int packed_size <- 0
  
function destroy t
  arg_w PackedTile t
  memory_free t:packed
  memory_free t:clear


type ImagePacked
  inherit ImagePrototype
  field Int tile_x tile_y
  field Array:PackedTile tiles ; field Int nb_x nb_y
  field Address cbuf <- null
  field Sem cbuf_sem
  field Int packed_size <- 0
  field Int packed_limit <- undefined
  field Int clear_size <- 0
  if advanced_thresholding
    field Int clear_threshold1 clear_threshold2
  else
    field Int clear_threshold
  field List_ clear_list
  field Sem clear_sem
  field Int clear_size <- 0
  if advanced_thresholding
    field Int clear_threshold1 clear_threshold2
  else
    field Int clear_threshold
  field List_ clear_list
  field Sem clear_sem
  field CBool disk <- false
  field Str disk_file
  field Stream disk_stream
  field Str disk_file
  field Stream disk_stream
  field FilePool disk_pool
  field Sem disk_sem
  field Sem disk_sem
  field Sem disk_shrink_sem
  if clip
    field CBool auto_clip <- false
    field Int clip_y0 clip_y1




method p disk_shrink
  arg_rw ImagePacked p
  p:disk_shrink_sem request
  if p:packed_size>p:packed_limit
    p:disk_sem request
    if p:disk_file=""
      p disk_file := file_temporary
      p:disk_stream open p:disk_file in+out+nocache
    p:disk_sem release
    for (var Int i) 0 p:tiles:size-1
      var Pointer:PackedTile t :> p:tiles i
      t:sem request
      if t:packed<>null
        if t:disk_offset=undefined
          p:disk_sem request
          t disk_offset := p:disk_pool allocate t:packed_size
          p:disk_stream configure "seek "+(string t:disk_offset)
          p:disk_stream raw_write t:packed t:packed_size
          p:disk_sem release
        memory_free t:packed ; t packed := null
        atomic_add p:packed_size -(t:packed_size)
      t:sem release
    if p:auto_clip
      p clip_y1 := p:clip_y0+(max (p:clip_y1-p:clip_y0)\2 1)
  p:disk_shrink_sem release


method p pack t
  arg_rw ImagePacked p ; arg_rw PackedTile t
  if t:modified
method p pack t
  arg_rw ImagePacked p ; arg_rw PackedTile t
  if t:modified
    if t:disk_offset<>undefined
      p:disk_sem request
      p:disk_pool free t:disk_offset t:packed_size
      t disk_offset := undefined
      p:disk_sem release
    p:cbuf_sem request
    var Int csize := 0
    for (var Int y) 0 t:size_y-1
      csize += pack4_encode (t:clear translate Byte y*t:size
    p:cbuf_sem request
    var Int csize := 0
    for (var Int y) 0 t:size_y-1
      csize += pack4_encode (t:clear translate Byte y*t:size
    memory_free t:packed
    t packed := memory_allocate csize addressof:p
    if t:packed<>null
      memory_free t:packed
      atomic_add p:packed_size -(t:packed_size)
    atomic_add p:packed_size csize
    t packed := memory_allocate csize addressof:p ; t packed_size := csize
    memory_copy p:cbuf t:packed csize
    memory_copy p:cbuf t:packed csize
    atomic_add p:packed_size csize-t:packed_size ; t packed_
    p:cbuf_sem release
  memory_free t:clear ; t clear := null
  atomic_add p:clear_size -(t:size_x*t:size_y*p:pixel_size)

method p unpack t
  arg_rw ImagePacked p ; arg_rw PackedTile t
    p:cbuf_sem release
  memory_free t:clear ; t clear := null
  atomic_add p:clear_size -(t:size_x*t:size_y*p:pixel_size)

method p unpack t
  arg_rw ImagePacked p ; arg_rw PackedTile t
  var CBool disk := p:disk and t:packed=null
  if disk
  if t:packed=null and t:disk_offset<>undefined
    p:disk_sem request
    p:disk_sem request
    atomic_add p:packed_size t:packed_size
    t packed := memory_allocate t:packed_size addressof:p
    p:disk_stream configure "seek "+(string t:disk_offset)
    p:disk_stream raw_read t:packed t:packed_size
    t packed := memory_allocate t:packed_size addressof:p
    p:disk_stream configure "seek "+(string t:disk_offset)
    p:disk_stream raw_read t:packed t:packed_size
    p:disk_sem release
  if t:packed<>null
    t clear := memory_allocate t:size_x*t:size_y*p:pixel_siz
    var Int csize := 0
    for (var Int y) 0 t:size_y-1
      csize += pack4_decode (t:packed translate Byte csize) 
  else
    t clear := memory_zallocate t:size_x*t:size_y*p:pixel_si
  if t:packed<>null
    t clear := memory_allocate t:size_x*t:size_y*p:pixel_siz
    var Int csize := 0
    for (var Int y) 0 t:size_y-1
      csize += pack4_decode (t:packed translate Byte csize) 
  else
    t clear := memory_zallocate t:size_x*t:size_y*p:pixel_si
  if disk
    memory_free t:packed ; t packed := null
    p:disk_sem release
  t modified := false
  atomic_add p:clear_size t:size_x*t:size_y*p:pixel_size


method p setup proto options -> status
  arg_rw ImagePacked p ; arg ImagePrototype proto ; arg Str 
  t modified := false
  atomic_add p:clear_size t:size_x*t:size_y*p:pixel_size


method p setup proto options -> status
  arg_rw ImagePacked p ; arg ImagePrototype proto ; arg Str 
  check proto:size_x>0 and proto:size_y>0
  memory_free p:cbuf
  addressof:p map ImagePrototype := proto
  p tile_x := options option "tile_x" Int (min p:size_x defa
  p tile_y := options option "tile_y" Int (min p:size_y defa
  p nb_x := (p:size_x+p:tile_x-1)\p:tile_x
  p nb_y := (p:size_y+p:tile_y-1)\p:tile_y
  if advanced_thresholding
    p clear_threshold1 := bound 2*p:tile_y*p:size_x*p:pixel_
    p clear_threshold2 := max 4*processor_count*p:tile_y*p:s
  else
  memory_free p:cbuf
  addressof:p map ImagePrototype := proto
  p tile_x := options option "tile_x" Int (min p:size_x defa
  p tile_y := options option "tile_y" Int (min p:size_y defa
  p nb_x := (p:size_x+p:tile_x-1)\p:tile_x
  p nb_y := (p:size_y+p:tile_y-1)\p:tile_y
  if advanced_thresholding
    p clear_threshold1 := bound 2*p:tile_y*p:size_x*p:pixel_
    p clear_threshold2 := max 4*processor_count*p:tile_y*p:s
  else
    p clear_threshold := bound 2*p:tile_y*p:size_x*p:pixel_s
    p clear_threshold := options option "clear_cache_size" Int (bound 2*p:tile_y*p:size_x*p:pixel_size minimum_clear_cache maximum_clear_cache)
  p:tiles size := 0
  p:tiles size := p:nb_x*p:nb_y
  for (var Int iy) 0 p:nb_y-1
    for (var Int ix) 0 p:nb_x-1
      var Pointer:PackedTile t :> p:tiles ix+iy*p:nb_x
      t size_x := min p:tile_x p:size_x-ix*p:tile_x
      t size_y := min p:tile_y p:size_y-iy*p:tile_y
  p cbuf := memory_allocate p:tile_x*p:tile_y*p:pixel_size*2
  p:tiles size := 0
  p:tiles size := p:nb_x*p:nb_y
  for (var Int iy) 0 p:nb_y-1
    for (var Int ix) 0 p:nb_x-1
      var Pointer:PackedTile t :> p:tiles ix+iy*p:nb_x
      t size_x := min p:tile_x p:size_x-ix*p:tile_x
      t size_y := min p:tile_y p:size_y-iy*p:tile_y
  p cbuf := memory_allocate p:tile_x*p:tile_y*p:pixel_size*2
  p clear_size := 0
  p packed_size := 0
  p packed_size := 0
  p clear_size := 0  
  p packed_limit := options option "packed_cache_size" Int undefined
  p disk_pool := var FilePool empty_disk_pool
  p auto_clip := false
  p clip_y0 := 0 ; p clip_y1 := p size_y
  status := success


method p read x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  status := success


method p read x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  if clip and (y<p:clip_y0 or y>=p:clip_y1)
    memory_clear adr count*p:pixel_size
    return
  if p:packed_limit<>undefined and p:packed_size>p:packed_limit
    p disk_shrink
  var Int xx := x
  while xx<x+count
    var Pointer:PackedTile t :> p tile_map xx y (var Int off
    var Int step := min x+count-xx t:size_x-offset_x
    memory_copy (t:clear translate Byte (offset_x+offset_y*t
    t:sem rd_release
    xx += step

  var Int xx := x
  while xx<x+count
    var Pointer:PackedTile t :> p tile_map xx y (var Int off
    var Int step := min x+count-xx t:size_x-offset_x
    memory_copy (t:clear translate Byte (offset_x+offset_y*t
    t:sem rd_release
    xx += step


method p write x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
method p write x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  if clip and (y<p:clip_y0 or y>=p:clip_y1)
    return
  if p:packed_limit<>undefined and p:packed_size>p:packed_limit
    p disk_shrink
  var Int xx := x
  while xx<x+count
    var Pointer:PackedTile t :> p tile_map xx y (var Int off
    var Int step := min x+count-xx t:size_x-offset_x
    memory_copy (adr translate Byte (xx-x)*p:pixel_size) (t:
    t modified := true
    t:sem rd_release
    xx += step


method p read_map x y mini maxi count -> adr
  arg_rw ImagePacked p ; arg Int x y mini maxi ; arg_w Int c
  check mini>0 and maxi>=mini and x>=0 and count>=0 and x+ma
  var Int xx := x
  while xx<x+count
    var Pointer:PackedTile t :> p tile_map xx y (var Int off
    var Int step := min x+count-xx t:size_x-offset_x
    memory_copy (adr translate Byte (xx-x)*p:pixel_size) (t:
    t modified := true
    t:sem rd_release
    xx += step


method p read_map x y mini maxi count -> adr
  arg_rw ImagePacked p ; arg Int x y mini maxi ; arg_w Int c
  check mini>0 and maxi>=mini and x>=0 and count>=0 and x+ma
  if mini>p:tile_x
  if mini>p:tile_x or (clip and (y<p:clip_y0 or y>=p:clip_y1))
    return null
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  count := t:size_x-offset_x
  if count>=mini
    count := min count maxi
    adr := t:clear translate Byte (offset_x+offset_y*t:size_
  else
    t:sem rd_release
    adr := null
    
method p read_unmap x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  t:sem rd_release
  t:sem rd_release
  

method p write_map x y mini maxi count -> adr
  arg_rw ImagePacked p ; arg Int x y mini maxi ; arg_w Int c
    return null
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  count := t:size_x-offset_x
  if count>=mini
    count := min count maxi
    adr := t:clear translate Byte (offset_x+offset_y*t:size_
  else
    t:sem rd_release
    adr := null
    
method p read_unmap x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  t:sem rd_release
  t:sem rd_release
  

method p write_map x y mini maxi count -> adr
  arg_rw ImagePacked p ; arg Int x y mini maxi ; arg_w Int c
  check mini>0 and maxi>=mini and x>=0 and count>=0 and x+ma
  if mini>p:tile_x
  check mini>0 and maxi>=mini and x>=0 and x+maxi<=p:size_x and y>=0 and y<p:size_y
  if mini>p:tile_x or (clip and (y<p:clip_y0 or y>=p:clip_y1))
    return null
    return null
  if p:packed_limit<>undefined and p:packed_size>p:packed_limit
    p disk_shrink
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  count := t:size_x-offset_x
  if count>=mini
    count := min count maxi
    adr := t:clear translate Byte (offset_x+offset_y*t:size_
    t modified := true
  else
    t:sem rd_release
    adr := null
    
method p write_unmap x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  t:sem rd_release
  t:sem rd_release
  

  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  count := t:size_x-offset_x
  if count>=mini
    count := min count maxi
    adr := t:clear translate Byte (offset_x+offset_y*t:size_
    t modified := true
  else
    t:sem rd_release
    adr := null
    
method p write_unmap x y count adr
  arg_rw ImagePacked p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and
  var Pointer:PackedTile t :> p tile_map x y (var Int offset
  t:sem rd_release
  t:sem rd_release
  

method p clip x0 y0 x1 y1
  oarg ImagePacked p ; arg_rw Int x0 y0 x1 y1
  x0 := max x0 0
  y0 := max y0 p:clip_y0
  x1 := min x1 p:size_x
  y1 := min y1 p:clip_y1


method p rectangle_read_map x y x0 y0 x1 y1 step_x step_y -> adr
  oarg_rw ImagePacked p ; arg Int x y ; arg_w Int x0 y0 x1 y1 step_x step_y ; arg Address adr
  var Pointer:PackedTile t :> p tile_map x y (var Int offset_x) (var Int offset_y)
  x0 := x-offset_x ; y0 := y-offset_y ; x1 := x0+t:size_x ; y1 := y0+t:size_y
  step_x := p pixel_size ; step_y := p:pixel_size*t:size_x
  adr := t clear

method p rectangle_read_unmap x0 y0 x1 y1 adr
  oarg_rw ImagePacked p ; arg Int x0 y0 x1 y1 ; arg Address adr
  var Pointer:PackedTile t :> p tile_map x0 y0 (var Int offset_x) (var Int offset_y)
  t:sem rd_release
  t:sem rd_release


method p recommended_draw_tile -> y
  arg ImagePacked p ; arg Int y
  y := (max p:clear_threshold\p:tile_x\p:tile_y\p:gamut:pixel_size\p:nb_x 1)*p:tile_y


method p shrink -> status
  arg_rw ImagePacked p ; arg Status status
  part shrink
    status := success
    p:clear_sem request
    var Pointer:ListNode_ ptr :> p:clear_list first
    while exists:ptr
      var Pointer:PackedTile t :> addressof:ptr map PackedTi
      if (t:sem nowait_request)
        p:clear_list remove ptr
        p:clear_sem release
        p pack t
        t:sem release
        restart shrink
      else
        status := failure
        ptr :> ptr next
    p:clear_sem release


method p fast_save filename -> status
  oarg_rw ImagePacked p ; arg Str filename ; arg Status stat
method p shrink -> status
  arg_rw ImagePacked p ; arg Status status
  part shrink
    status := success
    p:clear_sem request
    var Pointer:ListNode_ ptr :> p:clear_list first
    while exists:ptr
      var Pointer:PackedTile t :> addressof:ptr map PackedTi
      if (t:sem nowait_request)
        p:clear_list remove ptr
        p:clear_sem release
        p pack t
        t:sem release
        restart shrink
      else
        status := failure
        ptr :> ptr next
    p:clear_sem release


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
  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
    if t:packed<>null or t:disk_offset=undefined
      s raw_write t:packed csize
    else
      p:disk_sem request
      p:disk_stream configure "seek "+(string t:disk_offset)
      raw_copy p:disk_stream s csize csize
      p:disk_sem release
    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
    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_
  if (p setup proto options+" tile_x "+string:tile_x+" tile_y "+string:tile_y+(shunt (options option "disk") "packed_cache_size "+string:minimum_clear_cache ""))=failure
    return failure
    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
  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
    t packed := memory_allocate csize addressof:p
    s raw_read t:packed csize
    p packed_size += csize
  status := s close
  if trace
    console "loaded " filename " in " (cast datetime:seconds


  if trace
    console "loaded " filename " in " (cast datetime:seconds


export ImagePacked '. packed_size' '. shrink' '. fast_save' 
export ImagePacked '. packed_size' '. shrink' '. disk_shrink'
export '. fast_save' '. fast_load'
if clip
  export '. auto_clip' '. clip_y0' '. clip_y1'
  export '. recommended_draw_tile'