Patch title: Release 90 bulk changes
Abstract:
File: /graphic/browser/tag/table.pli
Key:
    Removed line
    Added line
   
module "common.pli"
module "/pliant/language/unsafe.pli"
module "prototype.pli"
module "/pliant/graphic/browser/xml/helper.pli"




type D2TableCell
  inherit D2Box
  field (List Link:D2Box) content
  field Int bgcolor <- undefined
tag_position td
  newline
  position_recurse tree
  position_container tree


D2Box maybe D2TableCell
tag_draw td
  if not ((query "table" "border") parse (var Float border))
    border := 0
  border *= 25.4/72
  if border>0
    var Int bcolor := html_color (query "table" "bordercolor")
    if bcolor=undefined
      bcolor := 808080h
    rectangle x0-border y0-border x1+border y0 addressof:bcolor
    rectangle x0-border y0-border x0 y1+border addressof:bcolor
    rectangle x1 y0-border x1+border y1+border addressof:bcolor
    rectangle x0-border y1 x1+border y1+border addressof:bcolor
  var Int c := html_color (query "td" "bgcolor")
  if c<>undefined and x0<>undefined
    rectangle x0 y0 x1 y1 addressof:c
  draw_recurse tree


method tc configure attribute value options
  oarg_rw D2TableCell tc ; arg Str attribute value options
  if attribute="bgcolor"
    tc bgcolor := html_color value


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

method tc position c
  oarg_rw D2TableCell tc ; arg_rw D2Context c
  tc position_zero c

method tc draw img c
  oarg_rw D2TableCell tc ; oarg_rw ImagePrototype img ; arg_
  if tc:bgcolor=defined and tc:x0=defined
    img fill tc:x0 tc:y0 tc:x1 tc:y1 (addressof tc:bgcolor)
  each b tc:content
    b draw img c

html_tags insert "td" true addressof:D2TableCell


type D2TableHeader
  inherit D2Box
  field (List Link:D2Box) content

D2Box maybe D2TableHeader

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

method th position c
  oarg_rw D2TableHeader th ; arg_rw D2Context c
  th position_zero c
    
method th draw img c
  oarg_rw D2TableHeader th ; oarg_rw ImagePrototype img ; ar
  each b th:content
    b draw img c

html_tags insert "th" true addressof:D2TableHeader


type D2TableRow
  inherit D2Box
  field (List Link:D2Box) content

D2Box maybe D2TableRow

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

method tr position c
  oarg_rw D2TableRow tr ; arg_rw D2Context c
  tr position_undefined c
    
method tr draw img c
  oarg_rw D2TableRow tr ; oarg_rw ImagePrototype img ; arg_r
  each b tr:content
    b draw img c

html_tags insert "tr" true addressof:D2TableRow


type D2Table
  inherit D2Box
  field (List Link:D2Box) content
  field Int bgcolor <- undefined
  field Str border padding spacing

D2Box maybe D2Table

method t configure attribute value options
  oarg_rw D2Table t ; arg Str attribute value options
  if attribute="bgcolor"
    t bgcolor := html_color value
  eif attribute="border"
    t border := value
  eif attribute="cellpadding"
    t padding := value
  eif attribute="cellspacing"
    t spacing := value

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

