/pliant/graphic/image/convert.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/mtbuffer.pli" 
 6   
 7   
 8  type ImageConvert 
 9    inherit ImagePrototype 
 10    field Link:ImagePrototype image 
 11    field MtBuffer buffers 
 12    field Arrow speedup 
 13    field CBool same_gamut 
 14    field Array:Float32 down 
 15    field Array:Float32 up 
 16    field Link:ColorGamut switch 
 17    field Array:Int hachure 
 18   
 19  ImagePrototype maybe ImageConvert 
 20   
 21   
 22  method convert bind image gamut options -> status 
 23    oarg_rw ImageConvert convert ; oarg ImagePrototype image ; oarg ColorGamut gamut ; arg Str options ; arg ExtendedStatus status 
 24    if gamut=failure 
 25      return (failure "Invalid gamut '"+gamut:name+"' ("+gamut:status:message+")") 
 26    addressof:convert map ImagePrototype := addressof:image map ImagePrototype 
 27    convert gamut :> gamut 
 28    convert complete 
 29    convert image :> image 
 30    convert:buffers size := image line_size 
 31    var Link:ColorGamut :> image gamut 
 32    if (exists convert:switch) 
 33      :> convert switch 
 34    convert speedup := gamut speedup options 
 35    convert same_gamut := image:gamut:name=gamut:name and (image:gamut query "options")=(gamut query "options") 
 36    status := success 
 37   
 38  method convert setup image options -> status 
 39    oarg_rw ImageConvert convert ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status 
 40    var Str gamut_name := options option "gamut" Str 
 41    if gamut_name="" 
 42      return failure:"Gamut name not specified" 
 43    var Link:ColorGamut gamut :> color_gamut gamut_name 
 44    if gamut=failure 
 45      return (failure "Gamut '"+gamut_name+"' is not valid") 
 46    status := convert bind (addressof:image omap ImagePrototype) gamut options 
 47   
 48   
 49  method convert read x y count adr 
 50    oarg_rw ImageConvert convert ; arg Int count ; arg Address adr 
 51    if convert:same_gamut and not (exists convert:switch) and convert:hachure:size=and convert:down:size=0 
 52      convert:image read count adr 
 53      return 
 54    var Address buffer := convert:buffers allocate 
 55    convert:image read count buffer 
 56    var Link:ColorGamut :> convert:image gamut 
 57    if (exists convert:switch) 
 58      :> convert switch 
 59    if convert:hachure:size>0 
 60      var Int psize := convert:image pixel_size 
 61      for (var Int d) convert:hachure:size-1 
 62        var Int := convert:hachure d 
 63        var Int := shunt ((query "component_options "+string:d) option "negative") 255 0 
 64        if h=defined 
 65          var Address ptr := buffer 
 66          var Address stop := buffer translate Byte count*psize 
 67          var Int := (x+y)%(2*h) 
 68          while ptr<>stop 
 69            if r<h 
 70              ptr map uInt8 := z 
 71            += 1 
 72            if r=2*h 
 73              := 0 
 74            ptr := ptr translate Byte psize 
 75    if convert:down:size>0 
 76      var Int psize := convert:image pixel_size 
 77      var Int dim := min (min convert:down:size convert:up:size) psize 
 78      var Address downs := addressof convert:down:0 
 79      var Address ups := addressof convert:up:0 
 80      var Address ptr := buffer 
 81      var Address stop := buffer translate Byte count*psize 
 82      while ptr<>stop 
 83        for (var Int i) dim-1 
 84          ptr map uInt8 := cast (ptr map uInt8 i)*(downs map Float32 i)+255*(ups map Float32 i) Int 
 85        ptr := ptr translate Byte psize 
 86    convert:gamut convert buffer adr count convert:speedup 
 87    convert:buffers free buffer 
 88   
 89  export ImageConvert '. bind' '. down' '. up' '. switch' '. hachure' 
 90   
 91   
 92   
 93   
 94   
 95   
 96