Patch title: Release 90 bulk changes
Abstract:
File: /graphic/browser/xml/context.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/language/compiler.pli"
module "/pliant/graphic/draw/prototype.pli"
module "tree.pli"

module "tree.pli"


type XmlArea
  field Float x0 y0 x1 y1

type XmlContext
  # attributes forwarding
  field (Dictionary Str Str) values
  field (List List:Str) stack
type XmlArea
  field Float x0 y0 x1 y1

type XmlContext
  # attributes forwarding
  field (Dictionary Str Str) values
  field (List List:Str) stack
  #
  # field Link:XmlTree document
  field Link:DrawPrototype draw
  field Float clip_x0 clip_y0 clip_x1 clip_y1
  # space
  # space
  field Float x0 y0 x1 y1
  field Float area_x0 area_y0 area_x1 area_y1
  field List:XmlArea areas
  # current line
  field Float line_y0 line_x line_y
  field (List Pointer:XmlTree) line_content
  field List:XmlArea areas
  # current line
  field Float line_y0 line_x line_y
  field (List Pointer:XmlTree) line_content
  field CBool line_center
  # event
  field Str url
  field Str key
  field Float x y






method c set tag
  arg_rw XmlContext c ; arg Str tag
  c:values insert tag "[0]"
  var (Pointer List:Str) l :> c:stack last
  l += tag

method c reset tag
  arg_rw XmlContext c ; arg Str tag
  c:values insert tag ""
  var (Pointer List:Str) l :> c:stack last
  l += tag

method c query tag -> value
  arg XmlContext c ; arg Str tag ; arg CBool value
  var Pointer:Str p :> c:values first tag
  if exists:p
    value := p:len<>0
  else
    value := false

method c set tag attr value
  arg_rw XmlContext c ; arg Str tag attr value
  c:values insert tag+" "+attr value
  var (Pointer List:Str) l :> c:stack last
method c set tag attr value
  arg_rw XmlContext c ; arg Str tag attr value
  c:values insert tag+" "+attr value
  var (Pointer List:Str) l :> c:stack last
  l += attr+" "+value
  l += tag+" "+attr

method c query tag attr -> value

method c query tag attr -> value
  arg_rw XmlContext c ; arg Str tag attr value
  arg XmlContext c ; arg Str tag attr value
  var Pointer:Str p :> c:values first tag+" "+attr
  if exists:p
    value := p
  else
    value := ""


method c newline
  arg_rw XmlContext c
  var Pointer:Str p :> c:values first tag+" "+attr
  if exists:p
    value := p
  else
    value := ""


method c newline
  arg_rw XmlContext c
  c line_y0 := c y0
  c line_x := c x0 ; c line_y := c y0
  if c:line_center
    var Float move_x := 0.5*(c:area_x1-c:line_x)
    each lc c:line_content
      lc x0 += move_x
      lc x1 += move_x
  c line_y0 := c area_y0
  c line_x := c area_x0 ; c line_y := c area_y0
  c line_content := var (List Pointer:XmlTree) empty_list
  c line_content := var (List Pointer:XmlTree) empty_list
  c line_center := false

method c addtoline t
  arg_rw XmlContext c ; arg_rw XmlTree t
  # vcenter is not covered yet

method c addtoline t
  arg_rw XmlContext c ; arg_rw XmlTree t
  # vcenter is not covered yet
  if c:line_x+t:x1-t:x0>c:x1 and c:line_x<>c:x0
    c newline
  var Float move_y := (-t:y0)-(c:line_y-c:line_y0)
  if move_y>0
    each lc c:line_content
      lc y0 += move_y
      lc y1 += move_y
    c line_y += move_y
  var Float move_y := (-t:y0)-(c:line_y-c:line_y0)
  if move_y>0
    each lc c:line_content
      lc y0 += move_y
      lc y1 += move_y
    c line_y += move_y
    c y0 += move_y
  var Float move_y := t:y1-(c:y0-c:line_y)
    c area_y0 += move_y
  var Float move_y := t:y1-(c:area_y0-c:line_y)
  if move_y>0
  if move_y>0
    c y0 += move_y
    c area_y0 += move_y
    # might need to switch to next area
  t x0 += c line_x ; t y0 += c line_y
  t x1 += c line_x ; t y1 += c line_y
  var Pointer:XmlTree p :> t ; c line_content += p
  c line_x += t:x1-t:x0


method c newarea
  arg_rw XmlContext c
  var Pointer:XmlArea a :> c:areas first
    # might need to switch to next area
  t x0 += c line_x ; t y0 += c line_y
  t x1 += c line_x ; t y1 += c line_y
  var Pointer:XmlTree p :> t ; c line_content += p
  c line_x += t:x1-t:x0


method c newarea
  arg_rw XmlContext c
  var Pointer:XmlArea a :> c:areas first
  c x0 := a x0 ; c y0 := a y0 ; c x1 := a x1 ; c y1 := a y1
  c area_x0 := a x0 ; c area_y0 := a y0 ; c area_x1 := a x1 ; c area_y1 := a y1
  c:areas remove a
  c newline



  c:areas remove a
  c newline



