Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/vector/shading.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/math/point.pli"
module "/pliant/math/vector.pli"
module "/pliant/graphic/misc/int.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/graphic/misc/bytes.pli"


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

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


function '-' p1 p2 -> v
  arg Point2 p1 p2 ; arg Vector2 v
  v x := p1:x-p2:x
  v y := p1:y-p2:y

function '*' c v -> w
  arg Float c ; arg Vector2 v w
  w x := c*v:x
  w y := c*v:y

function '*' v1 v2 -> p
  arg Vector2 v1 v2 ; arg Float p
  p := v1:x*v2:x+v1:y*v2:y

function norme v -> d
  arg Vector2 v ; arg Float d
  d := ( v:x*v:x + v:y*v:y )^0.5
  if d=undefined
    d := 0


method p axial_shading p0 c0 p1 c1 g
  oarg_rw ImagePrototype p ; arg Point2 p0 ; arg ColorBuffer c0 ; arg Point2 p1 ; arg ColorBuffer c1 ; arg ColorGamut g
function shading_color g cs f c
  arg ColorGamut g ; arg Array:ColorBuffer cs ; arg Float f ; arg_w ColorBuffer c
  var Float r := f*(cs:size-1)
  var Int i := bound (cast r-0.5 Int) 0 cs:size-2 ; r -= i
  var Pointer:ColorBuffer c0 :> cs i
  var Pointer:ColorBuffer c1 :> cs i+1
  for (var Int i) 0 g:dimension-1
    c:bytes i := cast (1-r)*c0:bytes:i+r*c1:bytes:i Int


method p axial_shading p0 p1 g cs
  oarg_rw ImagePrototype p ; arg Point2 p0 ; arg Point2 p1 ; arg ColorGamut g ; arg Array:ColorBuffer cs
  check cs:size>=2
  var ColorBuffer c
  bytes_fill (addressof:c translate Byte g:dimension) 1 g:transparency
  var Vector2 v1 := p1-p0
  v1 := 1/norme:v1^2*v1
  for (var Int y) 0 p:size_y-1
    for (var Int x) 0 p:size_x-1
      var Vector2 v2 := (point (p mm_x x) (p mm_y y))-p0
      var Float f := bound v1*v2 0 1
      for (var Int i) 0 g:dimension-1
        c:bytes i := cast (1-f)*c0:bytes:i+f*c1:bytes:i Int
      shading_color g cs (bound v1*v2 0 1) (var ColorBuffer c)
      p write x y 1 addressof:c


method p radial_shading p0 r0 c0 p1 r1 c1 g
  oarg_rw ImagePrototype p ; arg Point2 p0 ; arg Float r0 ; arg ColorBuffer c0 ; arg Point2 p1 ; arg Float r1 ; arg ColorBuffer c1 ; arg ColorGamut g
method p radial_shading p0 r0 p1 r1 g cs
  oarg_rw ImagePrototype p ; arg Point2 p0 ; arg Float r0 ; arg Point2 p1 ; arg Float r1 ; arg ColorGamut g ; arg Array:ColorBuffer cs
  check cs:size>=2
  # FIXME
  var ColorBuffer c
  bytes_fill (addressof:c translate Byte g:dimension) 1 g:transparency
  for (var Int y) 0 p:size_y-1
    for (var Int x) 0 p:size_x-1
      var Point2 pxy := point (p mm_x x) (p mm_y y)
      var Float d0 := abs (norme pxy-p0)-r0
      var Float d1 := abs (norme pxy-p1)-r1
      var Float f := d0/(d0+d1)
      if f=undefined
        f := 0.5
      for (var Int i) 0 g:dimension-1
        c:bytes i := cast (1-f)*c0:bytes:i+f*c1:bytes:i Int
      shading_color g cs f (var ColorBuffer c)
      p write x y 1 addressof:c


export '-' '*' norme
export '. axial_shading' '. radial_shading'