Patch title: Release 87 bulk changes
Abstract:
File: /pliant/graphic/vector/outline.pli
Key:
    Removed line
    Added line
abstract
  [Filling an outline (Pliant formula or Bezier)]

# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/compiler.pli"
module "/pliant/math/curve.pli"
module "/pliant/math/point.pli"
module "/pliant/math/transform.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/misc/float.pli"


public
  constant outline_evenodd 0 # odd even
  constant outline_nonzero 1 # non zero


type OutlineChain
  field Array:Point2 points
  field Int current
  field Float x
  field Int way

type Outline
  field Array:OutlineChain chains


method outline build_chains points
  arg_rw Outline outline ; arg Array:Point2 points
  var Int start := 0 ; var Float m := float_max
  for (var Int i) 0 points:size-1
    if points:i:y<m
      start := i ; m := points:i:y
  var Int stop := start+points:size
  var Int top := start
  while top<>stop
    var Int bottom := top
    while bottom<>stop and (points (bottom+1)%points:size):y>=(points bottom%points:size):y
      bottom += 1
    if bottom=stop
      return
    outline:chains size += 1
    var Pointer:OutlineChain chain :> outline:chains outline:chains:size-1
    chain way := 1
    chain:points size := bottom-top+1 ; check chain:points:size>=2
    for (var Int i) 0 bottom-top
      chain:points i := points (top+i)%points:size
    var Int back := bottom
    while back<>stop and (points (back+1)%points:size):y<=(points back%points:size):y
      back += 1
    outline:chains size += 1
    var Pointer:OutlineChain chain :> outline:chains outline:chains:size-1
    chain way := -1
    chain:points size := back-bottom+1 ; check chain:points:size>=2
    for (var Int i) 0 back-bottom
      chain:points i := points (back-i)%points:size
    top := back


method outline bbox min_x min_y max_x max_y
  arg Outline outline ; arg_w Float min_x min_y max_x max_y
  min_x := float_max
  min_y := float_max
  max_x := -float_max
  max_y := -float_max
  for (var Int i) 0 outline:chains:size-1
    var Pointer:OutlineChain chain :> outline:chains i
    for (var Int j) 0 chain:points:size-1
      var Pointer:Point2 point :> chain:points j
      min_x := min min_x point:x
      min_y := min min_y point:y
      max_x := max max_x point:x
      max_y := max max_y point:y
  if min_x=float_max
    min_x := undefined
    min_y := undefined
    max_x := undefined
    max_y := undefined


function compare a b -> c
  arg OutlineChain a b ; arg Int c
  c := compare a:points:0:y b:points:0:y

function quick_sort_chains chains nb
  arg Address chains ; arg Int nb
  if nb>2
    var Int ip := nb\2
    swap (chains map OutlineChain ip) (chains map OutlineChain nb-1)
    var Pointer:OutlineChain p :> chains map OutlineChain nb-1
    var Int i0 := 0 ; var Int i1 := nb-1
    while i0<i1
      var Pointer:OutlineChain q :> chains map OutlineChain i0
      if p<q
        i1 -= 1
        swap q (chains map OutlineChain i1)
      else
        i0 += 1
    swap p (chains map OutlineChain i0)
    quick_sort_chains chains i0
    quick_sort_chains (chains translate OutlineChain i0+1) nb-i0-1
  eif nb=2
    var Pointer:OutlineChain p :> chains map OutlineChain 1
    var Pointer:OutlineChain q :> chains map OutlineChain 0
    if p<q
      swap p q

method p index_x x -> i
  arg ImagePrototype p ; arg Float x ; arg Int i
  i := cast (x-p:x0)/(p:x1-p:x0)*p:size_x Int

method p index_y y -> i
  arg ImagePrototype p ; arg Float y ; arg Int i
  i := cast (y-p:y0)/(p:y1-p:y0)*p:size_y Int

