Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/browser/naive/tag/form.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/graphic/browser/naive/core.pli"
module "/pliant/language/type/text/str32.pli"
module "/pliant/util/encoding/utf8.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/math/transform.pli"

constant input_space_x 1.5
constant input_space_y 0
constant button_space_x 5
constant button_space_y 0


browser_tag_position input
  var Str32 text := utf8_decode attribute:"value"
  if attribute:"password"="true"
    text := repeat text:len "*"
  font "input" text+" " (var Link:Font font) (var Float scale) (var Int color)
  if false
    font bbox text+" " null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
  else
    var Int start := text search "[lf]" text:len
    font bbox (text 0 start)+" " null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    while start<text:len
      start += 1
      var Int stop := ((text start text:len) search "[lf]" text:len-start)+start
      font bbox (text start stop-start)+" " null (var Float cx0) (var Float cy0) (var Float cx1) (var Float cy1)
      bx1 := max bx1 bx0+(cx1-cx0)
      by1 += cy1-cy0
      start := stop
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  area x0 := bx0*scale ; area y0 := by0*scale-space_y ; area x1 := bx1*scale+2*space_x ; area y1 := by1*scale+space_y # FIXME
  addtoline node

browser_tag_draw input
  if not (attribute:"round" parse (var Float round))
    round := 1
  if not (attribute:"border" parse (var Float border))
    border := 0.001
  var CBool noborder := border=0.001
  if noborder
    border := (console:unit_x+console:unit_y)/2
  var Int color := console browser_color attribute:"background"
  if color=undefined
    color := 0F8F8E0h
  rectangle area:x0 area:y0 area:x1 area:y1 round undefined addressof:color
  var Int color := console browser_color attribute:"bordercolor"
  if color=undefined
    color := shunt noborder 0C0C0C0h 808080h
  if border>0
    rectangle area:x0 area:y0 area:x1 area:y1 round border addressof:color
  var Str32 text := utf8_decode attribute:"value"
  if attribute:"password"="true"
    text := repeat text:len "*"
  font "input" text (var Link:Font font) (var Float scale) (var Int color)
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  if false
    font bbox text null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    text text font null (transform area:x0+space_x-scale*bx0 area:y0+space_y-scale*by0 scale scale 0 0) addressof:color
  else
    var Int start := text search "[lf]" text:len
    font bbox (text 0 start) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    var Transform2 t := transform area:x0+space_x-scale*bx0 area:y0+space_y-scale*by0 scale scale 0 0
    text (text 0 start) font null t addressof:color
    while start<text:len
      start += 1
      var Int stop := ((text start text:len) search "[lf]" text:len-start)+start
      font bbox (text start stop-start) null (var Float cx0) (var Float cy0) (var Float cx1) (var Float cy1)
      t yt += scale*(cy1-cy0)
      text (text start stop-start) font null t addressof:color
      start := stop
  focus_draw node font:vector

browser_tag_split input
  var Str32 text := (utf8_decode attribute:"value")+" "
  if attribute:"password"="true"
    text := repeat text:len "*"
  font "input" text (var Link:Font font) (var Float scale) (var Int color)
  font bbox text null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  var Vector2 v := vector area:x0+space_x-scale*bx0 area:y0+space_y-scale*by0
  boxes size := text len
  if false
    for (var Int i) 0 text:len-1
      font bbox (text i 1) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      var Pointer:BrowserArea ba :> boxes i ; ba x0 := bx0+v:x ; ba y0 := by0+v:y ; ba x1 := bx1+v:x ; ba y1 := by1+v:y
      var Vector2 w := font vector (text i 1) null
      v x += scale*w:x ; v y += scale*w:y
  else
    var Vector2 vv := v
    var Int start := text search "[lf]" text:len
    for (var Int i) 0 start-1
      font bbox (text i 1) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      var Pointer:BrowserArea ba :> boxes i ; ba x0 := bx0+vv:x ; ba y0 := by0+vv:y ; ba x1 := bx1+vv:x ; ba y1 := by1+vv:y
      var Vector2 w := font vector (text i 1) null
      vv x += scale*w:x ; vv y += scale*w:y
    while start<text:len
      var Pointer:BrowserArea ba :> boxes i ; ba x0 := bx0+vv:x ; ba y0 := by0+vv:y ; ba x1 := bx0+vv:x ; ba y1 := by1+vv:y
      start += 1
      var Int stop := ((text start text:len) search "[lf]" text:len-start)+start
      font bbox (text start stop-start) null (var Float cx0) (var Float cy0) (var Float cx1) (var Float cy1)
      v y += scale*(cy1-cy0)
      var Vector2 vv := v
      for (var Int i) start stop-1
        font bbox (text i 1) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
        var Pointer:BrowserArea ba :> boxes i ; ba x0 := bx0+vv:x ; ba y0 := by0+vv:y ; ba x1 := bx1+vv:x ; ba y1 := by1+vv:y
        var Vector2 w := font vector (text i 1) null
        vv x += scale*w:x ; vv y += scale*w:y
      start := stop

