Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/sample/charte.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/draw/displaylist.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/vfilter/io.pli"
module "/pliant/math/transform.pli"

constant unit 8.5
constant gamut_name "pantone:process_cyan+process_magenta+process_yellow+process_black"
# constant gamut_name "pantone:blue_072+orange_021+green+process_black"
# constant gamut_name "pantone:process_cyan+process_magenta+process_yellow+process_black"
constant gamut_name "pantone:process_cyan+process_magenta+process_yellow+process_black+red_032+green+blue_072+white"
constant default_font "FreeSans" # "Helvetica"

function linear_charte d
  oarg_rw DrawPrototype d
  d setup (image_prototype 0 0 18*unit 9*unit undefined undefined color_gamut:gamut_name) ""
  for (var Int j) 0 7
    for (var Int i) 0 16
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      var ColorBuffer c
      for (var Int k) 0 3
        addressof:c map uInt8 k := min (shunt (j+1 .and. 2^k)<>0 i*16 0) 255
      d rectangle x+0.25 y+0.25 x+unit-0.25 y+unit-0.25 addressof:c
  for (var Int j) 0 3
    addressof:c map uInt8 j := shunt j=3 255 0
  for (var Int i) 0 17
    for (var Int j) 0 8
      var Float x := i*unit+5
      var Float y := j*unit+5
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      d rectangle x-0.25 y-0.25 x+0.25 y+0.25 addressof:c
  var Link:Font f :> font "Helvetica"
  var Link:Font f :> font default_font
  for (var Int i) 0 16
    var Str t := string (min i*16 255)
    var Float s := 3
    f bbox t null undefined (var Float x0) (var Float y0) (var Float x1) (var Float y1)
    var Float x := i*unit+unit-0.5*s*(x0+x1)
    var Float y := unit/4-0.5*s*(y0+y1)
    d text t f null undefined (transform x y s s 0 0) addressof:c
    d text t f null (transform x y s s 0 0) addressof:c
    var Float y := 8.75*unit-0.5*s*(y0+y1)
    d text t f null undefined (transform x y s s 0 0) addressof:c
    d text t f null (transform x y s s 0 0) addressof:c


function grid_charte d
function linear_charte2 d
  oarg_rw DrawPrototype d
  var Link:ColorGamut gamut :> color_gamut gamut_name
  var Int dim := gamut dimension
  d setup (image_prototype 0 0 18*unit (dim+1)*unit undefined undefined gamut) ""
  for (var Int j) 0 dim-1
    for (var Int i) 0 16
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      var ColorBuffer c
      for (var Int k) 0 dim-1
        addressof:c map uInt8 k := min (shunt j=k i*16 0) 255
      d rectangle x+0.25 y+0.25 x+unit-0.25 y+unit-0.25 addressof:c
  for (var Int j) 0 dim-1
    addressof:c map uInt8 j := shunt j=3 255 0
  for (var Int i) 0 17
    for (var Int j) 0 dim
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      d rectangle x-0.25 y-0.25 x+0.25 y+0.25 addressof:c
  var Link:Font f :> font default_font
  for (var Int i) 0 16
    var Str t := string (min i*16 255)
    var Float s := 3
    f bbox t null undefined (var Float x0) (var Float y0) (var Float x1) (var Float y1)
    var Float x := i*unit+unit-0.5*s*(x0+x1)
    var Float y := unit/4-0.5*s*(y0+y1)
    d text t f null (transform x y s s 0 0) addressof:c
    var Float y := 8.75*unit-0.5*s*(y0+y1)
    d text t f null (transform x y s s 0 0) addressof:c

