Patch title: Release 96 bulk changes
Abstract:
File: /pliant/graphic/layout/text.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/util/encoding/utf8.pli"
module "prototype.pli"
submodule "text1.pli"
module "helper/text.pli"
module "helper/recurse.pli"
module "helper/position.pli"
module "helper/event.pli"
module "sequence.pli"
module "restyle.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/util/encoding/utf8.pli"
module "prototype.pli"
submodule "text1.pli"
module "helper/text.pli"
module "helper/recurse.pli"
module "helper/position.pli"
module "helper/event.pli"
module "sequence.pli"
module "restyle.pli"
module "/pliant/graphic/browser/client/context.pli"
module "/pliant/graphic/browser/client/window.pli"
module "/pliant/graphic/ui/client/context.pli"
module "/pliant/graphic/ui/client/window.pli"


public
  type LayoutText


public
  type LayoutText
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    inherit LayoutPrototype
    field Str text
  
  LayoutPrototype maybe LayoutText



    field Str text
  
  LayoutPrototype maybe LayoutText



method t flush eol some stop_x x y0 y1 c list box
  arg LayoutPara t ; arg CBool eol ; arg_rw CBool some ; arg
  if (c:style:text:justify and eol) or c:style:text:align<>(
method t flush eol some stop_x x y0 y1 c style list box
  arg LayoutPara t ; arg CBool eol ; arg_rw CBool some ; arg Float stop_x ; arg_rw Float x y0 y1 ; arg_rw LayoutPC c ; arg LayoutStyleText style ; arg_rw List list ; arg_rw LayoutArea box
  if (style:para:justify and eol) or style:para:align<>(-1)
    var Float extend := c:area:x1-stop_x
    var Int total := 0
    var Pointer:Arrow a :> list last
    while a<>null and (a map LayoutTextObject):y=undefined
      var Pointer:Type ta :> entry_type a
      if ta=LayoutTextPart
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        for (var Int i) 0 p:text:len-1
          if p:text:i=" "
            total += 1
      a :> list previous a
    var Pointer:Arrow a :> list last
    part drop_tail_spaces
      if a<>null and (a map LayoutTextObject):y=undefined an
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        i := p:text len
        while i>0 and (p:text i-1)=" "
          i -= 1
        var Int back := p:text:len-i
        total -= back
        var Vector2 v := p:font vector " ":number
        extend += back*p:scale*v:x
        if i=0
          a :> list previous a
          restart drop_tail_spaces
    var Float extend := c:area:x1-stop_x
    var Int total := 0
    var Pointer:Arrow a :> list last
    while a<>null and (a map LayoutTextObject):y=undefined
      var Pointer:Type ta :> entry_type a
      if ta=LayoutTextPart
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        for (var Int i) 0 p:text:len-1
          if p:text:i=" "
            total += 1
      a :> list previous a
    var Pointer:Arrow a :> list last
    part drop_tail_spaces
      if a<>null and (a map LayoutTextObject):y=undefined an
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        i := p:text len
        while i>0 and (p:text i-1)=" "
          i -= 1
        var Int back := p:text:len-i
        total -= back
        var Vector2 v := p:font vector " ":number
        extend += back*p:scale*v:x
        if i=0
          a :> list previous a
          restart drop_tail_spaces
    if c:style:text:justify and eol and extend>0 and total>0
    if style:para:justify and eol and extend>0 and total>0
      var Int index := 0
      var Pointer:Arrow a :> list last
      while a<>null and (a map LayoutTextObject):y=undefined
        a :> list previous a
      if a=null
        a :> list first
      else
        a :> list next a
      while a<>null
        (a map LayoutTextObject) x += index/total*extend    
        var Pointer:Type ta :> entry_type a
        if ta=LayoutTextPart
          var Pointer:LayoutTextPart p :> a map LayoutTextPa
          p kerning := memory_allocate p:text:len*Float:size
          for (var Int i) 0 p:text:len-1
            p:kerning map Float i := shunt i>0 and p:text:(i
          for (var Int i) 0 p:text:len-1
            if p:text:i=" "
              index += 1
        a :> list next a
      box x1 := max box:x1 c:area:x1
      var Int index := 0
      var Pointer:Arrow a :> list last
      while a<>null and (a map LayoutTextObject):y=undefined
        a :> list previous a
      if a=null
        a :> list first
      else
        a :> list next a
      while a<>null
        (a map LayoutTextObject) x += index/total*extend    
        var Pointer:Type ta :> entry_type a
        if ta=LayoutTextPart
          var Pointer:LayoutTextPart p :> a map LayoutTextPa
          p kerning := memory_allocate p:text:len*Float:size
          for (var Int i) 0 p:text:len-1
            p:kerning map Float i := shunt i>0 and p:text:(i
          for (var Int i) 0 p:text:len-1
            if p:text:i=" "
              index += 1
        a :> list next a
      box x1 := max box:x1 c:area:x1
    eif c:style:text:align=0 and extend>0
    eif style:para:align=0 and extend>0
      var Pointer:Arrow a :> list last
      while a<>null and (a map LayoutTextObject):y=undefined
        (a map LayoutTextObject) x += extend/2
        a :> list previous a
      box x1 := max box:x1 stop_x+extend/2
      var Pointer:Arrow a :> list last
      while a<>null and (a map LayoutTextObject):y=undefined
        (a map LayoutTextObject) x += extend/2
        a :> list previous a
      box x1 := max box:x1 stop_x+extend/2
    eif c:style:text:align=1 and extend>0
    eif style:para:align=1 and extend>0
      var Pointer:Arrow a :> list last
      while a<>null and (a map LayoutTextObject):y=undefined
        (a map LayoutTextObject) x += extend      
        a :> list previous a
      box x1 := max box:x1 c:area:x1
    else
      box x1 := max box:x1 stop_x
  else
    box x1 := max box:x1 stop_x
  var Pointer:Arrow a :> list last
  while a<>null and (a map LayoutTextObject):y=undefined
    (a map LayoutTextObject) y := c:area:y0-y0
    a :> list previous a
  c:area y0 += y1-y0
  some := false
  x := c:area x0 ; y0 := 0 ; y1 := 0

method t dispatch r some x y0 y1 c list box
  oarg_rw LayoutPara t ; oarg_rw LayoutPrototype r ; arg_rw 
      var Pointer:Arrow a :> list last
      while a<>null and (a map LayoutTextObject):y=undefined
        (a map LayoutTextObject) x += extend      
        a :> list previous a
      box x1 := max box:x1 c:area:x1
    else
      box x1 := max box:x1 stop_x
  else
    box x1 := max box:x1 stop_x
  var Pointer:Arrow a :> list last
  while a<>null and (a map LayoutTextObject):y=undefined
    (a map LayoutTextObject) y := c:area:y0-y0
    a :> list previous a
  c:area y0 += y1-y0
  some := false
  x := c:area x0 ; y0 := 0 ; y1 := 0

method t dispatch r some x y0 y1 c list box
  oarg_rw LayoutPara t ; oarg_rw LayoutPrototype r ; arg_rw 
  var Pointer:Font font :> c:style:text:font (shunt c:style:
  var Float scale := c:style:text scale
  var Pointer:LayoutColor color :> c:style:text color
  var Pointer:LayoutStyleText style
  if (t:flags .and. 10h)<>0
    style :> c:style header
  eif (t:flags .and. 20h)<>0
    style :> c:style title
  else
    style :> c:style standard
  var Pointer:Font font :> style:text:font (shunt style:text:bold 1 0)+(shunt style:text:italic 2 0)+(shunt style:text:fixed 4 0)
  var Float scale := style:text size
  var Pointer:LayoutColor color :> style:text color
  var Link:LayoutPrototype p :> r first
  while exists:p
    var Pointer:Type ta :> entry_type addressof:p
    if ta=LayoutText
      var Str text := utf8_decode (addressof:p map LayoutTex
      c:window:session font_complete font text
      var Float start_x := x ; var Float stop_x := x
      var Int start := 0 ; var Int stop := start
      for (var Int i) 0 text:len-1
        var Int n := text:i number
        var Vector2 v := font vector n
        if n="[lf]":number
          stop := i ; stop_x := x
          if true
            var Link:LayoutTextPart pp :> new LayoutTextPart
            pp x := start_x
            pp y := undefined
  var Link:LayoutPrototype p :> r first
  while exists:p
    var Pointer:Type ta :> entry_type addressof:p
    if ta=LayoutText
      var Str text := utf8_decode (addressof:p map LayoutTex
      c:window:session font_complete font text
      var Float start_x := x ; var Float stop_x := x
      var Int start := 0 ; var Int stop := start
      for (var Int i) 0 text:len-1
        var Int n := text:i number
        var Vector2 v := font vector n
        if n="[lf]":number
          stop := i ; stop_x := x
          if true
            var Link:LayoutTextPart pp :> new LayoutTextPart
            pp x := start_x
            pp y := undefined
            pp slide := c:style:text slide
            pp slide := style:text slide
            pp text := text start stop-start
            pp extra := shunt i=text:len-1 2 1
            pp font :> font
            pp scale := scale
            pp color := color
            list append addressof:pp
            some := true
            y0 := min y0 scale*font:bbox_y0
            y1 := max y1 scale*font:bbox_y1
            start := stop+1
            pp text := text start stop-start
            pp extra := shunt i=text:len-1 2 1
            pp font :> font
            pp scale := scale
            pp color := color
            list append addressof:pp
            some := true
            y0 := min y0 scale*font:bbox_y0
            y1 := max y1 scale*font:bbox_y1
            start := stop+1
          t flush false some stop_x x y0 y1 c list box
          t flush false some stop_x x y0 y1 c style list box
          start_x := x ; x -= scale*v:x
        eif n=" ":number
          stop := i+1 ; stop_x := x+scale*v:x
          start_x := x ; x -= scale*v:x
        eif n=" ":number
          stop := i+1 ; stop_x := x+scale*v:x
        eif x+scale*v:x>c:area:x1+1e-6 and (some or stop<>st
        eif x+scale*v:x>c:area:x1+1e-6 and (some or stop<>start) and style:para:wrap
          font bbox n (var Float bx0) (var Float by0) (var F
          if x+scale*bx1>c:area:x1
            if stop<>start
              var Link:LayoutTextPart pp :> new LayoutTextPa
              pp x := start_x
              pp y := undefined
          font bbox n (var Float bx0) (var Float by0) (var F
          if x+scale*bx1>c:area:x1
            if stop<>start
              var Link:LayoutTextPart pp :> new LayoutTextPa
              pp x := start_x
              pp y := undefined
              pp slide := c:style:text slide
              pp slide := style:text slide
              pp text := text start stop-start
              pp extra := 0
              pp font :> font
              pp scale := scale
              pp color := color
              list append addressof:pp
              some := true
              y0 := min y0 scale*font:bbox_y0
              y1 := max y1 scale*font:bbox_y1
              start := stop
            var Float delta := x-stop_x
              pp text := text start stop-start
              pp extra := 0
              pp font :> font
              pp scale := scale
              pp color := color
              list append addressof:pp
              some := true
              y0 := min y0 scale*font:bbox_y0
              y1 := max y1 scale*font:bbox_y1
              start := stop
            var Float delta := x-stop_x
            t flush true some stop_x x y0 y1 c list box
            t flush true some stop_x x y0 y1 c style list box
            start_x := x ; x += delta
        x += scale*v:x
      stop := text len
      if text:len=0 or (text text:len-1)<>"[lf]"
        var Link:LayoutTextPart pp :> new LayoutTextPart
        pp x := start_x
        pp y := undefined
            start_x := x ; x += delta
        x += scale*v:x
      stop := text len
      if text:len=0 or (text text:len-1)<>"[lf]"
        var Link:LayoutTextPart pp :> new LayoutTextPart
        pp x := start_x
        pp y := undefined
        pp slide := c:style:text slide
        pp slide := style:text slide
        pp text := text start stop-start
        pp extra := 1
        pp font :> font
        pp scale := scale
        pp color := color
        list append addressof:pp
        some := true
        y0 := min y0 scale*font:bbox_y0
        y1 := max y1 scale*font:bbox_y1
    eif ta=LayoutRestyle
      var Pointer:LayoutRestyle s :> addressof:p map LayoutR
      var Pointer:LayoutStyle memo :> c style
      if (exists s:style)
        c style :> s style
      each attr s:attributes
        memory_swap ((addressof c:style) translate Byte attr
      t dispatch p some x y0 y1 c list box
      each attr s:attributes
        memory_swap ((addressof c:style) translate Byte attr
      c style :> memo
    eif ta=LayoutSection
      t dispatch p some x y0 y1 c list box
    else
      # console ta:name eol
      (var LayoutPC c2) setup c:window c:style c:area:x0 c:a
      var LayoutArea a := p bbox c2
      if x+a:x1-a:x0>c:area:x1+1e-6 and some
        pp text := text start stop-start
        pp extra := 1
        pp font :> font
        pp scale := scale
        pp color := color
        list append addressof:pp
        some := true
        y0 := min y0 scale*font:bbox_y0
        y1 := max y1 scale*font:bbox_y1
    eif ta=LayoutRestyle
      var Pointer:LayoutRestyle s :> addressof:p map LayoutR
      var Pointer:LayoutStyle memo :> c style
      if (exists s:style)
        c style :> s style
      each attr s:attributes
        memory_swap ((addressof c:style) translate Byte attr
      t dispatch p some x y0 y1 c list box
      each attr s:attributes
        memory_swap ((addressof c:style) translate Byte attr
      c style :> memo
    eif ta=LayoutSection
      t dispatch p some x y0 y1 c list box
    else
      # console ta:name eol
      (var LayoutPC c2) setup c:window c:style c:area:x0 c:a
      var LayoutArea a := p bbox c2
      if x+a:x1-a:x0>c:area:x1+1e-6 and some
        t flush true some x x y0 y1 c list box
        t flush true some x x y0 y1 c style list box
      var Link:LayoutTextObject oo :> new LayoutTextObject
      oo x := x-a:x0
      oo y := undefined
      oo object :> p
      list append addressof:oo
      some := true
      y0 := min y0 a:y0
      y1 := max y1 a:y1
      x += a:x1-a:x0
    p :> p next

method t dispatch c list box
  oarg_rw LayoutPara t ; arg_rw LayoutPC c ; arg_rw List lis
      var Link:LayoutTextObject oo :> new LayoutTextObject
      oo x := x-a:x0
      oo y := undefined
      oo object :> p
      list append addressof:oo
      some := true
      y0 := min y0 a:y0
      y1 := max y1 a:y1
      x += a:x1-a:x0
    p :> p next

method t dispatch c list box
  oarg_rw LayoutPara t ; arg_rw LayoutPC c ; arg_rw List lis
  var Pointer:LayoutStyleText style
  if (t:flags .and. 10h)<>0
    style :> c:style header
  eif (t:flags .and. 20h)<>0
    style :> c:style title
  else
    style :> c:style standard
  if (t:flags .and. 1)<>0
    c:area y0 += style:para head_padding
  var CBool some := false
  var Float x := c:area x0 ; var Float y0 := 0 ; var Float y
  var CBool some := false
  var Float x := c:area x0 ; var Float y0 := 0 ; var Float y
  if (t:flags .and. 1)<>0
    c:area y0 += c:style:text head_padding
  if (t:flags .and. 20h)<>0
    swap c:style:text c:style:title
  eif (t:flags .and. 10h)<>0
    swap c:style:text c:style:header
  box x0 := c:area x0
  box y0 := c:area y0
  box x1 := c:area x0
  box y1 := c:area y0
  t dispatch t some x y0 y1 c list box
  box x0 := c:area x0
  box y0 := c:area y0
  box x1 := c:area x0
  box y1 := c:area y0
  t dispatch t some x y0 y1 c list box
  t flush false some x x y0 y1 c list box
  t flush false some x x y0 y1 c style list box
  box y1 := c:area y0
  box y1 := c:area y0
  if (t:flags .and. 20h)<>0
    swap c:style:text c:style:title
  eif (t:flags .and. 10h)<>0
    swap c:style:text c:style:header
  if (t:flags .and. 2)<>0
  if (t:flags .and. 2)<>0
    c:area y0 += c:style:text tail_padding
    c:area y0 += style:para tail_padding



method t event c
  oarg_rw LayoutPara t ; arg_rw LayoutEC c
  if c:mode=layout_event_pointer
    part escape
      var Pointer:LayoutArea pa :> t:bbox first
      while exists:pa
        if pa:y0<=c:y and pa:y1>=c:y
          leave escape
        pa :> t:bbox next pa
      return
  t event_recurse c
  if c:cancel
    return
  var Pointer:LayoutArea b :> t:bbox first
  if c:mode=layout_event_pointer and (t:flags .and. 4)<>0 an
    var Pointer:LayoutStyleFocus fs :> c:style focus
    (var LayoutPC pc) setup c:window c:style t:bbox 0
    t dispatch pc (var List list) (var LayoutArea box)
    var CBool found := false ; var Int possible := undefined
    var Int i := 0
    var Pointer:Arrow a :> list first
    while a<>null
      var Pointer:Type ta :> entry_type a
      if ta=LayoutTextPart
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        if c:y>=p:y+p:scale*p:font:bbox_y0 and c:y<=p:y+p:sc
          var Float x := p x
          for (var Int index) 0 p:text:len-1
            var Float dx := p:scale*(p:font vector p:text:in
            if p:kerning<>null
              dx += p:scale*(p:kerning map Float index)*p:fo
            if c:x>=x and c:x<=x+dx
              c pointer_target :> t
              c pointer_index := i+index
              found := true
            x += dx
          if c:x>x
            possible := i+p:text:len
        i += p:text:len+p:extra
      eif ta=LayoutTextObject
        i += 1
      a :> list next a
    if not found and possible<>undefined
      c pointer_target :> t
      c pointer_index := possible



method t event c
  oarg_rw LayoutPara t ; arg_rw LayoutEC c
  if c:mode=layout_event_pointer
    part escape
      var Pointer:LayoutArea pa :> t:bbox first
      while exists:pa
        if pa:y0<=c:y and pa:y1>=c:y
          leave escape
        pa :> t:bbox next pa
      return
  t event_recurse c
  if c:cancel
    return
  var Pointer:LayoutArea b :> t:bbox first
  if c:mode=layout_event_pointer and (t:flags .and. 4)<>0 an
    var Pointer:LayoutStyleFocus fs :> c:style focus
    (var LayoutPC pc) setup c:window c:style t:bbox 0
    t dispatch pc (var List list) (var LayoutArea box)
    var CBool found := false ; var Int possible := undefined
    var Int i := 0
    var Pointer:Arrow a :> list first
    while a<>null
      var Pointer:Type ta :> entry_type a
      if ta=LayoutTextPart
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        if c:y>=p:y+p:scale*p:font:bbox_y0 and c:y<=p:y+p:sc
          var Float x := p x
          for (var Int index) 0 p:text:len-1
            var Float dx := p:scale*(p:font vector p:text:in
            if p:kerning<>null
              dx += p:scale*(p:kerning map Float index)*p:fo
            if c:x>=x and c:x<=x+dx
              c pointer_target :> t
              c pointer_index := i+index
              found := true
            x += dx
          if c:x>x
            possible := i+p:text:len
        i += p:text:len+p:extra
      eif ta=LayoutTextObject
        i += 1
      a :> list next a
    if not found and possible<>undefined
      c pointer_target :> t
      c pointer_index := possible
  var Pointer:BrowserSession s :> c:window session
  var Pointer:UISession s :> c:window session
  var CBool pos := exists t:bbox:first
  var CBool redraw := false
  if c:mode=layout_event_focus and (exists c:window) and (ad
    if c:event="character" and (t:flags .and. 8)<>0
      var Pointer:LayoutPrototype pp :> t first ; var Int in
      if (scan pp index) and (entry_type addressof:pp)=Layou
        var Pointer:LayoutText tt :> addressof:pp map Layout
        var Str32 v := utf8_decode tt:text
        tt text := utf8_encode (v 0 index)+(utf8_decode c:ke
        s set_focus_index s:focus_index+1
        c reposition t
        redraw := true
  if c:event="focus"
    redraw := true
  if pos and redraw
    each b t:bbox
      c:window redraw_area b:x0 b:y0 b:x1+c:style:focus:thic


method t first -> p
  oarg_rw LayoutPara t ; arg_C Link:LayoutPrototype p
  p :>> t first_son
  var CBool pos := exists t:bbox:first
  var CBool redraw := false
  if c:mode=layout_event_focus and (exists c:window) and (ad
    if c:event="character" and (t:flags .and. 8)<>0
      var Pointer:LayoutPrototype pp :> t first ; var Int in
      if (scan pp index) and (entry_type addressof:pp)=Layou
        var Pointer:LayoutText tt :> addressof:pp map Layout
        var Str32 v := utf8_decode tt:text
        tt text := utf8_encode (v 0 index)+(utf8_decode c:ke
        s set_focus_index s:focus_index+1
        c reposition t
        redraw := true
  if c:event="focus"
    redraw := true
  if pos and redraw
    each b t:bbox
      c:window redraw_area b:x0 b:y0 b:x1+c:style:focus:thic


method t first -> p
  oarg_rw LayoutPara t ; arg_C Link:LayoutPrototype p
  p :>> t first_son