Patch title: Release 87 bulk changes
Abstract:
File: /pliant/graphic/browser/tag/text.pli
Key:
    Removed line
    Added line
   
module "common.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/language/type/text/istr.pli"

public


type D2Text
  inherit D2Box
  field iStr itext
  field (List Link:D2Box) content

D2Box maybe D2Text

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

method t configure attribute value options
  oarg_rw D2Text t ; arg Str attribute value options
  if attribute=""
    t itext := html_decode32 (replace (replace value " " " ") "[lf]" " ")

method t position c
  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

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

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'


type D2Font
  inherit D2Box
  field (List Link:D2Box) content
  field Int size <- undefined
  field Int color <- undefined

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