/pliant/graphic/image/antialiasing.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  submodule "prototype.pli" 
 3  module "/pliant/graphic/color/gamut.pli" 
 4  module "/pliant/language/compiler/type/inherit.pli" 
 5  module "/pliant/graphic/misc/mtbuffer.pli" 
 6   
 7  constant smart true 
 8   
 9   
 10  type ImageAntiAliasing 
 11    inherit ImagePrototype 
 12    field Link:ImagePrototype image 
 13    field MtBuffer buffers 
 14    field Int tile_x tile_y shift 
 15   
 16  ImagePrototype maybe ImageAntiAliasing 
 17   
 18   
 19  method aa step_x -> s 
 20    arg ImageAntiAliasing aa ; arg Int s 
 21    := aa pixel_size 
 22   
 23  method aa step_y -> s 
 24    arg ImageAntiAliasing aa ; arg Int s 
 25    := aa:line_size*aa:tile_x 
 26   
 27   
 28  method aa bind image tile_x tile_y -> status 
 29    oarg_rw ImageAntiAliasing aa ; oarg ImagePrototype image ; arg Int tile_x tile_y ; arg ExtendedStatus status 
 30    if image:gamut:bits_per_component<>8 
 31      return (failure "Antialiasing on "+(string image:gamut:bits_per_component)+" bits per component images is not supported") 
 32    var Int shift := 0 
 33    while 2^shift<tile_x*tile_y 
 34      shift += 1 
 35    if tile_x*tile_y<>2^shift 
 36      return (failure "Antialiasing factor "+string:tile_x+"x"+string:tile_y+" is not supported") 
 37    if not smart and (image:size_x%tile_x<>0 or image:size_y%tile_y<>0) 
 38      return failure:"The image sampling is not suited for the requested antialiasing" 
 39    addressof:aa map ImagePrototype := addressof:image map ImagePrototype 
 40    aa image :> image 
 41    aa tile_x := tile_x ; aa tile_y := tile_y 
 42    aa shift := shift 
 43    aa size_x := image:size_x\tile_x 
 44    aa size_y := image:size_y\tile_y 
 45    if smart 
 46      aa x1 := image:x0+(image:x1-image:x0)*(aa:size_x*tile_x)/image:size_x 
 47      aa y1 := image:y0+(image:y1-image:y0)*(aa:size_y*tile_y)/image:size_y 
 48    check image:line_size>=aa:line_size*tile_x 
 49    aa:buffers size := aa:step_y*tile_y 
 50    status := success 
 51   
 52  method aa setup image options -> status 
 53    oarg_rw ImageAntiAliasing aa ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status 
 54    if not ((options (options option_position "antialiasing" 0) options:len) parse word:"antialiasing" (var Int tile_x) (var Int tile_y) any) 
 55      return failure:"Antialiasing factor not specified" 
 56    status := aa bind (addressof:image omap ImagePrototype) tile_x tile_y 
 57   
 58   
 59  method aa read x y count adr 
 60    oarg_rw ImageAntiAliasing aa ; arg Int count ; arg Address adr 
 61    check x>=and count>=and x+count<=aa:size_x and y>=and y<aa:size_y 
 62    var Int tile_x := aa tile_x ; var Int tile_y := aa tile_y 
 63    var Int shift := aa shift 
 64    var Int step_x := aa step_x 
 65    var Int step_y := aa step_y 
 66    var Int next_tile := (tile_x-1)*step_x 
 67    var Address buffer := aa:buffers allocate 
 68    for (var Int iy) tile_y-1 
 69      aa:image read x*tile_x y*tile_y+iy count*tile_x (buffer translate Byte iy*step_y) 
 70    var Address src := buffer 
 71    var Address dest := adr 
 72    var Address stop := adr translate Byte count*aa:pixel_size 
 73    while dest<>stop 
 74      for (var Int i) step_x-# for each component of the gamut 
 75        var uInt total := 0 
 76        var Address cy := src 
 77        var Int iy := tile_y 
 78        while iy>0 
 79          var Address cx := cy 
 80          var Int ix := tile_x 
 81          while ix>0 
 82            total += cx map uInt8 
 83            cx := cx translate uInt8 step_x 
 84            ix -= 1 
 85          cy := cy translate uInt8 step_y 
 86          iy -= 1 
 87        src := src translate uInt8 1 
 88        dest map uInt8 := total\2^shift 
 89        dest := dest translate uInt8 1 
 90      src := src translate Byte next_tile     
 91    aa:buffers free buffer 
 92   
 93   
 94  export ImageAntiAliasing '. bind' 
 95   
 96