browser_tag_event input
  # console "input event " event " "  key " " x " " y eol
  if id=session:focus_id and session:focus_index>=0
    var Int i := session focus_index
    var Str32 v := utf8_decode (node attribute "value")
    if event="press" and key="enter"
      if (node attribute "multiline")="true"
        event := "character" ; key := "[lf]"
    if event="character"
      v := (v 0 i)+utf8_decode:key+(v i v:len)
      attribute "value" := utf8_encode v
      session focus_index += 1 ; focus_scroll node
      session node_refresh node:id 0 0 ""
      session display
      event_discard
    eif event="press" and key="backspace"
      if i>0
        v := (v 0 i-1)+(v i v:len)
        attribute "value" := utf8_encode v
        session focus_index -= 1 ; focus_scroll node
        session node_refresh node:id 0 0 ""
        session display
      event_discard
    eif event="press" and key="delete"
      v := (v 0 i)+(v i+1 v:len)
      attribute "value" := utf8_encode v
      session node_draw id
      event_discard
    eif event="press" and key="left"
      session focus_index := max i-1 0 ; focus_scroll node
      session node_draw id
      event_discard
    eif event="press" and key="right"
      session focus_index := min i+1 v:len ; focus_scroll node
      session node_draw id
      event_discard
    eif event="press" and key="home"
      session focus_index := 0 ; focus_scroll node
      session node_draw id
      event_discard
    eif event="press" and key="end"
      session focus_index := v len ; focus_scroll node
      session node_draw id
      event_discard
    eif event="press" and key="shift tab"
      focus_find_previous
      event_discard
    eif event="press" and key="tab"
      focus_find_next
      event_discard
  event_auto_focus node
  if event="focus" and key="on"
    session:focus_options := "was "+(string attribute:"value")
  if event="focus" and (key="flush" or key="off")
    if attribute:"value"<>(session:focus_options option "was" Str)
      connection writeline "set "+string:(shunt attribute:"id"<>"" attribute:"id" node:id)+" "+(string attribute:"value")
      connection flush anytime
      session restore_connection
      if key="flush"
        session focus_options := "was "+(string attribute:"value")

browser_tag_position select
  var Str32 text := utf8_decode attribute:"value"
  part resolve
    each sub node
      if sub:tag="option"
        if (sub attribute "value")=text
          text := sub attribute "label"
          leave resolve
  font "select" text (var Link:Font font) (var Float scale) (var Int color)
  font bbox text+" " null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  area x0 := bx0*scale ; area y0 := by0*scale-space_y ; area x1 := bx1*scale+2*space_x ; area y1 := by1*scale+space_y # FIXME
  addtoline node

browser_tag_draw select
  if not (attribute:"round" parse (var Float round))
    round := 1
  if not (attribute:"border" parse (var Float border))
    border := 0.001
  var CBool noborder := border=0.001
  if noborder
    border := (console:unit_x+console:unit_y)/2
  var Int color := console browser_color attribute:"background"
  if color=undefined
    color := 0F8F8E0h
  rectangle area:x0 area:y0 area:x1 area:y1 round undefined addressof:color
  var Int color := console browser_color attribute:"bordercolor"
  if color=undefined
    color := shunt noborder 0C0C0C0h 808080h
  if border>0
    rectangle area:x0 area:y0 area:x1 area:y1 round border addressof:color
  if round>0
    if session:focus_id=id
      color := 0FF0000h
      # session focus_x0 := area:x1-2.01*round ; session focus_y0 := area y0 ; session focus_x1 := area x1 ; session focus_y1 := area y1
    rectangle area:x1-2.01*round area:y0 area:x1 area:y1 round border addressof:color
  var Str32 text := utf8_decode attribute:"value"
  part resolve
    each sub node
      if sub:tag="option"
        if (sub attribute "value")=text
          text := sub attribute "label"
          leave resolve
  font "select" text (var Link:Font font) (var Float scale) (var Int color)
  font bbox text null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  text text font null (transform area:x0+space_x-scale*bx0 area:y0+space_y-scale*by0 scale scale 0 0) addressof:color

