/pliant/graphic/image/sharpening.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  submodule "prototype.pli" 
 3  module "/pliant/language/compiler/type/inherit.pli" 
 4  module "/pliant/graphic/color/gamut.pli" 
 5  module "/pliant/graphic/misc/int.pli" 
 6   
 7  # FIXME: Sharpening is not burst compatible 
 8   
 9  type ImageSharpening 
 10    inherit ImagePrototype 
 11    field Link:ImagePrototype image 
 12    field Address buffer ; field Int y 
 13    field Float intensity 
 14    field ColorBuffer ground 
 15    field Array:Float32 remain 
 16    field uInt random_bits ; field Int random_available 
 17   
 18  ImagePrototype maybe ImageSharpening 
 19   
 20   
 21  function build s 
 22    arg_w ImageSharpening s 
 23    buffer := null 
 24   
 25  function destroy s 
 26    arg_w ImageSharpening s 
 27    memory_free s:buffer 
 28   
 29   
 30  method s bind image intensity -> status 
 31    arg_rw ImageSharpening s ; oarg ImagePrototype image ; arg Float intensity ; arg ExtendedStatus status 
 32    memory_free s:buffer 
 33    addressof:map ImagePrototype := addressof:image map ImagePrototype 
 34    image :> image 
 35    buffer := memory_allocate 3*(s:line_size+2*s:pixel_size) addressof:s 
 36    := undefined 
 37    intensity := intensity/20 
 38    s:remain  size := s:line_size+s:gamut:pixel_size 
 39    for (var Int i) s:remain:size-1 
 40      s:remain := 0 
 41    random_available := 0 
 42    for (var Int i) s:gamut:pixel_size-1 
 43      s:ground:bytes := shunt s:gamut:model=color_gamut_additive 255 0 
 44    status := success 
 45   
 46  method s setup image options -> status 
 47    arg_rw ImageSharpening s ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status 
 48    var Float intensity := options option "intensity" Float 
 49    if intensity=undefined 
 50      return failure:"Sharpening intensity is not defined" 
 51    status := bind (addressof:image omap ImagePrototype) intensity 
 52   
 53   
 54  method s read_line y buffer 
 55    oarg_rw ImageSharpening s ; arg Int y ; arg Address buffer 
 56    if y>=and y<s:size_y 
 57      memory_copy (addressof s:ground) buffer s:pixel_size 
 58      s:image read s:size_x (buffer translate Byte s:pixel_size) 
 59      memory_copy (addressof s:ground) (buffer translate Byte s:pixel_size+s:line_size) s:pixel_size 
 60    else 
 61      for (var Int x) s:size_x+1 
 62        memory_copy (addressof s:ground) (buffer translate Byte x*s:pixel_size) s:pixel_size 
 63   
 64  function min a b c -> m 
 65    arg Int m 
 66    := min (min b) c 
 67   
 68  function max a b c -> m 
 69    arg Int m 
 70    := max (max b) c 
 71   
 72  method s read x y count adr 
 73    oarg_rw ImageSharpening s ; arg Int count ; arg Address adr 
 74    var Int dim := s:gamut dimension 
 75    var Int psize := pixel_size 
 76    if y=s:y 
 77      void 
 78    eif y=s:y+1 
 79      memory_move (s:buffer translate Byte s:line_size+2*s:pixel_size) s:buffer 2*(s:line_size+2*s:pixel_size) 
 80      read_line y+1 (s:buffer translate Byte 2*(s:line_size+2*s:pixel_size)) 
 81    else 
 82      for (var Int i) 0 2 
 83        read_line y+i-1 (s:buffer translate Byte i*(s:line_size+2*s:pixel_size)) 
 84    := y 
 85    var Address src := s:buffer translate Byte s:line_size+(3+x)*s:pixel_size 
 86    var Int step_x := s:pixel_size 
 87    var Int step_y := s:line_size+2*s:pixel_size 
 88    var Address stop := src translate uInt8 count*s:gamut:pixel_size 
 89    var Address dest := adr 
 90    var Pointer:Float32 remain :> s:remain x*s:gamut:pixel_size 
 91    var uInt bits := random_bits ; var Int available := random_available 
 92    var Float intensity := intensity 
 93    while src<>stop 
 94      for (var Int i) dim-1 
 95        var Int v ; var Float f 
 96        := -2*(src map uInt8 -step_x-step_y) -3*(src map uInt8 -step_y) -2*(src map uInt8 step_x-step_y) 
 97        += -3*(src map uInt8 -step_x) 20*(src map uInt8 0) -3*(src map uInt8 step_x) 
 98        += -2*(src map uInt8 -step_x+step_y) -3*(src map uInt8 step_y) -2*(src map uInt8 step_x+step_y) 
 99        := remain+(src map uInt8)+v*intensity 
 100        := bound (cast Int) 0 255 
 101        dest map uInt8 := v 
 102        -= v 
 103        if f<(-1) 
 104          := -1 
 105        if f>1 
 106          := 1 
 107        if available=0 
 108          memory_random addressof:bits uInt:size 
 109          available := uInt:size*8 
 110        if (bits .and. 1)<># send to the right 
 111          remain := 0 
 112          addressof:remain map Float32 psize += f 
 113        else # send to the bottom 
 114          remain := f 
 115        bits := bits\2 ; available -= 1 
 116        src := src translate uInt8 1 
 117        dest := dest translate uInt8 1 
 118        remain :> addressof:remain map Float32 1 
 119      if psize>dim 
 120        memory_copy src dest psize-dim 
 121        src := src translate uInt8 psize-dim 
 122        dest := dest translate uInt8 psize-dim 
 123        remain :> addressof:remain map Float32 psize-dim 
 124    random_bits := bits 
 125    random_available := available 
 126   
 127   
 128  export ImageSharpening '. bind' 
 129   
 130   
 131   
 132   
 133