Patch title: Release 85 bulk changes
Abstract:
File: /pliant/graphic/filter/packed.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/util/encoding/pack4.pli"
module "/pliant/graphic/filter/prototype.pli"
module "/pliant/graphic/color/gamut.pli"


constant default_tile_x 512
constant default_tile_y 16


type ImageReadFilterPacked
  field Stream stream
  field Int size_x size_y pixel_size
  field Int tile_x tile_y
  field Array:Address lines
  field Address cbuf
  field Int y

ImageReadFilter maybe ImageReadFilterPacked


method f open stream options h -> status
  arg_rw ImageReadFilterPacked f ; arg_rw Stream stream ; arg Str options ; arg_w ImagePrototype h ; arg ExtendedStatus status
  f:stream open "gzip:" "" in+safe pliant_default_file_system stream
  if f:stream=failure
    return (failure "Failed to open gzip stream") 
  if f:stream:readline<>"pliant image packed"
    return failure
  h options := ""
  var Str gamut_name
  while { var Str l := f:stream readline ; l<>"" }
    l parse word:"x0" h:x0
    l parse word:"y0" h:y0
    l parse word:"x1" h:x1
    l parse word:"y1" h:y1
    l parse word:"size_x" h:size_x
    l parse word:"size_y" h:size_y
    l parse word:"gamut" gamut_name
    l parse word:"tile_x" f:tile_x
    l parse word:"tile_y" f:tile_y
    l parse word:"options" h:options
  h gamut :> color_gamut gamut_name
  h complete
  f size_x := h size_x
  f size_y := h size_y
  f pixel_size := h pixel_size
  f:lines size := f:tile_y
  for (var Int i) 0 f:tile_y-1
    f:lines i := memory_allocate h:line_size addressof:f
  f cbuf := memory_allocate 2*f:tile_x*f:tile_y*f:pixel_size addressof:f
  f y := 0
  status := success

method f readline adr -> status
  arg_rw ImageReadFilterPacked f ; arg Address adr ; arg Status status
  if f:y%f:tile_y=0
    var Int tile_y := min f:size_y-f:y f:tile_y
    for (var Int x) 0 f:size_x-1 step f:tile_x
      var Int tile_x := min f:size_x-x f:tile_x
      f:stream raw_read addressof:(var Int32 csize) Int32:size
      f:stream raw_read f:cbuf csize
      var Int offset := 0
      for (var Int i) 0 tile_y-1
        var Address previous := null
        if i>0
          previous := f:lines:(i-1) translate Byte x*f:pixel_size
        offset += pack4_decode (f:cbuf translate Byte offset) (f:lines:i translate Byte x*f:pixel_size) f:pixel_size tile_x previous
  memory_copy f:lines:(f:y%f:tile_y) adr f:size_x*f:pixel_size
  f y += 1
  status := success

method f close -> status
  arg_rw ImageReadFilterPacked f ; arg ExtendedStatus status
  f:stream close
  for (var Int i) 0 f:lines:size-1
    memory_free f:lines:i
  memory_free f:cbuf
  status := success


#-------------------------------------------------------------------------


type ImageWriteFilterPacked
  field Stream stream
  field Int size_x size_y pixel_size
  field Int tile_x tile_y
  field Array:Address lines
  field Address cbuf
  field Int base_y y

ImageWriteFilter maybe ImageWriteFilterPacked


method f open stream options h -> status
  arg_rw ImageWriteFilterPacked f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
  f:stream open "gzip:" options out+safe pliant_default_file_system stream
  if f:stream=failure
    return (failure "Failed to open gzip stream") 
  f size_x := h size_x
  f size_y := h size_y
  f pixel_size := h pixel_size
  f tile_x := options option "tile_x" Int
  if f:tile_x=undefined
    f tile_x := min h:size_x default_tile_x
  f tile_y := options option "tile_y" Int
  if f:tile_y=undefined
    f tile_y := min h:size_y default_tile_y
  f:lines size := f:tile_y
  for (var Int i) 0 f:tile_y-1
    f:lines i := memory_allocate h:line_size addressof:f
  f cbuf := memory_allocate 2*f:tile_x*f:tile_y*f:pixel_size addressof:f
  f:stream writeline "pliant image packed"
  f:stream writeline "x0 "+(string h:x0)
  f:stream writeline "y0 "+(string h:y0)
  f:stream writeline "x1 "+(string h:x1)
  f:stream writeline "y1 "+(string h:y1)
  f:stream writeline "size_x "+(string h:size_x)
  f:stream writeline "size_y "+(string h:size_y)
  f:stream writeline "tile_x "+(string f:tile_x)
  f:stream writeline "tile_y "+(string f:tile_y)
  f:stream writeline "gamut "+(string h:gamut:name)
  f:stream writeline "pixel_size "+(string h:gamut:pixel_size)
  if h:options<>""
    f:stream writeline "options "+(string h:options)
  f:stream writeline ""
  f base_y := 0 ; f y := 0
  status := success

method f writeline adr -> status
  arg_rw ImageWriteFilterPacked f ; arg Address adr ; arg Status status
  memory_copy adr f:lines:(f:y%f:tile_y) f:size_x*f:pixel_size
  f y += 1
  if f:y%f:tile_y=0 or f:y=f:size_y
    var Int tile_y := f:y-f:base_y
    for (var Int x) 0 f:size_x-1 step f:tile_x
      var Int tile_x := min f:size_x-x f:tile_x
      var Int32 csize := 0
      for (var Int i) 0 tile_y-1
        var Address previous := null
        if i>0
          previous := f:lines:(i-1) translate Byte x*f:pixel_size
        csize += pack4_encode (f:lines:i translate Byte x*f:pixel_size) (f:cbuf translate Byte csize) f:pixel_size tile_x previous
      f:stream raw_write addressof:csize Int32:size
      f:stream raw_write f:cbuf csize
    f base_y := f y
  status := shunt f:stream=success success failure

method f close -> status
  arg_rw ImageWriteFilterPacked f ; arg ExtendedStatus status
  f:stream close
  for (var Int i) 0 f:lines:size-1
    memory_free f:lines:i
  memory_free f:cbuf
  status := success

image_record_filters ".packed" ImageReadFilterPacked ImageWriteFilterPacked