method img fill outline mode color
  oarg_rw ImagePrototype img ; arg_rw Outline outline ; arg Int mode ; arg Address color
  outline bbox (var Float min_x) (var Float min_y) (var Float max_x) (var Float max_y)
  if min_x=undefined
    return
  var Int min_iy := max (img index_y min_y) 0
  var Int max_iy := (min (img index_y max_y) img:size_y)-1
  if outline:chains:size=0
    return
  quick_sort_chains (addressof outline:chains:0) outline:chains:size
  var Int n0 := 0 ; var Int n1 := 0
  for (var Int iy) min_iy max_iy
    var Float y := img:y0+(iy+0.5)/img:size_y*(img:y1-img:y0)
    # add new active chains
    while n1<outline:chains:size and outline:chains:n1:points:0:y<=y
      outline:chains:n1:current := 0
      n1 += 1
    # forward active chains and drop terminated chains
    for (var Int i) n0 n1-1
      var Pointer:OutlineChain chain :> outline:chains:i
      part forward
        while (chain:points chain:current+1):y<=y
          if chain:current+2<chain:points:size
            chain current += 1
          else
            if i<>n0
              swap outline:chains:i outline:chains:n0
            n0 += 1
            leave forward
    # compute horizontal positions
    for (var Int i) n0 n1-1
      var Pointer:OutlineChain chain :> outline:chains:i
      var Pointer:Point2 p0 :> chain:points chain:current
      var Pointer:Point2 p1 :> chain:points chain:current+1
      chain x := p0:x+(p1:x-p0:x)*(y-p0:y)/(p1:y-p0:y)
    # sort active chains from left to right
    for (var Int i) n0+1 n1-1
      var Int j := i
      while j>n0 and outline:chains:j:x<outline:chains:(j-1):x
        swap outline:chains:j outline:chains:(j-1)
        j -= 1
    # draw
    check (n1-n0)%2=0
    if mode=outline_evenodd
      for (var Int i) n0 n1-2 step 2
        var Int seg_x0 := max (img index_x outline:chains:i:x) 0
        var Int seg_x1 := min (img index_x outline:chains:(i+1):x) img:size_x
        if seg_x1>seg_x0
          img fill seg_x0 iy seg_x1-seg_x0 color
    eif mode=outline_nonzero
      var Int count := 0
      for (var Int i) n0 n1-2
        count += outline:chains:i:way
        if count<>0
          var Int seg_x0 := max (img index_x outline:chains:i:x) 0
          var Int seg_x1 := min (img index_x outline:chains:(i+1):x) img:size_x
          if seg_x1>seg_x0
            img fill seg_x0 iy seg_x1-seg_x0 color


if true
if false

  type BoundingBox
    field Float x0 y0 x1 y1
  
  method b reset p
    arg_w BoundingBox b ; arg Point2 p
    b x0 := p x
    b y0 := p y
    b x1 := p x
    b y1 := p y
  
  method b include p
    arg_rw BoundingBox b ; arg Point2 p
    b x0 := min b:x0 p:x
    b y0 := min b:y0 p:y
    b x1 := max b:x1 p:x
    b y1 := max b:y1 p:y
  

method img fill curves mode t color
  oarg_rw ImagePrototype img ; arg Array:Curve curves ; arg Int mode ; arg Transform2 t ; arg Address color
  var Float epsilon := (min (img:x1-img:x0)/img:size_x (img:y1-img:y0)/img:size_y)/4
  var Outline outline
  for (var Int i) 0 curves:size-1
    var Array:Point2 pts := curves:i polyline t epsilon
    outline build_chains pts
  # outline chains # FIXME: Pliant will wrongly optimize if removed
  img fill outline mode color


method img rectangle x0 y0 x1 y1 color
  oarg_rw ImagePrototype img ; arg Float x0 y0 x1 y1 ; arg Address color
  var Int ix0 := max (img index_x x0) 0
  var Int iy0 := max (img index_y y0) 0
  var Int ix1 := min (img index_x x1)+1 img:size_x
  var Int iy1 := min (img index_y y1)+1 img:size_y
  if ix1>ix0
    for (var Int iy) iy0 iy1-1
      img fill ix0 iy ix1-ix0 color


export Outline '. build_chains' '. bbox'
export '. fill' '. rectangle'