Patch title: Release 90 bulk changes
Abstract:
File: /graphic/browser/tag/text.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "prototype.pli"
module "/pliant/language/type/text/str32.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/graphic/browser/xml/helper.pli"

tag_position 
  oarg_rw D2Text t ; arg_rw D2Context c
  implicit t
    var Str text := itext
    var Str text32 := itext
    if text=""
      t position_undefined c
      return
    part control
      c:font bbox text null x0 y0 x1 y1 ; x0 *= c scale ; y0 *= c scale ; x1 *= c scale ; y1 *= c scale
      if x1-x0<=c:x1-c:line_x
        c addtoline t
        return
      var Int start := 0
      part dispatch
        var Int stop := start
        part cut
          var Int i := ((text stop text:len) search " " text:len-stop)+stop
          c:font bbox (text32 start i-start) null x0 y0 x1 y1 ; x0 *= c scale ; y0 *= c scale ; x1 *= c scale ; y1 *= c scale
          if x1-x0>c:x1-c:line_x
            leave cut
          while i<text:len and text:i=" "
            i += 1
          stop := i
          if stop<text:len
            restart cut
        if stop=start
          if start=0 and c:line_x<>c:x0
            c newline
            restart control
          eif start=0
            c:font bbox text null x0 y0 x1 y1 ; x0 *= c scale ; y0 *= c scale ; x1 *= c scale ; y1 *= c scale
            c addtoline t
            return
          else
            stop := text len
        var Link:D2Text line :> new D2Text
        line itext := (cast itext Str32) start stop-start
        var Link:D2Box l :> line ; content += l
        c:font bbox line:itext null line:x0 line:y0 line:x1 line:y1 ; line x0 *= c scale ; line y0 *= c scale ; line x1 *= c scale ; line y1 *= c scale
        c addtoline line
        c newline
        start := stop
        if start<text:len
          restart dispatch
      t itext := ""
      x0 := undefined ; y0 := undefined ; x1 := undefined ; y1 := undefined
# constant standard_font_family "[dq]Nimbus Roman No9 L[dq] regular [dq] Regular[dq] bold [dq] Medium[dq]"
constant standard_font_family "Bitstream Charter"
# constant standard_font_family "[dq]Nimbus Sans L[dq] regular [dq] Regular[dq]"

method t draw img c
  oarg_rw D2Text t ; oarg_rw ImagePrototype img ; arg_rw D2Context c
  var Str32 text32 := t itext
  if text32:len>0
    img text text32 c:font null undefined (transform t:x0 t:y0-y0 1 1 0 0) (addressof c:color)
  t draw_recurse img c
# constant fixed_font_family "[dq]Nimbus Mono L[dq] regular [dq] Regular[dq] italic [dq] Oblique[dq]"
constant fixed_font_family "Courier 10 Pitch"

method t event e
  oarg_rw D2Text t ; arg_rw D2Event e
  if e:status:mouse_button_1_pressed
    if e:potencial_url<>"" and t:x0=defined and e:x>=t:x0 and e:x<=t:x1 and e:y>=t:y0 and e:y<=t:y1
      e url := e potencial_url
  each b t:content
    b event e

export D2Text '. itext'
method c font_name def -> name
  arg XmlContext c ; arg Str def name
  if not (def parse (var Str face) any:(var Str options))
    face := def ; options := ""
  var Str regular := options option "regular" Str
  var Str bold := options option "bold" Str " Bold"
  var Str italic := options option "italic" Str " Italic"
  name := face+(shunt (c query "b") bold regular)+(shunt (c query "i") italic "")

method c current_font scale color -> f
  arg XmlContext c ; arg_w Float scale ; arg_rw Int color ; arg Link:Font f
  f :> font (c font_name (c query "font" "face"))
  if not exists:f
    f :> font (c query "font" "face")
  if not exists:f
    f :> font (c font_name (shunt (c query "tt") fixed_font_family standard_font_family))
    if not exists:f
      console "Error: font '"+(c font_name (shunt (c query "tt") fixed_font_family standard_font_family))+"' is missing in your system." eol
  var Str sc := c query "font" "size"
  if (sc parse "+" scale)
    scale := 12*1.25^scale
  eif (sc parse "-" scale)
    scale := 12/1.25^scale
  eif not (sc parse scale)
    scale := 12
  scale *= 25.4/72
  color := html_color (c query "font" "color")

type D2Font
  inherit D2Box
  field (List Link:D2Box) content
  field Int size <- undefined
  field Int color <- undefined
tag_position ''
  if true
    var Pointer:XmlTree sub :> tree first
    while exists:sub
      tree text += sub text
      var Pointer:XmlTree next :> sub next
      free_xml_node sub
      sub :> next
    tree first :> null map XmlTree
  if text=""
    return
  var Link:Font font :> current_font (var Float scale) (var Int color)
  part control
    var Str32 t := html_decode32 (replace text "&nbsp;" "&#32;")
    font bbox t null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    if bx1-bx0<=area_x1-line_x
      x0 := bx0 ; y0 := by0 ; x1 := bx1 ; y1 := by1
      addtoline tree
      if query:"center"
        line_center := true
      return
    var Int start := 0
    while start<text:len
      var Int stop := start
      part cut
        var Int i := ((text stop text:len) search " " text:len-stop)+stop
        var Str32 t := html_decode32 (replace (text start i-start) "&nbsp;" "&#32;")
        font bbox t null bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
        if bx1-bx0>area_x1-line_x
          leave cut
        while i<text:len and text:i=" "
          i += 1
        stop := i
        if stop<text:len
          restart cut
      if stop=start
        if start=0 and line_x<>area_x0
          newline
          restart control
        eif start=0
          var Str32 t := html_decode32 (replace text "&nbsp;" "&#32;")
          font bbox t null bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
          x0 := bx0 ; y0 := by0 ; x1 := bx1 ; y1 := by1
          addtoline tree
          return
        else
          stop := text len
      var Pointer:XmlTree line :> new_xml_node
      line text := text start stop-start
      tree append line
      var Str32 t := html_decode32 (replace line:text "&nbsp;" "&#32;")
      font bbox t null bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      line x0 := bx0 ; line y0 := by0 ; line x1 := bx1 ; line y1 := by1
      addtoline line
      if query:"center"
        line_center := true
      start := stop
      if start<text:len
        newline
  text := ""

D2Box maybe D2Font

method f configure attribute value options
  oarg_rw D2Font f ; arg Str attribute value options
  if attribute="size"
    (value parse f:size) or (value parse "+" f:size)
  eif attribute="color"
    f color := html_color value

method f list -> l
  oarg_rw D2Font f ; arg Pointer:(List Link:D2Box) l
  l :> f content

method f position c
  oarg_rw D2Font f ; arg_rw D2Context c
  var Float scale := c scale
  if f:size=defined
    c scale *= 1.25^f:size
  f position_undefined c
  c scale := scale
    
method f draw img c
  oarg_rw D2Font f ; oarg_rw ImagePrototype img ; arg_rw D2Context c
  var Float scale := c scale
  if f:size=defined
    c scale *= 1.25^f:size
  var Int color := c color
  if f:color=defined
    c color := f color
  each b f:content
    b draw img c
  c scale := scale
  c color := color

html_tags insert "font" true addressof:D2Font
tag_draw ''
  var Str32 t := html_decode32 (replace text "&nbsp;" "&#32;")
  if t:len>0
    var Link:Font font :> current_font (var Float scale) (var Int color)
    font bbox t null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    text t font null undefined (transform x0-bx0 y0-by0 scale scale 0 0) addressof:color
  draw_recurse tree