/pliant/graphic/filter/packed.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  module "/pliant/language/stream.pli" 
 3  module "/pliant/language/stream/filesystembase.pli" 
 4  module "/pliant/util/encoding/pack4.pli" 
 5  module "/pliant/graphic/filter/prototype.pli" 
 6  module "/pliant/graphic/color/gamut.pli" 
 7   
 8   
 9  constant default_tile_x 512 
 10  constant default_tile_y 16 
 11   
 12   
 13  type ImageReadFilterPacked 
 14    field Stream stream 
 15    field Int size_x size_y pixel_size 
 16    field Int tile_x tile_y 
 17    field CBool plan 
 18    field Array:Address lines 
 19    field Address cbuf 
 20    field Int y 
 21   
 22  ImageReadFilter maybe ImageReadFilterPacked 
 23   
 24   
 25  method f open stream options h -> status 
 26    arg_rw ImageReadFilterPacked f ; arg_rw Stream stream ; arg Str options ; arg_w ImagePrototype h ; arg ExtendedStatus status 
 27    f:stream open "gzip:" "" in+safe pliant_default_file_system stream 
 28    if f:stream=failure 
 29      return (failure "Failed to open gzip stream" 
 30    if f:stream:readline<>"pliant image packed" 
 31      return failure 
 32    plan := false 
 33    options := "" 
 34    var Str gamut_name 
 35    while { var Str := f:stream readline ; l<>"" } 
 36      parse word:"x0" h:x0 
 37      parse word:"y0" h:y0 
 38      parse word:"x1" h:x1 
 39      parse word:"y1" h:y1 
 40      parse word:"size_x" h:size_x 
 41      parse word:"size_y" h:size_y 
 42      parse word:"gamut" gamut_name 
 43      parse word:"tile_x" f:tile_x 
 44      parse word:"tile_y" f:tile_y 
 45      if l="plan" 
 46        plan := true 
 47      parse word:"options" h:options 
 48    gamut :> color_gamut gamut_name 
 49    complete 
 50    size_x := size_x 
 51    size_y := size_y 
 52    pixel_size := pixel_size 
 53    f:lines size := f:tile_y 
 54    for (var Int i) f:tile_y-1 
 55      f:lines := memory_allocate h:line_size addressof:f 
 56    cbuf := memory_allocate 2*f:tile_x*f:tile_y*f:pixel_size addressof:f 
 57    := 0 
 58    status := success 
 59   
 60  method f readline adr -> status 
 61    arg_rw ImageReadFilterPacked f ; arg Address adr ; arg Status status 
 62    if f:y%f:tile_y=0 
 63      var Int tile_y := min f:size_y-f:f:tile_y 
 64      for (var Int x) f:size_x-1 step f:tile_x 
 65        var Int tile_x := min f:size_x-f:tile_x 
 66        f:stream raw_read addressof:(var Int32 csize) Int32:size 
 67        f:stream raw_read f:cbuf csize 
 68        if f:plan 
 69          var Int offset := 0 
 70          for (var Int c) f:pixel_size-1 
 71            for (var Int i) tile_y-1 
 72              var Address previous := null 
 73              if i>0 
 74                previous := f:lines:(i-1) translate Byte x*f:pixel_size+c 
 75              offset += pack4_plan_decode (f:cbuf translate Byte offset) (f:lines:translate Byte x*f:pixel_size+c) f:pixel_size tile_x previous 
 76        else 
 77          var Int offset := 0 
 78          for (var Int i) tile_y-1 
 79            var Address previous := null 
 80            if i>0 
 81              previous := f:lines:(i-1) translate Byte x*f:pixel_size 
 82            offset += pack4_decode (f:cbuf translate Byte offset) (f:lines:translate Byte x*f:pixel_size) f:pixel_size tile_x previous 
 83    memory_copy f:lines:(f:y%f:tile_y) adr f:size_x*f:pixel_size 
 84    += 1 
 85    status := success 
 86   
 87  method f close -> status 
 88    arg_rw ImageReadFilterPacked f ; arg ExtendedStatus status 
 89    f:stream close 
 90    for (var Int i) f:lines:size-1 
 91      memory_free f:lines:i 
 92    memory_free f:cbuf 
 93    status := success 
 94   
 95   
 96 
 
 97   
 98   
 99  type ImageWriteFilterPacked 
 100    field Stream stream 
 101    field Int size_x size_y pixel_size 
 102    field Int tile_x tile_y 
 103    field CBool plan 
 104    field Array:Address lines 
 105    field Address cbuf 
 106    field Int base_y y 
 107   
 108  ImageWriteFilter maybe ImageWriteFilterPacked 
 109   
 110   
 111  method f open stream options h -> status 
 112    arg_rw ImageWriteFilterPacked f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status 
 113    f:stream open "gzip:" options out+safe pliant_default_file_system stream 
 114    if f:stream=failure 
 115      return (failure "Failed to open gzip stream" 
 116    size_x := size_x 
 117    size_y := size_y 
 118    pixel_size := pixel_size 
 119    tile_x := options option "tile_x" Int (min h:size_x default_tile_x) 
 120    tile_y := options option "tile_y" Int (min h:size_y default_tile_y) 
 121    plan := options option "plan" 
 122    f:lines size := f:tile_y 
 123    for (var Int i) f:tile_y-1 
 124      f:lines := memory_allocate h:line_size addressof:f 
 125    cbuf := memory_allocate 2*f:tile_x*f:tile_y*f:pixel_size addressof:f 
 126    f:stream writeline "pliant image packed" 
 127    f:stream writeline "x0 "+(string h:x0) 
 128    f:stream writeline "y0 "+(string h:y0) 
 129    f:stream writeline "x1 "+(string h:x1) 
 130    f:stream writeline "y1 "+(string h:y1) 
 131    f:stream writeline "size_x "+(string h:size_x) 
 132    f:stream writeline "size_y "+(string h:size_y) 
 133    f:stream writeline "tile_x "+(string f:tile_x) 
 134    f:stream writeline "tile_y "+(string f:tile_y) 
 135    if f:plan 
 136      f:stream writeline "plan" 
 137    f:stream writeline "gamut "+(string h:gamut:name) 
 138    f:stream writeline "pixel_size "+(string h:gamut:pixel_size) 
 139    if h:options<>"" 
 140      f:stream writeline "options "+(string h:options) 
 141    f:stream writeline "" 
 142    base_y := 0 ; := 0 
 143    status := success 
 144   
 145  method f writeline adr -> status 
 146    arg_rw ImageWriteFilterPacked f ; arg Address adr ; arg Status status 
 147    memory_copy adr f:lines:(f:y%f:tile_y) f:size_x*f:pixel_size 
 148    += 1 
 149    if f:y%f:tile_y=or f:y=f:size_y 
 150      var Int tile_y := f:y-f:base_y 
 151      for (var Int x) f:size_x-1 step f:tile_x 
 152        var Int tile_x := min f:size_x-f:tile_x 
 153        if f:plan 
 154          var Int32 csize := 0 
 155          for (var Int c) f:pixel_size-1 
 156            for (var Int i) tile_y-1 
 157              var Address previous := null 
 158              if i>0 
 159                previous := f:lines:(i-1) translate Byte x*f:pixel_size+c 
 160              csize += pack4_plan_encode (f:lines:translate Byte x*f:pixel_size+c) (f:cbuf translate Byte csize) f:pixel_size tile_x previous 
 161        else 
 162          var Int32 csize := 0 
 163          for (var Int i) tile_y-1 
 164            var Address previous := null 
 165            if i>0 
 166              previous := f:lines:(i-1) translate Byte x*f:pixel_size 
 167            csize += pack4_encode (f:lines:translate Byte x*f:pixel_size) (f:cbuf translate Byte csize) f:pixel_size tile_x previous 
 168        f:stream raw_write addressof:csize Int32:size 
 169        f:stream raw_write f:cbuf csize 
 170      base_y := y 
 171    status := shunt f:stream=success success failure 
 172   
 173  method f close -> status 
 174    arg_rw ImageWriteFilterPacked f ; arg ExtendedStatus status 
 175    f:stream close 
 176    for (var Int i) f:lines:size-1 
 177      memory_free f:lines:i 
 178    memory_free f:cbuf 
 179    status := success 
 180   
 181  image_record_filters ".packed" ImageReadFilterPacked false ImageWriteFilterPacked false 
 182   
 183   
 184