/pliant/graphic/color/gradation.pli
 
 1  abstract 
 2    [Efficients encoding/decoding handling accoding to gradation curve] 
 3   
 4   
 5  module "/pliant/language/unsafe.pli" 
 6  module "/pliant/language/stream.pli" 
 7  module "/pliant/math/curve.pli" 
 8  module "/pliant/graphic/misc/int.pli" 
 9   
 10  public 
 11    constant encoded_resolution 256 
 12    constant linear_resolution 4096 
 13   
 14  type ColorGradation 
 15    field (Array Float32 encoded_resolution) decode_table 
 16    field (Array uInt8 linear_resolution) encode_table 
 17    field Int maximum 
 18    field Status status <- failure 
 19   
 20  method cg compute 
 21    arg_rw ColorGradation cg 
 22    for (var Int i) 0 encoded_resolution-1 
 23      if cg:decode_table:i=undefined 
 24        cg status := failure 
 25        return 
 26    for (var Int i) 1 encoded_resolution-1 
 27      if cg:decode_table:i<=cg:decode_table:(i-1) and cg:decode_table:i<0.99 
 28        cg status := failure 
 29        return 
 30    var Int encoded := 0 
 31    for (var Int i) 0 linear_resolution-1 
 32      var Float linear := i/(linear_resolution-1) 
 33      while encoded+1<encoded_resolution and (abs linear-cg:decode_table:(encoded+1))<(abs linear-cg:decode_table:encoded) 
 34        encoded += 1 
 35      cg:encode_table := encoded 
 36    cg maximum := encoded 
 37    cg status := success 
 38   
 39  function color_gamma gamma threshold extra -> cg 
 40    arg Float gamma threshold extra ; arg ColorGradation cg 
 41    var Float factor := threshold/((threshold+extra)/(1+extra))^gamma 
 42    for (var Int i) 0 encoded_resolution-1 
 43      var Float := i/(encoded_resolution-1) 
 44      var Float l 
 45      if e<threshold 
 46        := e/factor 
 47      else 
 48        := ((e+extra)/(1+extra))^gamma 
 49      if l=undefined 
 50        := 0 
 51      cg:decode_table := l 
 52    cg compute 
 53     
 54  function color_gradation curve -> cg 
 55    arg Curve curve ; arg ColorGradation cg 
 56    # curve is level (0 - 255) -> density (0 - 1) 
 57    if curve=failure 
 58      cg status := failure 
 59      return 
 60    for (var Int i) 0 encoded_resolution-1 
 61      cg:decode_table := curve 1e-12 
 62    cg compute 
 63   
 64   
 65  method cg decode level -> linear 
 66    arg ColorGradation cg ; arg Int level ; arg Float linear 
 67    linear := cg:decode_table level 
 68     
 69  method cg encode linear -> level 
 70     arg ColorGradation cg ; arg Float linear ; arg Int level 
 71     var Int assign := cast linear*(linear_resolution-1) Int 
 72     level := cg:encode_table (bound assign 0 linear_resolution-1) 
 73   
 74   
 75  function 'cast Status' g -> status 
 76    arg ColorGradation g ; arg Status status 
 77    extension 
 78    status := status 
 79   
 80   
 81  export ColorGradation color_gamma color_gradation '. decode' '. encode' 'cast Status' 
 82  export '. decode_table' '. compute' '. maximum'