/pliant/graphic/vector/outline.pli
 
 1  abstract 
 2    [Filling an outline (Pliant formula or Bezier)] 
 3   
 4  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 5  # 
 6  # This program is free software; you can redistribute it and/or 
 7  # modify it under the terms of the GNU General Public License version 2 
 8  # as published by the Free Software Foundation. 
 9  # 
 10  # This program is distributed in the hope that it will be useful, 
 11  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 13  # GNU General Public License for more details. 
 14  # 
 15  # You should have received a copy of the GNU General Public License 
 16  # version 2 along with this program; if not, write to the Free Software 
 17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 18   
 19  module "/pliant/language/compiler.pli" 
 20  module "/pliant/math/curve.pli" 
 21  module "/pliant/math/point.pli" 
 22  module "/pliant/math/transform.pli" 
 23  module "/pliant/graphic/image/prototype.pli" 
 24  module "/pliant/graphic/misc/float.pli" 
 25   
 26  public 
 27    constant outline_evenodd 0 # odd even 
 28    constant outline_nonzero 1 # non zero 
 29   
 30   
 31  type OutlineChain 
 32    field Array:Point2 points 
 33    field Int current 
 34    field Float x 
 35    field Int way 
 36   
 37  type Outline 
 38    field Array:OutlineChain chains 
 39   
 40   
 41  method outline build_chains points 
 42    arg_rw Outline outline ; arg Array:Point2 points 
 43    var Int start := 0 ; var Float := float_max 
 44    for (var Int i) points:size-1 
 45      if points:i:y<m 
 46        start := i ; := points:i:y 
 47    var Int stop := start+points:size 
 48    var Int top := start 
 49    while top<>stop 
 50      var Int bottom := top 
 51      while bottom<>stop and (points (bottom+1)%points:size):y>=(points bottom%points:size):y 
 52        bottom += 1 
 53      if bottom=stop 
 54        return 
 55      outline:chains size += 1 
 56      var Pointer:OutlineChain chain :> outline:chains outline:chains:size-1 
 57      chain way := 1 
 58      chain:points size := bottom-top+1 ; check chain:points:size>=2 
 59      for (var Int i) bottom-top 
 60        chain:points := points (top+i)%points:size 
 61      var Int back := bottom 
 62      while back<>stop and (points (back+1)%points:size):y<=(points back%points:size):y 
 63        back += 1 
 64      outline:chains size += 1 
 65      var Pointer:OutlineChain chain :> outline:chains outline:chains:size-1 
 66      chain way := -1 
 67      chain:points size := back-bottom+1 ; check chain:points:size>=2 
 68      for (var Int i) back-bottom 
 69        chain:points := points (back-i)%points:size 
 70      top := back 
 71   
 72   
 73  method outline bbox min_x min_y max_x max_y 
 74    arg Outline outline ; arg_w Float min_x min_y max_x max_y 
 75    min_x := float_max 
 76    min_y := float_max 
 77    max_x := -float_max 
 78    max_y := -float_max 
 79    for (var Int i) outline:chains:size-1 
 80      var Pointer:OutlineChain chain :> outline:chains i 
 81      for (var Int j) chain:points:size-1 
 82        var Pointer:Point2 point :> chain:points j 
 83        min_x := min min_x point:x 
 84        min_y := min min_y point:y 
 85        max_x := max max_x point:x 
 86        max_y := max max_y point:y 
 87    if min_x=float_max 
 88      min_x := undefined 
 89      min_y := undefined 
 90      max_x := undefined 
 91      max_y := undefined 
 92   
 93   
 94  function compare a b -> c 
 95    arg OutlineChain b ; arg Int c 
 96    := compare a:points:0:b:points:0:y 
 97   
 98  function quick_sort_chains chains nb 
 99    arg Address chains ; arg Int nb 
 100    if nb>2 
 101      var Int ip := nb\2 
 102      swap (chains map OutlineChain ip) (chains map OutlineChain nb-1) 
 103      var Pointer:OutlineChain :> chains map OutlineChain nb-1 
 104      var Int i0 := 0 ; var Int i1 := nb-1 
 105      while i0<i1 
 106        var Pointer:OutlineChain :> chains map OutlineChain i0 
 107        if p<q 
 108          i1 -= 1 
 109          swap q (chains map OutlineChain i1) 
 110        else 
 111          i0 += 1 
 112      swap p (chains map OutlineChain i0) 
 113      quick_sort_chains chains i0 
 114      quick_sort_chains (chains translate OutlineChain i0+1) nb-i0-1 
 115    eif nb=2 
 116      var Pointer:OutlineChain :> chains map OutlineChain 1 
 117      var Pointer:OutlineChain :> chains map OutlineChain 0 
 118      if p<q 
 119        swap q 
 120   
 121  method p index_x x delta -> i 
 122    arg ImagePrototype p ; arg Float delta ; arg Int i 
 123    := cast (x-p:x0)/(p:x1-p:x0)*p:size_x+delta Int 
 124   
 125  method p index_y y delta -> i 
 126    arg ImagePrototype p ; arg Float delta ; arg Int i 
 127    := cast (y-p:y0)/(p:y1-p:y0)*p:size_y+delta Int 
 128   
 129  method img fill outline mode color 
 130    oarg_rw ImagePrototype img ; arg_rw Outline outline ; arg Int mode ; arg Address color 
 131    outline bbox (var Float min_x) (var Float min_y) (var Float max_x) (var Float max_y) 
 132    if min_x=undefined 
 133      return 
 134    var Int iy0 := img index_y min_y -0.499 
 135    var Int iy1 := (img index_y max_y -0.499)+1 
 136    img clip (var Int ix0) iy0 (var Int ix1) iy1 
 137    if outline:chains:size=or iy1<=iy0 
 138      return 
 139    quick_sort_chains (addressof outline:chains:0) outline:chains:size 
 140    var Int n0 := 0 ; var Int n1 := 0 
 141    for (var Int iy) iy0 iy1-1 
 142      var Float := img:y0+(iy+0.5)/img:size_y*(img:y1-img:y0) 
 143      # add new active chains 
 144      while n1<outline:chains:size and outline:chains:n1:points:0:y<=y 
 145        outline:chains:n1:current := 0 
 146        n1 += 1 
 147      # forward active chains and drop terminated chains 
 148      for (var Int i) n0 n1-1 
 149        var Pointer:OutlineChain chain :> outline:chains:i 
 150        part forward 
 151          while (chain:points chain:current+1):y<=y 
 152            if chain:current+2<chain:points:size 
 153              chain current += 1 
 154            else 
 155              if i<>n0 
 156                swap outline:chains:outline:chains:n0 
 157              n0 += 1 
 158              leave forward 
 159      # compute horizontal positions 
 160      for (var Int i) n0 n1-1 
 161        var Pointer:OutlineChain chain :> outline:chains:i 
 162        var Pointer:Point2 p0 :> chain:points chain:current 
 163        var Pointer:Point2 p1 :> chain:points chain:current+1 
 164        chain := p0:x+(p1:x-p0:x)*(y-p0:y)/(p1:y-p0:y) 
 165      # sort active chains from left to right 
 166      for (var Int i) n0+n1-1 
 167        var Int := i 
 168        while j>n0 and outline:chains:j:x<outline:chains:(j-1):x 
 169          swap outline:chains:outline:chains:(j-1) 
 170          -= 1 
 171      # draw 
 172      check (n1-n0)%2=0 
 173      if mode=outline_evenodd 
 174        for (var Int i) n0 n1-2 step 2 
 175          var Int seg_x0 := max (img index_x outline:chains:i:0) 0 
 176          var Int seg_x1 := min (img index_x outline:chains:(i+1):0) img:size_x 
 177          if seg_x1>seg_x0 
 178            img fill seg_x0 iy seg_x1-seg_x0 color 
 179      eif mode=outline_nonzero 
 180        var Int count := 0 
 181        for (var Int i) n0 n1-2 
 182          count += outline:chains:i:way 
 183          if count<>0 
 184            var Int seg_x0 := max (img index_x outline:chains:i:0) 0 
 185            var Int seg_x1 := min (img index_x outline:chains:(i+1):0) img:size_x 
 186            if seg_x1>seg_x0 
 187              img fill seg_x0 iy seg_x1-seg_x0 color 
 188   
 189   
 190  method img fill curves mode t color 
 191    oarg_rw ImagePrototype img ; arg Array:Curve curves ; arg Int mode ; arg Transform2 t ; arg Address color 
 192    var Float epsilon := (min (abs img:x1-img:x0)/img:size_x (abs img:y1-img:y0)/img:size_y)/4 
 193    var Outline outline 
 194    for (var Int i) curves:size-1 
 195      var Array:Point2 pts := curves:polyline epsilon 
 196      outline build_chains pts 
 197    img fill outline mode color 
 198   
 199   
 200  method img rectangle x0 y0 x1 y1 color 
 201    oarg_rw ImagePrototype img ; arg Float x0 y0 x1 y1 ; arg Address color 
 202    var Int ix0 := max (img index_x x0 0) 0 
 203    var Int iy0 := max (img index_y y0 0) 0 
 204    var Int ix1 := min (img index_x x1 0) img:size_x 
 205    var Int iy1 := min (img index_y y1 0) img:size_y 
 206    if ix1>ix0 
 207      for (var Int iy) iy0 iy1-1 
 208        img fill ix0 iy ix1-ix0 color 
 209   
 210   
 211  export Outline '. build_chains' '. bbox' 
 212  export '. fill' '. rectangle' 
 213