/pliant/graphic/image/resampling.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  submodule "prototype.pli" 
 3  module "/pliant/language/compiler/type/inherit.pli" 
 4  module "/pliant/graphic/misc/int.pli" 
 5  module "/pliant/graphic/misc/mtbuffer.pli" 
 6   
 7   
 8  type ImageResampling 
 9    inherit ImagePrototype 
 10    field Link:ImagePrototype image 
 11    field Float translate_x translate_y 
 12    field CBool same_resolution 
 13    field Array:Int xs offsets 
 14    field Float delta_x step_x delta_y step_y 
 15    field Int start_x stop_x 
 16    field MtBuffer buffers 
 17   
 18  ImagePrototype maybe ImageResampling 
 19   
 20   
 21  method r map_pixel x y xx yy 
 22    arg_rw ImageResampling r ; arg Int y ; arg_w Float xx yy 
 23    var Float mm_x := r:x0+(x+0.5)*(r:x1-r:x0)/r:size_x 
 24    mm_x -= translate_x 
 25    xx := (mm_x-r:image:x0)/(r:image:x1-r:image:x0)*r:image:size_x-0.5 
 26    var Float mm_y := r:y0+(y+0.5)*(r:y1-r:y0)/r:size_y 
 27    mm_y -= translate_y 
 28    yy := (mm_y-r:image:y0)/(r:image:y1-r:image:y0)*r:image:size_y-0.5 
 29   
 30   
 31  method r bind image x0 y0 x1 y1 size_x size_y tx ty -> status 
 32    arg_rw ImageResampling r ; arg ImagePrototype image ; arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; arg Float tx ty ; arg ExtendedStatus status 
 33    addressof:map ImagePrototype := addressof:image map ImagePrototype 
 34    x0 := x0 ; y0 := y0 ; x1 := x1 ; y1 := y1 
 35    size_x := size_x ; size_y := size_y 
 36    image :> image 
 37    translate_x := tx ; translate_y := ty 
 38    map_pixel 0 0 r:delta_x r:delta_y 
 39    map_pixel 1 1 r:step_x r:step_y ; step_x -= delta_x ; step_y -= delta_y 
 40    same_resolution := (abs (x1-x0)/size_x-(image:x1-image:x0)/image:size_x)<1e-6 and (abs (y1-y0)/size_y-(image:y1-image:y0)/image:size_y)<1e-6 
 41    r:xs size := size_x ; r:offsets size := size_x 
 42    start_x := 0 ; stop_x := r:size_x 
 43    for (var Int x) r:size_x-1 
 44      var Int ix := cast r:delta_x+x*r:step_x Int 
 45      if ix<0 
 46        if r:step_x>=0 
 47          start_x := x+1 
 48        else 
 49          stop_x := min r:stop_x 
 50      eif ix>=r:image:size_x 
 51        if r:step_x>=0 
 52          stop_x := min r:stop_x 
 53        else 
 54          start_x := x+1 
 55      else 
 56        r:xs := ix ; r:offsets := ix*image:pixel_size 
 57    r:buffers size := image line_size 
 58    status := success 
 59   
 60  method r bind image x0 y0 x1 y1 size_x size_y -> status 
 61    arg_rw ImageResampling r ; arg ImagePrototype image ; arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; arg ExtendedStatus status 
 62    status := bind image x0 y0 x1 y1 size_x size_y 0 0 
 63   
 64  method r setup image options -> status 
 65    oarg_rw ImageResampling r ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status 
 66    if not ((options (options option_position "area" 0) options:len) parse word:"area" (var Float x0) (var Float y0) (var Float x1) (var Float y1) any) 
 67      x0 := image x0 ; y0 := image y0 ; x1 := image x1 ; y1 := image y1 
 68    if not ((options (options option_position "size" 0) options:len) parse word:"size" (var Int size_x) (var Int size_y) any) 
 69      return failure:"Resampled image size not specified" 
 70    if not ((options (options option_position "translate" 0) options:len) parse word:"translate" (var Float tx) (var Float ty) any) 
 71      tx := 0 ; ty := 0 
 72    status := bind (addressof:image omap ImagePrototype) x0 y0 x1 y1 size_x size_y tx ty 
 73   
 74   
 75  method r read x y count adr 
 76    arg_rw ImageResampling r ; arg Int count ; arg Address adr 
 77    check x>=and count>=and x+count<=r:size_x and y>=and y<r:size_y 
 78    var Int iy := cast r:delta_y+y*r:step_y Int 
 79    if iy<or iy>=r:image:size_y 
 80      memory_clear adr count*r:pixel_size 
 81    eif x<r:start_x 
 82      var Int := min r:start_x-count 
 83      memory_clear adr n*r:pixel_size 
 84      if n<count 
 85        read x+count-n (adr translate Byte n*r:pixel_size) 
 86    eif x+count>r:stop_x 
 87      var Int := min x+count-r:stop_x count 
 88      memory_clear (adr translate Byte (count-n)*r:pixel_size) n*r:pixel_size 
 89      if n<count 
 90        read count-adr 
 91    else 
 92      var Address buffer := r:buffers allocate 
 93      var Int done := 0 
 94      while done<count 
 95        var Int ix0 := r:xs x+done 
 96        var Int ix1 := (r:xs x+count-1)+1 
 97        if ix1<ix0 
 98          swap ix0 ix1 
 99        var Address map := r:image read_map ix0 iy ix1-ix0 (var Int map_count) 
 100        var Address buf ; var Int step 
 101        if map<>null 
 102          buf := map translate Byte -ix0*r:pixel_size 
 103          if map_count=ix1-ix0 
 104            step := count-done 
 105          else 
 106            var Int step := bound (cast ((ix0+map_count)-r:delta_x)/r:step_x Int)-(x+done) count-done 
 107            while (r:xs x+done+step-1)>=ix0+map_count 
 108              step -= 1 
 109        else 
 110          r:image read ix0 iy ix1-ix0 (buffer translate Byte ix0*r:pixel_size) 
 111          buf := buffer ; step := count-done 
 112        if r:same_resolution 
 113          memory_copy (buf translate Byte (r:offsets x+done)) (adr translate Byte done*r:pixel_size) step*r:pixel_size 
 114        else 
 115          var Address ptr := addressof (r:offsets x+done) 
 116          var Address cur := adr translate Byte done*r:pixel_size ; var Address stop := cur translate Byte step*r:pixel_size 
 117          while cur<>stop 
 118            memory_copy (buf translate Byte (ptr map Int)) cur r:pixel_size 
 119            cur := cur translate Byte r:pixel_size 
 120            ptr := ptr translate Int 1 
 121        if map<>null 
 122          r:image read_unmap ix0 iy map_count map 
 123        done += step 
 124      r:buffers free buffer 
 125   
 126   
 127  export ImageResampling '. bind' 
 128   
 129