function grid_charte d model add mul
  oarg_rw DrawPrototype d ; arg Str model ; arg Int add mul
  var Int n := 5
  d setup (image_prototype 0 0 n^2*unit+unit n^2*unit+unit undefined undefined color_gamut:gamut_name) ""
  var Link:ColorGamut gamut :> color_gamut gamut_name
  var Int dim := gamut dimension
  d setup (image_prototype 0 0 n^2*unit+unit n^2*unit+unit undefined undefined gamut) ""
  (var Array:Int channel) size := 4
  for (var Int i) 0 3
    channel i := i
  if model="red"
    channel 0 := 1
    channel 1 := 4
    channel 2 := 2
  eif model="green"
    channel 0 := 2
    channel 1 := 5
    channel 2 := 0
  eif model="blue"
    channel 0 := 0
    channel 1 := 6
    channel 2 := 1
  for (var Int i) 0 n^4
    var Float x := (i%n)*unit+(i\n^2%n)*(n*unit)+5
    var Float y := (i\n%n)*unit+(i\n^3)*(n*unit)+5
    var Float x := (i%n)*unit+(i\n^2%n)*(n*unit)+unit/2
    var Float y := (i\n%n)*unit+(i\n^3)*(n*unit)+unit/2
    var ColorBuffer c
    memory_clear addressof:c dim
    for (var Int j) 0 3
      addressof:c map uInt8 j := min (i\n^j%n)*(256\(n-1)) 255
      var Int v :=i\n^j%n
      addressof:c map uInt8 channel:j := min (max (v*mul+add)*256\mul\(n-1) 0) 255
    d rectangle x+0.25 y+0.25 x+unit-0.25 y+unit-0.25 addressof:c
  for (var Int j) 0 3
  for (var Int j) 0 dim-1
    addressof:c map uInt8 j := 255
  d rectangle 0 0 0.001 0.001 addressof:c
  for (var Int j) 0 dim-1
    addressof:c map uInt8 j := shunt j=3 255 0
  for (var Int i) 0 n^2
    for (var Int j) 0 n^2
      var Float x := i*unit+5
      var Float y := j*unit+5
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      d rectangle x-0.25 y-0.25 x+0.25 y+0.25 addressof:c
  var Link:Font f :> font "Helvetica"
  var Link:Font f :> font default_font
  for (var Int i) 0 n-1
    var Str t := string (min i*256\(n-1) 255)
    var Str t := string (min (max (i*mul+add)*256\mul\(n-1) 0) 255)
    var Float s := 3
    f bbox t null undefined (var Float x0) (var Float y0) (var Float x1) (var Float y1)
    var Float x := i*unit+unit-0.5*s*(x0+x1)
    var Float y := unit/4-0.5*s*(y0+y1)
    d text t f null undefined (transform x y s s 0 0) addressof:c
    d text t f null (transform x y s s 0 0) addressof:c

function approval_charte d
  oarg_rw DrawPrototype d
  d setup (image_prototype 0 0 18*unit 8*unit undefined undefined color_gamut:"pantone:process_cyan+process_magenta+process_yellow+process_black+orange_021+green+reflex_blue+silver+white") ""
  for (var Int j) 0 6
    for (var Int i) 0 16
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      var ColorBuffer c
      for (var Int k) 0 8
        addressof:c map uInt8 k := min (shunt k=j and k<7 i*16 0) 255
      d rectangle x+0.25 y+0.25 x+unit-0.25 y+unit-0.25 addressof:c
  for (var Int j) 0 8
    addressof:c map uInt8 j := shunt j=3 255 0
  for (var Int i) 0 17
    for (var Int j) 0 7
      var Float x := i*unit+unit/2
      var Float y := j*unit+unit/2
      d rectangle x-0.25 y-0.25 x+0.25 y+0.25 addressof:c
  var Link:Font f :> font default_font
  for (var Int i) 0 16
    var Str t := string (min i*16 255)
    var Float s := 3
    f bbox t null undefined (var Float x0) (var Float y0) (var Float x1) (var Float y1)
    var Float x := i*unit+unit-0.5*s*(x0+x1)
    var Float y := unit/4-0.5*s*(y0+y1)
    d text t f null (transform x y s s 0 0) addressof:c
    var Float y := 7.75*unit-0.5*s*(y0+y1)
    d text t f null (transform x y s s 0 0) addressof:c

function charte model filename
  arg Str model filename
  var Link:DrawDisplayList d :> new DrawDisplayList
  if model="linear"
    linear_charte d
  eif model="grid"
    grid_charte d
  eif model="linear2"
    linear_charte2 d
  eif model="grid" or model="red" or model="green" or model="blue"
    grid_charte d model 0 1
  eif model="grid2"
    grid_charte d model -1 2
  eif model="approval"
    approval_charte d
  else
    console "'"+model+"' is not a valid charte model"
    return
  d save filename ""


export charte