browser_tag_event select
  if event="press" and key="button1" and x<>undefined
    if false
      session focus_set id id undefined
    else
      session focus_set "" "" undefined ""
      var Pointer:BrowserWindow w :> session window node
      if exists:w
        var Pointer:BrowserNode r :> document search_node w:overlay
        if not exists:r
          w overlay := w:name+" overlay"
          r :> document create_node w:overlay "root"
        var Pointer:BrowserNode n :> document create_node id+" overlay" "select_options"
        n attribute "id" := id
        document stick n stick_tail r
        n:area x0 := area x0
        n:area y0 := area y0
        n:area x1 := area x1
        n:area y1 := area y1
        session focus_set n:id n:id undefined ""
        session node_refresh n:id 0 0 "localdraw"
  if event="press" and id=session:focus_id
    var Str value := attribute "value"
    if key="up"
      var Str previous := value
      each sub node
        if sub:tag="option"
          var Str v := sub attribute "value"
          if v=value
            attribute "value" := previous
          else
            previous := v
      session node_draw id
      event_discard
    eif key="down"
      part scan
        var CBool found := false
        each sub node
          if sub:tag="option"
            var Str v := sub attribute "value"
            if v=value
              found := true
            eif found
              attribute "value" := v
              leave scan
      session node_draw id
      event_discard
    eif key="shift tab"
      focus_find_previous
      event_discard
    eif key="tab"
      focus_find_next
      event_discard
  event_auto_focus node
  if event="focus" and key="on"
    session:focus_options := "was "+(string attribute:"value")
  if event="focus" and (key="flush" or key="off")
    if attribute:"value"<>(session:focus_options option "was" Str)
      connection writeline "set "+string:(shunt (node attribute "id")<>"" (node attribute "id") node:id)+" "+(string attribute:"value")
      connection flush anytime
      session restore_connection
      if key="flush"
        session focus_options := "was "+(string attribute:"value")


browser_tag_position select_options
  var Pointer:BrowserNode n :> document search_node attribute:"id"
  if not exists:n
    return
  var Float sx := 0 ; var Float sy := 0 ; var Float oy := 0
  each sub n
    if sub:tag="option"
      font "select" (sub attribute "label") (var Link:Font font) (var Float scale) (var Int color)
      font bbox (sub attribute "label") null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
      sx := max sx scale*(bx1-bx0)
      if (sub attribute "value")=(n attribute "value")
        oy := sy
      sy += scale*(by1-by0)
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  sx += 2*space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  sy += 2*space_y
  area x0 := n:area:x0
  area y0 := n:area:y0-oy
  area x1 := n:area:x0+sx
  area y1 := n:area:y0+sy-oy
      
browser_tag_draw select_options
  var Pointer:BrowserNode n :> document search_node attribute:"id"
  if not exists:n
    return
  if not has_area
    return
  if session:focus_id<>id
    return
  if not (attribute:"round" parse (var Float round))
    round := 1
  if not (attribute:"border" parse (var Float border))
    border := 0.001
  var CBool noborder := border=0.001
  if noborder
    border := (console:unit_x+console:unit_y)/2
  var Int color := console browser_color attribute:"background"
  if color=undefined
    color := 0FFFFD0h
  rectangle area:x0 area:y0 area:x1 area:y1 round undefined addressof:color
  var Int color := console browser_color attribute:"bordercolor"
  if color=undefined
    color := shunt noborder 0C0C0C0h 808080h
  if border>0
    rectangle area:x0 area:y0 area:x1 area:y1 round border addressof:color
  if not (attribute:"space_x" parse (var Float space_x))
    space_x := input_space_x
  if not (attribute:"space_y" parse (var Float space_y))
    space_y := input_space_y
  var Float ty := 0
  each sub n
    if sub:tag="option"
      font "select" (sub attribute "label") (var Link:Font font) (var Float scale) (var Int color)
      font bbox (sub attribute "label") null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
      text (sub attribute "label") font null (transform area:x0+space_x-scale*bx0 area:y0+space_y+ty-scale*by0 scale scale 0 0) addressof:color
      ty += scale*(by1-by0)