function compute_col_row_size b ix iy sx sy
  oarg_rw D2Box b ; arg_rw Int ix iy ; arg_rw Array:Float sx
  if (entry_type addressof:b)=D2TableCell or (entry_type add
function compute_col_row_size t ix iy sx sy
  arg XmlTree t ; arg_rw Int ix iy ; arg_rw Array:Float sx sy
  if t:tag="td"
    while ix>=sx:size
      sx += 0
    while iy>=sy:size
      sy += 0
    while ix>=sx:size
      sx += 0
    while iy>=sy:size
      sy += 0
    if b:x0=defined
      sx ix := max sx:ix b:x1
      sy iy := max sy:iy b:y1
    if t:x0<>undefined
      sx ix := max sx:ix t:x1-t:x0
      sy iy := max sy:iy t:y1-t:y0
    ix += 1
    ix += 1
  eif (entry_type addressof:b)=D2Table
  eif t:tag="table"
    void
  else
    void
  else
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        compute_col_row_size bb ix iy sx sy
    if (entry_type addressof:b)=D2TableRow
    each sub t
      compute_col_row_size sub ix iy sx sy
    if t:tag="tr"
      ix := 0 ; iy += 1

      ix := 0 ; iy += 1

function adjust_col_row_size b ix iy sx sy c
  oarg_rw D2Box b ; arg_rw Int ix iy ; arg_rw Array:Float sx
  if (entry_type addressof:b)=D2TableCell or (entry_type add
    var D2Context c2 := c
    c2 x0 := 0
    c2 y0 := 0
    c2 x1 := sx ix
    c2 y1 := float_max/2
    c2 newline
    b position c2
    if b:x0=defined
      sy iy := max sy:iy b:y1
method c adjust_col_row_size t ix iy sx sy
  arg_rw XmlContext c ; arg_rw XmlTree t ; arg_rw Int ix iy ; arg_rw Array:Float sx sy
  if t:tag="td"
    var Float memo_x0 := c area_x0 ; var Float memo_y0 := c area_y0 ; var Float memo_x1 := c area_x1 ; var Float memo_y1 := c area_y1
    c area_x0 := 0 ; c area_y0 := 0 ; c area_x1 := sx ix ; c area_y1 := float_max/2
    c newline
    c position t
    c area_x0 := memo_x0 ; c area_y0 := memo_y0 ; c area_x1 := memo_x1 ; c area_y1 := memo_y1
    c newline
    if t:x0<>undefined
      sy iy := max sy:iy t:y1
    ix += 1
    ix += 1
  eif (entry_type addressof:b)=D2Table
  eif t:tag="table"
    void
  else
    void
  else
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        adjust_col_row_size bb ix iy sx sy c
    if (entry_type addressof:b)=D2TableRow
    each sub t
      c adjust_col_row_size sub ix iy sx sy
    if t:tag="tr"
      ix := 0 ; iy += 1

      ix := 0 ; iy += 1

function adjust_cell_position b ix iy px py
  oarg_rw D2Box b ; arg_rw Int ix iy ; arg Array:Float px py
  if (entry_type addressof:b)=D2TableCell or (entry_type add
    if (b:x0<>0 or b:y0<>0) and b:x0=defined
      console "oops " b:x0 " " b:y0 eol
    b translate px:ix py:iy
function adjust_cell_position t ix iy px py padding extra
  arg_rw XmlTree t ; arg_rw Int ix iy ; arg Array:Float px py ; arg Float padding extra
  if t:tag="td"
    if t:x0<>undefined
      position_translate t px:ix-t:x0+padding py:iy-t:y0+padding
    t x0 := px ix ; t y0 := py iy ; t x1 := (px ix+1)-extra ; t y1 := (py iy+1)-extra
    ix += 1
    ix += 1
  eif (entry_type addressof:b)=D2Table
  eif t:tag="table"
    void
  else
    void
  else
    # if (entry_type addressof:b)=D2TableRow
    #   b translate px:ix py:iy 
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        adjust_cell_position bb ix iy px py
    if (entry_type addressof:b)=D2TableRow
    each sub t
      adjust_cell_position sub ix iy px py padding extra
    if t:tag="tr"
      ix := 0 ; iy += 1

      ix := 0 ; iy += 1

method t position c
  oarg_rw D2Table t ; arg_rw D2Context c
  var Float u := c unit

tag_position table
  if not ((query "table" "cellpadding") parse (var Float padding))
    padding := 0
  if not ((query "table" "border") parse (var Float border))
    border := 0
  if not ((query "table" "cellspacing") parse (var Float spacing))
    spacing := 0
  padding *= 25.4/72
  border *= 25.4/72
  spacing *= 25.4/72
  # ask cells for size
  # ask cells for size
  c newline
  each b t:content
    b position c
  x0 := area_x0 ; y0 := area_y0
  newline
  position_recurse tree
  var Array:Float sx sy
  var Int ix := 0 ; var Int iy := 0
  var Array:Float sx sy
  var Int ix := 0 ; var Int iy := 0
  each b t:content
    compute_col_row_size b ix iy sx sy
  each sub tree
    compute_col_row_size sub ix iy sx sy
  # adjust columns horizontal size
  # adjust columns horizontal size
  var Float total := 0*(3*sx:size+1)*u
  var Float total := 0
  for (var Int i) 0 sx:size-1
    total += sx i
  for (var Int i) 0 sx:size-1
    total += sx i
  if total>c:x1-c:x0
    var Float limit := (c:x1-c:x0)/sx:size
  var Float room := area_x1-area_x0-padding*2*sx:size-border*2*(sx:size+1)-spacing*(sx:size+1)
  if total>room
    var Float limit := room/sx:size
    part adjust_limit
    part adjust_limit
      var Float total := 0*(3*sx:size+1)*u ; var Int candida
      var Float total := 0 ; var Int candidate := 0
      for (var Int i) 0 sx:size-1
        total += min sx:i limit
        if sx:i>limit
          candidate += 1
      for (var Int i) 0 sx:size-1
        total += min sx:i limit
        if sx:i>limit
          candidate += 1
      if c:x1-c:x0>total+1e-6 and candidate>0
        limit += (c:x1-c:x0-total)/candidate
      if room>total+1e-6 and candidate>0
        limit += (room-total)/candidate
        restart adjust_limit
    for (var Int i) 0 sx:size-1
      sx i := min sx:i limit
    var Int ix := 0 ; var Int iy := 0
        restart adjust_limit
    for (var Int i) 0 sx:size-1
      sx i := min sx:i limit
    var Int ix := 0 ; var Int iy := 0
    each b t:content
      adjust_col_row_size b ix iy sx sy c
  # compute absolute horizontal and vertical positions
    each sub tree
      adjust_col_row_size sub ix iy sx sy
  # computess absolute horizontal and vertical positions
  var Array:Float px py
  px size := sx:size+1
  var Array:Float px py
  px size := sx:size+1
  px 0 := c x0
  px 0 := x0+2*border+spacing
  for (var Int i) 1 px:size-1
  for (var Int i) 1 px:size-1
    px i := (px i-1)+(sx i-1)
    px i := (px i-1)+(sx i-1)+2*padding+2*border+spacing
  py size := sy:size+1
  py size := sy:size+1
  py 0 := c y0
  py 0 := y0+2*border+spacing
  for (var Int i) 1 py:size-1
  for (var Int i) 1 py:size-1
    py i := (py i-1)+(sy i-1)
    py i := (py i-1)+(sy i-1)+2*padding+2*border+spacing
  # adjust cells positions
  var Int ix := 0 ; var Int iy := 0
  # adjust cells positions
  var Int ix := 0 ; var Int iy := 0
  each b t:content
    adjust_cell_position b ix iy px py
  each sub tree
    adjust_cell_position sub ix iy px py padding 2*border+spacing
  # overall table position
  # overall table position
  t x0 := px 0
  t y0 := py 0
  t x1 := px px:size-1
  t y1 := py py:size-1
  c y0 := t y1
  c newline
    
method t draw img c
  oarg_rw D2Table t ; oarg_rw ImagePrototype img ; arg_rw D2
  if t:bgcolor=defined and t:x0=defined
    img fill t:x0 t:y0 t:x1 t:y1 (addressof t:bgcolor)
  each b t:content
    b draw img c
  x1 := px px:size-1 ; y1 := py py:size-1
  area_y0 := y1
  newline


html_tags insert "table" true addressof:D2Table
tag_draw table
  if not ((query "table" "cellpadding") parse (var Float padding))
    padding := 0
  if not ((query "table" "border") parse (var Float border))
    border := 0
  if not ((query "table" "cellspacing") parse (var Float spacing))
    spacing := 0
  padding *= 25.4/72
  border *= 25.4/72
  spacing *= 25.4/72
  if border>0
    var Int bcolor := html_color (query "table" "bordercolor")
    if bcolor=undefined
      bcolor := 808080h
    rectangle x0 y0 x1 y0+border addressof:bcolor
    rectangle x0 y0 x0+border y1 addressof:bcolor
    rectangle x1-border y0 x1 y1 addressof:bcolor
    rectangle x0 y1-border x1 y1 addressof:bcolor
  draw_recurse tree