Patch title: Release 87 bulk changes
Abstract:
File: /pliant/graphic/browser/tag/form.pli
Key:
    Removed line
    Added line
module "common.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/language/type/text/istr.pli"
module "/pliant/util/encoding/http.pli"
module "text.pli"


type D2Option
  inherit D2Box
  field Str value
  field CBool selected <- false
  field (List Link:D2Box) content

D2Box maybe D2Option

method o configure attribute value options
  oarg_rw D2Option o ; arg Str attribute value options
  if attribute="value"
    o value := value
  eif attribute="selected"
    o selected := true

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

method o position c
  oarg_rw D2Option o ; arg_rw D2Context c
  o position_hidden c


function option_text b value -> label
  oarg_rw D2Box b ; arg Str value ; arg iStr label
  if (entry_type addressof:b)=D2Text
    return (addressof:b map D2Text):itext
  var Pointer:(List Link:D2Box) l :> b list
  if exists:l
    each bb l
      label := option_text bb value
      if label<>""
        return
  label := ""

function label_for b value -> label
  oarg_rw D2Box b ; arg Str value ; arg iStr label
  if (entry_type addressof:b)=D2Option
    if (addressof:b map D2Option):value=value
      return (option_text b value)
  var Pointer:(List Link:D2Box) l :> b list
  if exists:l
    each bb l
      label := label_for bb value
      if label<>""
        return
  label := ""

function value_for b -> value
  oarg_rw D2Box b ; arg Str value
  if (entry_type addressof:b)=D2Option
    if (addressof:b map D2Option):selected
      return (addressof:b map D2Option):value
  var Pointer:(List Link:D2Box) l :> b list
  if exists:l
    each bb l
      value := value_for bb
      if value<>""
        return
  value := ""

type D2Select
  inherit D2Box
  field Str name value
  field CBool selected <- false
  field (List Link:D2Box) content

D2Box maybe D2Select

method s configure attribute value options
  oarg_rw D2Select s ; arg Str attribute value options
  if attribute="name"
    s name := value

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

method s position c
  oarg_rw D2Select s ; arg_rw D2Context c
  if not s:selected
    s value := value_for s
    s selected := true
  var Str32 label := label_for s s:value
  c:font box label 0 0 c:scale s:x0 s:y0 s:x1 s:y1
  var Float u := c unit
  s y0 -= 2*u
  s x1 += 4*u
  s y1 += 2*u
  c addtoline s

method s draw img c
  oarg_rw D2Select s ; oarg_rw ImagePrototype img ; arg_rw D2Context c
  var Int ground := 0C0E8E8h
  var Float u := c unit
  img fill s:x0+u s:y0+u s:x1-u s:y1-u 2*u addressof:ground
  var Str32 label := label_for s s:value
  c:font box label 0 0 c:scale (var Float x0) (var Float y0) (var Float x1) (var Float y1)
  c:font draw label img s:x0+2*u s:y0+2*u-y0 c:scale (addressof c:color)

method s event e
  oarg_rw D2Select s ; arg_rw D2Event e


type D2Input
  inherit D2Box
  field Str type name value

D2Box maybe D2Input

method i configure attribute value options
  oarg_rw D2Input i ; arg Str attribute value options
  if attribute="type"
    i type := value
  eif attribute="name"
    i name := value
  eif attribute="value"
    i value := html_decode value

method i position c
  oarg_rw D2Input i ; arg_rw D2Context c
  if i:type="hidden"
    i position_hidden c
    return
  c:font box i:value 0 0 c:scale i:x0 i:y0 i:x1 i:y1
  var Float u := c unit
  i y0 -= 2*u
  i x1 += 4*u
  i y1 += 2*u
  c addtoline i

method i draw img c
  oarg_rw D2Input i ; oarg_rw ImagePrototype img ; arg_rw D2Context c
  if i:x0=undefined
    return
  var Int ground := shunt i:type="submit" 0FF8080h 0E0E0E0h
  var Float u := c unit
  img fill i:x0+u i:y0+u i:x1-u i:y1-u 2*u addressof:ground
  c:font box i:value 0 0 c:scale (var Float x0) (var Float y0) (var Float x1) (var Float y1)
  c:font draw i:value img i:x0+2*u i:y0+2*u-y0 c:scale (addressof c:color)


type D2Form
  inherit D2Box
  field (List Link:D2Box) content
  field Str action

D2Box maybe D2Form

function fill_form b form
  oarg_rw D2Box b ; arg_rw Str form
  if (entry_type addressof:b)=D2Input
    var Link:D2Input i :> addressof:b map D2Input
    if i:type<>"submit"
      form += replace "&"+i:name+"="+(http_encode i:value) " " "+"
  var Pointer:(List Link:D2Box) l :> b list
  if exists:l
    each bb l
      fill_form bb form

method i event e
  oarg_rw D2Input i ; arg_rw D2Event e
  if i:type="submit" and e:status:mouse_button_1_pressed
    if i:x0=defined and e:x>=i:x0 and e:x<=i:x1 and e:y>=i:y0 and e:y<=i:y1 and (exists e:form_box)
      e url := ((addressof e:form_box) map D2Form) action
      e form := replace i:name+"="+(http_encode i:value) " " "+"
      fill_form e:form_box e:form


method f configure attribute value options
  oarg_rw D2Form f ; arg Str attribute value options
  if attribute="action"
    f action := value

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

method f position c
  oarg_rw D2Form f ; arg_rw D2Context c
  f position_undefined c
    
method f draw img c
  oarg_rw D2Form f ; oarg_rw ImagePrototype img ; arg_rw D2Context c
  each b f:content
    b draw img c

method f event e
  oarg_rw D2Form f ; arg_rw D2Event e
  var Link:D2Box memo :> e form_box
  e form_box :> f
  each b f:content
    b event e
  e form_box :> memo

html_tags insert "form" true addressof:D2Form
html_tags insert "input" true addressof:D2Input
html_tags insert "select" true addressof:D2Select
html_tags insert "option" true addressof:D2Option