browser_tag_event select_options
  if event="focus" and key="off"
    session node_draw id
    document unstick node
  if event="release" and key="button1"
    var Pointer:BrowserNode n :> document search_node attribute:"id"
    if not exists:n
      return
    var Float ty := 0
    each sub n
      if sub:tag="option"
        font "select" (sub attribute "label") (var Link:Font font) (var Float scale) (var Int color)
        font bbox (sub attribute "label") null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
        if y>area:y0+ty and y<area:y0+ty+scale*(by1-by0)
          n attribute "value" := sub attribute "value"
        ty += scale*(by1-by0)
    session focus_set n:id n:id undefined ""


browser_tag_position button
  if (font "button" attribute:"label" (var Link:Font font) (var Float scale) (var Int color))=failure
    return
  var Str32 text := utf8_decode attribute:"label"
  font bbox text null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
  if not ((query "button" "space_x") parse (var Float space_x))
    space_x := button_space_x
  if not ((query "button" "space_y") parse (var Float space_y))
    space_y := button_space_y
  if not ((query "button" "border") parse (var Float border))
    border := 0.5
  area x0 := bx0*scale ; area y0 := by0*scale-space_y-border ; area x1 := bx1*scale+2*space_x+border ; area y1 := by1*scale+space_y # FIXME
  var Str key := attribute "key"
  if (key parse word:"alt" any:(var Str key2))
    key := key2
  if key<>"" 
    var Int i := text search key -1
    if i=(-1)
      if not ((query "button" "scale2") parse (var Float scale2))
        scale2 := scale/2
      area x1 += scale2*(font length " "+key null)
  addtoline node

browser_tag_draw button
  if not (attribute:"round" parse (var Float round))
    round := 1
  if not ((query "button" "border") parse (var Float border))
    border := 0.5
  var Int color := console browser_color attribute:"bordercolor"
  if color=undefined
    color := 0C0C0C0h
    if attribute:"selected"="true"
      color := 0A0A0A0h
  rectangle area:x0 area:y0 area:x1-border area:y1-border round undefined addressof:color
  var Int color := console browser_color attribute:"background"
  if color=undefined
    color := 888888h
    if attribute:"selected"="true"
      color := 444444h
  rectangle area:x0+border area:y0+border area:x1 area:y1 round undefined addressof:color
  if (font "button" attribute:"label" (var Link:Font font) (var Float scale) (var Int color))=failure
    return
  color := 0FFFFFFh
  if attribute:"active"="false"
    color := 0C0C0C0h
  var Str32 text := utf8_decode attribute:"label"
  font bbox text null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
  if not ((query "button" "space_x") parse (var Float space_x))
    space_x := button_space_x
  if not ((query "button" "space_y") parse (var Float space_y))
    space_y := button_space_y
  text text font null (transform area:x0+border+space_x-scale*bx0 area:y0+border+space_y-scale*by0 scale scale 0 0) addressof:color
  var Str key := attribute "key"
  if (key parse word:"alt" any:(var Str key2))
    key := key2
  if key<>""
    var Int highlight := console browser_color attribute:"highlight"
    if highlight=undefined
      highlight := 0FFFF80h
    var Int i := text search key text:len+1
    if i>=text:len
      if not ((query "button" "scale2") parse (var Float scale2))
        scale2 := scale/2
    else
      scale2 := scale
    var Vector2 v := font vector (text+" " 0 i) null
    text key font null (transform area:x0+border+space_x-scale*bx0+scale*v:x area:y0+border+space_y-scale*by0+scale*v:y scale2 scale2 0 0) addressof:highlight

browser_tag_event button
  # console "button event " event " key " key eol
  if event="press" and key="button1" or event="key"
    session focus_flush
    connection writeline "run "+string:(shunt (node attribute "id")<>"" (node attribute "id") node:id)+" "+(string attribute:"value")
    connection flush anytime
    # process_instructions
    session restore_connection
    event_discard