method t position_undefined c
  arg_rw XmlTree t ; arg_rw XmlContext c
  each sub t
    sub position c
if false # meta '. attribute' e
  if e:size=3 and (e:0 cast XmlContext) and e:1:is_pure_ident and e:2:is_pure_ident
    var Link:Argument r :> argument local Str
    e suckup e:0
    e add (instruction (the_function '. query' XmlContext Str Str -> Str) e:0:result (argument constant Str e:1:ident) (argument constant Str e:2:ident) r)
    e set_result r access_read


if false
  
  method b position_container c
    oarg_rw D2Box b ; arg_rw D2Context c
    function position_include b c
      oarg_rw D2Box b ; arg_rw D2Box c
      if b:x0=defined
        c x0 := min c:x0 b:x0
        c y0 := min c:y0 b:y0
        c x1 := max c:x1 b:x1
        c y1 := max c:y1 b:y1
      else
        var Pointer:(List Link:D2Box) l :> b list
        if exists:l
          each bb l
            position_include bb c
    b x0 := float_max
    b y0 := float_max
    b x1 := float_min
    b y1 := float_min
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        bb position c
        position_include bb b
    if b:x0=float_max
      b x0 := undefined
      b y0 := undefined
      b x1 := undefined
      b y1 := undefined
  
  method b position_zero c
    oarg_rw D2Box b ; arg_rw D2Context c
    var D2Context c2 := c
    c2 x0 := 0
    c2 y0 := 0
    c2 x1 := c:x1-c:x0
    c2 y1 := float_max/2
    c2 newline
    b position_container c2  
  
  method b position_hidden c
    oarg_rw D2Box b ; arg_rw D2Context c
    b x0 := undefined
    b y0 := undefined
    b x1 := undefined
    b y1 := undefined
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        bb position_hidden c
  
  
  method b draw_recurse img c
    oarg_rw D2Box b ; oarg_rw ImagePrototype img ; arg_rw D2
    var Pointer:(List Link:D2Box) l :> b list
    if exists:l
      each bb l
        if bb:x0=undefined
          bb draw img c
        eif bb:x0<=img:x1 and bb:y0<=img:y1 or bb:x1>=img:x0
          bb draw img c
  
  
  method c bind img
    arg_rw D2Context c ; arg ImagePrototype img
    c x0 := img x0
    c y0 := img y0
    c x1 := img x1
    c y1 := img y1
    c areas := var List:D2Area empty_areas_list
    c newline


method c position_setup current_url x0 y0 x1 y1
  arg_rw XmlContext c ; arg Str current_url ; arg Float x0 y0 x1 y1
  c url := current_url
  c area_x0 := x0
  c area_y0 := y0
  c area_x1 := x1
  c area_y1 := y1
  c areas := var List:XmlArea empty_areas_list
  c newline


#-----------------------------------------------------------


method c draw_setup current_url draw x0 y0 x1 y1
  arg_rw XmlContext c ; arg Str current_url ; oarg_rw DrawPrototype draw ; arg Float x0 y0 x1 y1
  c url := current_url
  c draw :> draw
  c clip_x0 := x0 ; c clip_y0 := y0 ; c clip_x1 := x1 ; c clip_y1 := y1


export XmlContext
method c gamut -> g
  arg_rw XmlContext c ; oarg_R ColorGamut g
  g :> c:draw gamut

method c image img t
  arg_rw XmlContext c ; oarg_rw ImagePrototype img ; arg Transform2 t
  c:draw image img t

method c rectangle x0 y0 x1 y1 color
  arg_rw XmlContext c ; arg Float x0 y0 x1 y1 ; arg Address color
  c:draw rectangle x0 y0 x1 y1 color

method c fill curves mode t color
  arg_rw XmlContext c ; arg Array:Curve curves ; arg Int mode ; arg Transform2 t ; arg Address color
  c:draw fill curves mode t color

method c text txt font kerning length t color
  arg_rw XmlContext c ; arg Str32 txt ; arg Font font ; arg Address kerning ; arg Float length ; arg Transform2 t ; arg Address color
  c:draw text txt font kerning length t color

method c event_setup current_url key x y
  arg_rw XmlContext c ; arg Str current_url ; arg Str key ; arg Float x y
  c url := current_url
  c key := key ; c x := x ; c y := y


export XmlContext '. url' '. key' '. x' '. y'
export '. mark' '. set' '. query' '. rewind'
export '. mark' '. set' '. query' '. rewind'
export '. newline' '. addtoline' '. newarea'
export '. area_x0' '. area_y0' '. area_x1' '. area_y1'
export '. line_x' '. line_y' '. newline' '. addtoline' '. line_center' '. newarea'
export '. position_setup'
export '. draw_setup' '. clip_x0' '. clip_y0' '. clip_x1' '. clip_y1'
export '. gamut' '. image' '. rectangle' '. fill' '. text'
export '. event_setup'