/pliant/graphic/misc/dither.pli
 
 1  module "/pliant/language/unsafe.pli" 
 2  module "/pliant/language/stream.pli" 
 3  module "/pliant/util/crypto/random.pli" 
 4   
 5  constant dither_matrix_mini 192 
 6  constant dither_matrix_maxi 384 
 7  constant dither_matrix_release 1 
 8   
 9   
 10  type DitherMatrix 
 11    field (Array Array:Int) coefs 
 12    field Int size_x size_y 
 13   
 14  method m resize size_x size_y 
 15    arg_rw DitherMatrix m ; arg Int size_x size_y 
 16    size_x := size_x ; size_y := size_y 
 17    m:coefs size := size_y 
 18    for (var Int y) size_y-1 
 19      m:coefs:size := size_x 
 20   
 21  method m '' x y -> coef 
 22    arg DitherMatrix m ; arg Int y ; arg_C Int coef 
 23    check x>=and x<m:size_x 
 24    check y>=and y<m:size_y 
 25    coef :> m:coefs:x 
 26   
 27  method m cell xx yy -> coef 
 28    arg DitherMatrix m ; arg Int xx yy ; arg_C Int coef 
 29    var Int := xx%m:size_x 
 30    if x<0 
 31      += size_x 
 32    var Int := yy%m:size_y 
 33    if y<0 
 34      += size_y 
 35    coef :> m:coefs:x 
 36   
 37  method m save filename 
 38    arg_rw DitherMatrix m ; arg Str filename 
 39    (var Stream s) open filename out+mkdir+safe 
 40    writeline "Pliant dithering matrix" 
 41    writeline "release "+string:dither_matrix_release 
 42    writeline "size_x "+(string m:size_x) 
 43    writeline "size_y "+(string m:size_y) 
 44    writeline "" 
 45    for (var Int y) m:size_y-1 
 46      raw_write addressof:(y) m:size_x*Int:size 
 47   
 48  method m load filename -> status 
 49    arg_rw DitherMatrix m ; arg Str filename ; arg Status status 
 50    (var Stream s) open filename in+safe 
 51    var Int := undefined ; var Int sx sy 
 52    while { var Str := readline ; l<>"" } 
 53      parse word:"release" r 
 54      parse word:"size_x" sx 
 55      parse word:"size_y" sy 
 56    if r<>dither_matrix_release 
 57      return failure 
 58    resize sx sy 
 59    for (var Int y) m:size_y-1 
 60      raw_read addressof:(y) m:size_x*Int:size 
 61    status := shunt s=success success failure 
 62   
 63  function random n -> r 
 64    arg Int r 
 65    memory_strong_random addressof:(var uInt u) uInt:size 
 66    # memory_random addressof:(var uInt u) uInt:size 
 67    := u%(cast uInt) 
 68   
 69  function distance m x y radius x_stretch y_stretch -> d 
 70    arg DitherMatrix m ; arg Int radius x_stretch y_stretch ; arg Float d 
 71    var Int radius2 := radius*radius 
 72    := 0 
 73    for (var Int yy) y-radius y+radius 
 74      var Int dy2 := (yy-y)*(yy-y)*y_stretch*y_stretch 
 75      if dy2<=radius2 
 76        for (var Int xx) x-radius x+radius 
 77          var Int d2 := (xx-x)*(xx-x)*x_stretch*x_stretch+dy2 
 78          if d2<=radius2 
 79            if (cell xx yy)=defined 
 80              += 1/d2 
 81   
 82  function random_matrix sx sy try radius x_stretch y_stretch -> m 
 83    arg Int sx sy try radius x_stretch y_stretch ; arg DitherMatrix m 
 84    resize sx sy 
 85    var Int count := sx*sy 
 86    (var Array:Int buffer_x) size := count 
 87    (var Array:Int buffer_y) size := count 
 88    for (var Int y) sy-1 
 89      for (var Int x) sx-1 
 90        := undefined 
 91        buffer_x x+y*sx := x 
 92        buffer_y x+y*sx := y 
 93    for (var Int index) sx*sy 
 94      part point "point "+string:index+"/"+(string sx*sy) 
 95        var Int selected ; var Float best := undefined 
 96        for (var Int lap) 1 (min (count+1)\try) 
 97          var Int := random count 
 98          var Float := distance buffer_x:buffer_y:radius x_stretch y_stretch 
 99          if best=undefined or d<best 
 100            selected := i ; best := d 
 101        buffer_x:selected buffer_y:selected := index 
 102        count -= 1 
 103        buffer_x selected := buffer_x count 
 104        buffer_y selected := buffer_y count 
 105   
 106   
 107  function is_prime n -> p 
 108    arg Int n ; arg CBool p 
 109    if n<2 
 110      return false 
 111    var Int := 2 
 112    while i*i<=n 
 113      if n%i=0 
 114        return false 
 115      += 1 
 116    := true 
 117   
 118   
 119  function dither_matrix index options -> m 
 120    arg Int index ; arg Str options ; arg DitherMatrix m 
 121    var Int dpi_x := options option "dpi_x" Int 1 
 122    var Int dpi_y := options option "dpi_y" Int 1 
 123    if (load "file:/pliant_data/pliant/graphic/dithering/matrix"+string:index+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin")=failure 
 124      var Int m1 := options option "dither_matrix_mini" Int dither_matrix_mini 
 125      var Int m2 := options option "dither_matrix_maxi" Int dither_matrix_maxi 
 126      part shake "select dithering pattern size for channel "+string:index 
 127        part shake_x 
 128          var Int sx := m1+(random m2-m1+1) 
 129          if not is_prime:sx 
 130            restart shake_x 
 131        part shake_y 
 132          var Int sy := m1+(random m2-m1+1) 
 133          if not is_prime:sy 
 134            restart shake_y 
 135        for (var Int j) index-1 
 136          (var DitherMatrix mm) load "file:/pliant_data/pliant/graphic/dithering/matrix"+string:j+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin" 
 137          if mm:size_x=sx or mm:size_y=sy 
 138            restart shake 
 139      part matrix "compute "+string:sx+" x "+string:sy+" dither matrix for channel "+string:index 
 140        := random_matrix sx sy 64 16 (shunt dpi_y>dpi_x 2 1) (shunt dpi_x>dpi_y 2 1) 
 141      save "file:/pliant_data/pliant/graphic/dithering/matrix"+string:index+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin" 
 142   
 143   
 144  export DitherMatrix '. size_x' '. size_y' '' '. cell' 
 145  export dither_matrix