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/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/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
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    inherit LayoutPrototype
    field Str text
  
  LayoutPrototype maybe LayoutText


type LayoutTextPart
  field Float x y slide
  field Str32 text
  field Int extra
  field Address kerning <- null
  field Link:Font font
  field Float scale
  field LayoutColor color

function destroy p
  arg_w LayoutTextPart p
  if p:kerning<>null
    memory_free p:kerning

type LayoutTextObject
  field Float x y
  field Link:LayoutPrototype object


method t flush eol some stop_x x y0 y1 c 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_rw List list ; arg_rw LayoutArea box
  if (c:style:text:justify and eol) or c:style:text:align<>(-1)
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 and entry_type:a=LayoutTextPart
        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 LayoutTextPart
          p kerning := memory_allocate p:text:len*Float:size addressof:p
          for (var Int i) 0 p:text:len-1
            p:kerning map Float i := shunt i>0 and p:text:(i-1)=" " extend/total/p:scale/p:font:vector:x 0
          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
    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 CBool some ; arg_rw Float x y0 y1 ; arg_rw LayoutPC c ; arg_rw List list ; arg_rw LayoutArea box
  var Pointer:Font font :> c:style:text:font (shunt c:style:text:bold 1 0)+(shunt c:style:text:italic 2 0)+(shunt c:style:text:fixed 4 0)
  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 LayoutText):text
      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
          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
        eif x+scale*v:x>c:area:x1+1e-6 and (some or stop<>start) and c:style:text:wrap
        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 Float bx1) (var Float by1)
          if x+scale*bx1>c:area:x1
            if stop<>start
              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 := 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
        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 LayoutRestyle
      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:offset) attr:value attr:size
      t dispatch p some x y0 y1 c list box
      each attr s:attributes
        memory_swap ((addressof c:style) translate Byte attr:offset) attr:value attr:size
      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:area:y0 c:area:x1 c:area:y1 c:flags
      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 list ; arg_rw LayoutArea box
  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 y1 := 0
  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
  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
  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
    c:area y0 += c:style:text tail_padding
    c:area y0 += style:para tail_padding


method l offset_rec tx ty
  oarg_rw LayoutPrototype l ; arg Float tx ty
  var Link:LayoutPrototype p :> l first
  while exists:p
    var Pointer:Type t :> entry_type addressof:p
    if t=LayoutText
      void
    eif t=LayoutRestyle or t=LayoutSection
      p offset_rec tx ty
    else
      p offset tx ty
    p :> p next

method t position c -> b
  oarg_rw LayoutPara t ; arg_rw LayoutPC c ; arg LayoutArea b
  if t:positioned # FIXME: too naive
    var Pointer:LayoutArea pa :> t:bbox first
    var Float tx := c:area:x0-pa:x0
    var Float ty := c:area:y0-pa:y0
    pa x0 += tx ; pa y0 += ty ; pa x1 += tx ; pa y1 += ty
    c:area y0 += pa:y1-pa:y0
    t offset_rec tx ty
    return pa
  b := c area
  t dispatch c (var List list) (var LayoutArea b2)
  b y1 := c:area y0
  var Pointer:Arrow a :> list first
  while a<>null
    var Pointer:Type ta :> entry_type a
    if ta=LayoutTextObject
      var Pointer:LayoutTextObject o :> a map LayoutTextObject
      o:object translate o:x o:y
    a :> list next a
  b x1 := max b:x1 b2:x1
  t bbox := var List:LayoutArea empty_list
  t bbox += b
  if (c:flags .and. layout_pos_test_x+layout_pos_test_y)=0
    t set_position
  else
    b := b2


constant debug false

method t draw d c
  oarg_rw LayoutPara t ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  part escape
    var Pointer:LayoutArea pa :> t:bbox first
    while exists:pa
      if (pa intersects c:bbox c:style:focus:thickness)
        leave escape
      pa :> t:bbox next pa
    return
  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 Int index := shunt (addressof c:window:session:focus_target)=addressof:t and (t:flags .and. 4)<>0 c:window:session:focus_index 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
      d text p:text p:font p:kerning (transform p:x p:y+p:slide p:scale p:scale 0 0) (c color p:color)
      if debug
        var Int g := 808080h
        d rectangle p:x-0.5 p:y-0.5 p:x+0.5 p:y+0.5 addressof:g
      if index>=i and index<i+p:text:len+p:extra
        var Float x := p:x+p:scale*(p:font vector (p:text 0 index-i) p:kerning):x
        d rectangle x p:y+p:scale*p:font:bbox_y0 x+fs:thickness p:y+p:scale*p:font:bbox_y1 (c color fs:color)
        c:window focus_area x p:y+p:scale*p:font:bbox_y0 x+fs:thickness p:y+p:scale*p:font:bbox_y1
      i += p:text:len+p:extra
    eif ta=LayoutTextObject
      (a map LayoutTextObject):object draw d c
      if debug
        var Pointer:LayoutTextPart p :> a map LayoutTextPart
        var Int g := 808080h
        d rectangle p:x-0.5 p:y-0.5 p:x+0.5 p:y+0.5 addressof:g
      i += 1
    a :> list next a


function scan p index -> found
  arg_rw Pointer:LayoutPrototype p ; arg_rw Int index ; arg CBool found
  while exists:p
    var Pointer:Type t :> entry_type addressof:p
    if t=LayoutText
      var Int l := (utf8_decode (addressof:p map LayoutText):text) len
      if index<=l
        return true
      p :> p next ; index -= l+1
    eif t=LayoutRestyle or t=LayoutSection
      var Pointer:LayoutPrototype q :> p next
      p :> (addressof:p omap LayoutPrototype) first
      if (scan p index)
        return true
      p :> q
    else
      if index=0
        return true
      p :> p next ; index -= 1
  found := false

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 and exists:b and c:y>=b:y0 and c:y<=b:y1
    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:scale*p:font:bbox_y1
          var Float x := p x
          for (var Int index) 0 p:text:len-1
            var Float dx := p:scale*(p:font vector p:text:index:number):x
            if p:kerning<>null
              dx += p:scale*(p:kerning map Float index)*p:font:vector:x
            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 (addressof s:focus_target)=addressof:t
    if c:event="character" and (t:flags .and. 8)<>0
      var Pointer:LayoutPrototype pp :> t first ; var Int index := s focus_index
      if (scan pp index) and (entry_type addressof:pp)=LayoutText
        var Pointer:LayoutText tt :> addressof:pp map LayoutText
        var Str32 v := utf8_decode tt:text
        tt text := utf8_encode (v 0 index)+(utf8_decode c:key)+(v index v:len)
        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:thickness b:y1

method t focusable -> c
  oarg_rw LayoutPara t ; arg CBool c
  c := (t:flags .and. 4)<>0


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