Patch title: Release 85 bulk changes
Abstract:
File: /pliant/graphic/vector/pml.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/graphic/vector/prototype.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/math/transform.pli"
module "/pliant/math/curve.pli"
module "/pliant/math/curve/mode.pli"


type DrawPml
  field Link:Stream s
  field Link:ColorGamut g
  field Str font ; field Float scale ; field ColorBuffer color
  field CBool env

DrawPrototype maybe DrawPml


function html_color color gamut -> s
  arg Address color ; arg ColorGamut gamut ; arg Str s
  s := "#"
  for (var Int i) 0 gamut:pixel_size-1
    s += ("0123456789ABCDEF" (color map uInt8 i)\16)+("0123456789ABCDEF" (color map uInt8 i)%16)

method d reset_env
  oarg_rw DrawPml d
  if d:env
    d:s writeline "</env>"
    d env := false

method d set_env font scale color
  oarg_rw DrawPml d ; arg Str font ; arg Float scale ; arg Address color
  if (memory_different color d:g:pixel_size (addressof d:color) d:g:pixel_size) or d:font<>font or d:scale<>scale or not d:env
    d reset_env
    d:s writechars "<env color=[dq]"+(html_color color d:g)+"[dq]"
    if font<>""
      d:s writechars " font=[dq]"+html_encode:font+"[dq]"
    if scale=defined
      d:s writechars " scale=[dq]"+string:scale+"[dq]"
    d:s writeline ">"
    d font := font
    d scale := scale
    memory_copy color (addressof d:color) d:g:pixel_size
    d env := true


method d bind stream gamut options
  oarg_rw DrawPml d ; arg Stream stream ; arg ColorGamut gamut ; arg Str options
  d s :> stream
  d g :> gamut
  d env := false

method d unbind
  oarg_rw DrawPml d
  d reset_env


method d gamut -> g
  oarg_rw DrawPml d ; arg_R ColorGamut g
  g :> d g


method d image img t
  oarg_rw DrawPml d ; arg_rw ImagePrototype img ; arg Transform2 t
  # FIXME


method d rectangle x0 y0 x1 y1 color
  oarg_rw DrawPml d ; arg Float x0 y0 x1 y1 ; arg Address color
  d set_env "" undefined color
  d:s writeline "<rect x0=[dq]"+string:x0+" y0=[dq]"+string:y0+" x1=[dq]"+string:x1+" y1=[dq]"+string:y1+">"

method d fill curves mode t color
  oarg_rw DrawPml d ; arg Array:Curve curves ; arg Int mode ; arg Transform2 t ; arg Address color
  d set_env "" undefined color
  d:s writeline "<fill"+(shunt mode=fill_nonzero " mode=[dq]nz[dq]" "")+">"
  for (var Int i) 0 curves:size-1
    d:s writeline "<curve"+(shunt (curves:i:mode .and. bezier)<>0 " model=[dq]bezier[dq]" "")+">"
    for (var Int j) 0 curves:i:size-1
      var Pointer:CurvePoint p :> curves:i point j
      if p:in_mode=curvepoint_manual and p:in_x=0 and p:in_y=0 and p:out_mode=curvepoint_manual and p:out_x=0 and p:out_y=0
        # short version for <point in_x="0" in_y="0" x="xxx" y="yyy" out_x="0" out_y="0">
        d:s writechars "<angle"
        d:s writechars " x=[dq]"+(string p:x)+"[dq]"
        d:s writechars " y=[dq]"+(string p:y)+"[dq]"
        d:s writeline ">"
      else
        d:s writechars "<point"
        if p:in_mode<>curvepoint_automatic
          d:s writechars " in_x=[dq]"+(string p:in_x)+"[dq]"
          d:s writechars " in_y=[dq]"+(string p:in_y)+"[dq]"
          if p:in_mode=curvepoint_directed
            d:s writechars " in_mode=[dq]directed[dq]"
        d:s writechars " x=[dq]"+(string p:x)+"[dq]"
        d:s writechars " y=[dq]"+(string p:y)+"[dq]"
        if p:out_mode<>curvepoint_automatic
          d:s writechars " out_x=[dq]"+(string p:out_x)+"[dq]"
          d:s writechars " out_y=[dq]"+(string p:out_y)+"[dq]"
          if p:out_mode=curvepoint_directed
            d:s writechars " out_mode=[dq]directed[dq]"
        d:s writeline ">"
    d:s writeline "</curve>"
  d:s writeline "</fill>"


method d text txt font kerning length t color
  oarg_rw DrawPml d ; arg Str32 txt ; arg Font font ; arg Address kerning ; arg Float length ; arg Transform2 t ; arg Address color
  d set_env font:psname t:xx color
  d:s writechars "<text text=[dq]"
  d:s writechars html_encode:txt
  d:s writechars "[dq]"
  d:s writechars " x=[dq]"+(string t:xt)+"[dq] y=[dq]"+(string t:yt)+"[dq]"
  d:s writechars " length=[dq]"+string:length+"[dq]"
  if kerning<>null
    d:s writechars " kerning=[dq]"
    for (var Int i) 0 txt:len-1
      d:s writechars (shunt i=0 "" " ")+string:(kerning map Float i)
    d:s writechars "[dq]"
  d:s writeline ">"


method d clip_open x0 y0 x1 y1
  oarg_rw DrawPml d ; arg Float x0 y0 x1 y1
  d reset_env
  d:s writeline "<clip>"

method d clip_draw_open
  oarg_rw DrawPml d
  d:s writeline "<clipdraw>"

method d clip_draw_close
  oarg_rw DrawPml d
  d reset_env
  d:s writeline "</clipdraw>"

method d clip_close
  oarg_rw DrawPml d
  d reset_env
  d:s writeline "</clip>"


method d tag line mode
  oarg_rw DrawPml d ; arg Str line ; arg Int mode
  d:s writeline line


export DrawPml '. bind' '. unbind'