Patch title: Release 95 bulk changes
Abstract:
File: /pliant/graphic/layout/form.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/util/pml/io.pli"
module "prototype.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/console/prototype.pli"
module "helper/draw.pli"
module "helper/event.pli"
module "sequence.pli"
module "/pliant/util/encoding/utf8.pli"
module "/pliant/graphic/browser/client/context.pli"
module "/pliant/graphic/browser/client/window.pli"


public
  type LayoutInput
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    field LayoutArea bbox ; field Float tx ty
    field Str value
    field Str id
    field Int flags <- 0

LayoutPrototype maybe LayoutInput

function build i
  arg_w LayoutInput i
  i:bbox x0 := undefined


public
  type LayoutSelectOption
    field Str label
    field Str value

  type LayoutSelect
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    field LayoutArea bbox ; field Float tx ty
    field Str value
    field Str id
    field Int flags <- 0
    field List:LayoutSelectOption options

LayoutPrototype maybe LayoutSelect

function build s
  arg_w LayoutSelect s
  s:bbox x0 := undefined


method i bbox c -> b
  oarg_rw LayoutInput i ; arg_rw LayoutPC c ; arg LayoutArea b
  var Pointer:LayoutStyleInput s :> c:style input
  implicit s
    var Str32 v := utf8_decode i:value
    if (i:flags .and. 2)<>0
      v := repeat v:len "*"
    var Int start := v search "[lf]" v:len
    value_font bbox (v 0 start) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    while start<v:len
      start += 1
      var Int stop := ((v start v:len) search "[lf]" v:len-start)+start
      value_font bbox (v 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
    i:bbox x0 := bx0*value_scale-padding_x
    i:bbox y0 := by0*value_scale-padding_y
    i:bbox x1 := bx1*value_scale+padding_x
    i:bbox y1 := by1*value_scale+padding_y
  b := i bbox

method i translate tx ty
  oarg_rw LayoutInput i ; arg Float tx ty
  i tx := tx ; i ty := ty

method i offset tx ty
  oarg_rw LayoutInput i ; arg Float tx ty
  i tx += tx ; i ty += ty


method i draw d c
  arg_rw LayoutInput i ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  var Pointer:LayoutStyleInput s :> c:style input
  var Pointer:LayoutStyleFocus fs :> c:style focus
  implicit s
    d rectangle i:bbox:x0+i:tx i:bbox:y0+i:ty i:bbox:x1+i:tx i:bbox:y1+i:ty round undefined (c color background_color)
    if border_size>0
      d rectangle i:bbox:x0+i:tx i:bbox:y0+i:ty i:bbox:x1+i:tx i:bbox:y1+i:ty round border_size (c color border_color)
    var Str32 v := utf8_decode i:value
    if (i:flags .and. 2)<>0
      v := repeat v:len "*"
    var Int index := shunt (addressof c:window:session:focus_target)=addressof:i c:window:session:focus_index undefined
    var Int start := v search "[lf]" v:len
    value_font bbox (v 0 start) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    var Transform2 t := transform i:bbox:x0+padding_x-value_scale*bx0+i:tx i:bbox:y0+padding_y-value_scale*by0+i:ty value_scale value_scale 0 0
    d text (v 0 start) value_font null t (c color value_color)
    if index>=0 and index<=start
      var Float x := i:bbox:x0+padding_x-value_scale*bx0+value_scale*(value_font vector (v 0 index) null):x+i:tx
      d rectangle x t:yt+value_scale*value_font:bbox_y0 x+fs:thickness t:yt+value_scale*value_font:bbox_y1 (c color fs:color)
      c:window focus_area x t:yt+value_scale*value_font:bbox_y0 x+fs:thickness t:yt+value_scale*value_font:bbox_y1
    while start<v:len
      start += 1
      var Int stop := ((v start v:len) search "[lf]" v:len-start)+start
      value_font bbox (v start stop-start) null (var Float cx0) (var Float cy0) (var Float cx1) (var Float cy1)
      t yt += value_scale*(cy1-cy0)
      d text (v start stop-start) value_font null t (c color value_color)
      if index>=start and index<=stop
        var Float x := i:bbox:x0+padding_x-value_scale*bx0+value_scale*(value_font vector (v start index-start) null):x+i:tx
        d rectangle x t:yt+value_scale*value_font:bbox_y0 x+fs:thickness t:yt+value_scale*value_font:bbox_y1 (c color fs:color)
        c:window focus_area x t:yt+value_scale*value_font:bbox_y0 x+fs:thickness t:yt+value_scale*value_font:bbox_y1
      start := stop


method p next_input target found -> next
  oarg_rw LayoutPrototype p ; arg_rw LayoutPrototype target ; arg_rw CBool found ; arg_C LayoutPrototype next
  var Link:LayoutPrototype p2 :> p first
  while exists:p2
    if ((entry_type addressof:p2)=LayoutInput or (entry_type addressof:p2)=LayoutSelect) and found
    if p2:focusable and found
      next :> p2
      return
    if addressof:p2=addressof:target
      found := true
    next :> p2 next_input target found
    if exists:next
      return
    p2 :> p2 next
  next :> null map LayoutPrototype

method i event c
  oarg_rw LayoutInput i ; arg_rw LayoutEC c
  var Pointer:BrowserSession s :> c:window session
  var Pointer:LayoutStyleInput st :> c:style input
  implicit st
    var CBool pos := i:bbox:x0<>undefined
    var CBool resize := false
    var CBool redraw := false
    if c:mode=layout_event_pointer and c:x>=i:bbox:x0+i:tx and c:x<=i:bbox:x1+i:tx and c:y>=i:bbox:y0+i:ty and c:y<=i:bbox:y1+i:ty
      var Float x := i:bbox:x0+padding_x+i:tx ; var Float y := i:bbox:y0+padding_y-value_scale*value_font:bbox_y0+i:ty
      var Str32 v := i value
      part scan
        for (var Int index) 0 v:len-1
          var Float dx := value_scale*(value_font vector v:index:number):x
          if c:y>=y+value_scale*value_font:bbox_y0 and c:y<=y+value_scale*value_font:bbox_y1
            if c:x>=x and c:x<=x+dx
              leave scan
          if v:index="[lf]"
            x := i:bbox:x0+padding_x ; y += value_scale*(value_font:bbox_y1-value_font:bbox_y0)
          else
            x += dx
      c pointer_target :> i
      c pointer_index := index
      if c:event="press" and c:key="button1"
        if (addressof s:focus_target)<>addressof:i
          c set_focus i index
        else
          s set_focus_index index
          redraw := true
        s:console clipboard_target :> i
        s:console clipboard_index := index
        c cancel := true
      eif c:event="release" and c:key="button1" and (addressof s:console:clipboard_target)=addressof:i
        var Int i0 := min s:console:clipboard_index index
        var Int i1 := max s:console:clipboard_index index
        if i0>=0
          var Str32 v := utf8_decode i:value
          s:console clipboard_set_text utf8_encode:(v i0 i1-i0+1)
        c cancel := true
      eif c:event="press" and c:key="button2" and index>=0
        var Str32 v := utf8_decode i:value
        var Str32 cp := utf8_decode s:console:clipboard_get_text
        i value := utf8_encode (v 0 index)+cp+(v index v:len)
        s set_focus_index s:focus_index+cp:len
        resize := true ; redraw := true
        c cancel := true
      eif c:event="move" and (i:flags .and. 1)<>0
        c set_over i
        c cancel := true
    if c:mode=layout_event_focus and (addressof s:focus_target)=addressof:i
      var Int index := s focus_index
      if c:event="character"
        var Str32 v := utf8_decode i:value
        i value := utf8_encode (v 0 index)+(utf8_decode c:key)+(v index v:len)
        s set_focus_index s:focus_index+1
        resize := true ; redraw := true
      eif c:event="press" and c:key="enter" and (i:flags .and. 4)<>0
        var Str32 v := i value
        i value := utf8_encode (v 0 index)+"[lf]"+(v index v:len)
        s set_focus_index s:focus_index+1
        resize := true ; redraw := true
      eif c:event="press" and c:key="backspace" and index>0
        var Str32 v := utf8_decode i:value
        i value := utf8_encode (v 0 index-1)+(v index v:len)
        s set_focus_index s:focus_index-1
        resize := true ; redraw := true
      eif c:event="press" and c:key="tab"
        var Link:LayoutPrototype next :> c:window:root next_input i { var CBool found := false ; found }
        if exists:next
          c set_focus next 0
    if c:event="focus"
      if c:key="on"
        s focus_value := i value
      if (c:key="off" or c:key="sync") and i:value<>s:focus_value
        c:window:session:connection otag "set" i:id i:value
        c:window:session:connection flush anytime
        s focus_value := i value
      redraw := true
    if c:event="over"
      c:window:session:connection otag "over" i:id c:key="on"
      c:window:session:connection flush anytime
    if pos and resize
      var Str32 v := utf8_decode i:value
      if (i:flags .and. 2)<>0
        v := repeat v:len "*"
      var Int start := v search "[lf]" v:len
      value_font bbox (v 0 start) null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
      while start<v:len
        start += 1
        var Int stop := ((v start v:len) search "[lf]" v:len-start)+start
        value_font bbox (v 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
      var Float delta_x := (value_scale*(bx1-bx0)+2*padding_x) - (i:bbox:x1-i:bbox:x0)
      var Float delta_y := (value_scale*(by1-by0)+2*padding_y) - (i:bbox:y1-i:bbox:y0)
      if abs:delta_x>1e-6 or abs:delta_y>=1e-6
        c reposition i
        if delta_x>0
          i:bbox:x1 += delta_x
        if delta_y>0
          i:bbox:y1 += delta_y
    if pos and redraw
      c:window redraw_area i:bbox:x0+i:tx i:bbox:y0+i:ty i:bbox:x1+i:tx i:bbox:y1+i:ty

method i focusable -> c
  oarg_rw LayoutInput i ; arg CBool c
  c := true


method s bbox c -> b
  arg_rw LayoutSelect s ; arg_rw LayoutPC c ; arg LayoutArea b
  var Pointer:LayoutStyleInput st :> c:style input
  implicit st
    var Str label := ""
    each o s:options
      if o:value=s:value
        label := o label
    value_font bbox label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    s:bbox x0 := bx0*value_scale-padding_x
    s:bbox y0 := by0*value_scale-padding_y
    s:bbox x1 := bx1*value_scale+padding_x
    s:bbox y1 := by1*value_scale+padding_y
  b := s bbox

method s translate tx ty
  oarg_rw LayoutSelect s ; arg Float tx ty
  s tx := tx ; s ty := ty

method s offset tx ty
  oarg_rw LayoutSelect s ; arg Float tx ty
  s tx += tx ; s ty += ty


method s draw d c
  arg_rw LayoutSelect s ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  var Pointer:LayoutStyleInput st :> c:style input
  implicit st
    d rectangle s:bbox:x0+s:tx s:bbox:y0+s:ty s:bbox:x1+s:tx s:bbox:y1+s:ty round undefined (c color background_color)
    if border_size>0
      d rectangle s:bbox:x0+s:tx s:bbox:y0+s:ty s:bbox:x1+s:tx s:bbox:y1+s:ty round border_size (c color border_color)
      if round>0
        var Address color := (c color border_color)
        if (addressof c:window:session:focus_target)=addressof:s
          color := c color c:style:focus:color    
        d rectangle s:bbox:x1-2.001*round+s:tx s:bbox:y0+s:ty s:bbox:x1+s:tx s:bbox:y1+s:ty round border_size color
    var Str label := ""
    each o s:options
      if o:value=s:value
        label := o label
    value_font bbox label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    var Transform2 t := transform s:bbox:x0+padding_x-value_scale*bx0+s:tx s:bbox:y0+padding_y-value_scale*by0+s:ty value_scale value_scale 0 0
    d text label value_font null t (c color value_color)

 
public
  type LayoutSelectOptions
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    field Link:LayoutSelect select
    field LayoutArea bbox

LayoutPrototype maybe LayoutSelectOptions

function build s
  arg_w LayoutSelectOptions s
  s:bbox x0 := undefined


method so position c -> b
  arg_rw LayoutSelectOptions so ; arg_rw LayoutPC c ; arg LayoutArea b
  var Link:LayoutSelect s :> so select
  var Pointer:LayoutStyleInput st :> c:style input
  implicit st
    so:bbox x0 := s:bbox:x0+s:tx
    so:bbox y0 := s:bbox:y0+s:ty
    so:bbox x1 := s:bbox:x1+s:tx
    so:bbox y1 := so:bbox y0
    each o s:options
      if o:value=s:value
        so:bbox y0 += s:bbox:y0+s:ty-so:bbox:y1
        so:bbox y1 := s:bbox:y0+s:ty
      value_font bbox o:label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
      so:bbox x1 := max so:bbox:x1 so:bbox:x0+bx1*value_scale+2*padding_x
      so:bbox y1 += value_scale*(by1-by0)
    so:bbox x1 := max so:bbox:x1 so:bbox:x0+2.001*round
    so:bbox y1 := max (max s:bbox:y1 so:bbox:y1) so:bbox:y0+2.001*round
  b := so bbox

    
method so draw d c
  arg_rw LayoutSelectOptions so ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  if so:bbox:x0=undefined
    return
  var Link:LayoutSelect s :> so select
  var Pointer:LayoutStyleInput st :> c:style input
  implicit st
    d rectangle so:bbox:x0 so:bbox:y0 so:bbox:x1 so:bbox:y1 round undefined (c color background_color)
    if border_size>0
      d rectangle so:bbox:x0 so:bbox:y0 so:bbox:x1 so:bbox:y1 round border_size (c color border_color)
    var Float y := so:bbox:y0+padding_y-value_scale*value_font:bbox_y0
    each o s:options
      var Transform2 t := transform so:bbox:x0+padding_x y value_scale value_scale 0 0
      d text o:label value_font null t (c color value_color)
      y += value_scale*(value_font:bbox_y1-value_font:bbox_y0)
 

method s event c
  oarg_rw LayoutSelect s ; arg_rw LayoutEC c
  if c:mode=layout_event_pointer and c:x>=s:bbox:x0+s:tx and c:x<=s:bbox:x1+s:tx and c:y>=s:bbox:y0+s:ty and c:y<=s:bbox:y1+s:ty
    if c:event="press" and c:key="button1"
      var Link:LayoutSelectOptions o :> new LayoutSelectOptions
      o set_parent (null map LayoutPrototype)
      o select :> s
      c:window overlay :> o
      c:window orefresh := true
      c set_focus o 0
      c:window redraw_hurry
    eif c:event="move" and (s:flags .and. 1)<>0
      c set_over s
      c cancel := true
  if c:mode=layout_event_focus and (addressof c:window:session:focus_target)=addressof:s
    if c:event="press" and c:key="tab"
      var Link:LayoutPrototype next :> c:window:root next_input s { var CBool found := false ; found }
      if exists:next
        c set_focus next 0
  if c:event="focus"
    c:window redraw_area s:bbox:x0+s:tx s:bbox:y0+s:ty s:bbox:x1+s:tx s:bbox:y1+s:ty
  if c:event="over"
    c:window:session:connection otag "over" s:id c:key="on"
    c:window:session:connection flush anytime

method s focusable -> c
  oarg_rw LayoutSelect s ; arg CBool c
  c := true


method so event c
  oarg_rw LayoutSelectOptions so ; arg_rw LayoutEC c
  var Link:LayoutSelect s :> so select
  var Pointer:LayoutStyleInput st :> c:style input
  implicit st
    if c:mode=layout_event_pointer and c:x>=so:bbox:x0 and c:x<=so:bbox:x1 and c:y>=so:bbox:y0 and c:y<=so:bbox:y1
      if c:event="release" and c:key="button1"
        var Int index := cast (c:y-so:bbox:y0)/(st:value_font:bbox_y1-st:value_font:bbox_y0)/st:value_scale-0.5 Int
        var Int i := 0
        each o s:options
          if i=index
            s value := o value
          i += 1
        c set_focus s 0
        c:window redraw_hurry
    if c:event="focus"
      var Pointer:BrowserSession session :> c:window session
      if c:key="on"
        session focus_value := s value
      if (c:key="off" or c:key="sync") and s:value<>session:focus_value
        session:connection otag "set" s:id s:value
        session:connection flush anytime
        session focus_value := s value
      if c:key="off"
        if (addressof c:window:overlay)=addressof:so
          session discard so
          c:window overlay :> null map LayoutPrototype
          c:window redraw_area so:bbox:x0 so:bbox:y0 so:bbox:x1 so:bbox:y1

method so focusable -> c
  oarg_rw LayoutSelectOptions so ; arg CBool c
  c := true


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


public
  type LayoutButton
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    field Str label
    field Str id
    field Str key
    field Int flags <- 0 # 1 selected, 2 mouse over hook
    field LayoutArea bbox ; field Float tx ty

LayoutPrototype maybe LayoutButton

function build b
  arg_w LayoutButton b
  b:bbox x0 := undefined


method b bbox c -> bbox
  arg_rw LayoutButton b ; arg_rw LayoutPC c ; arg LayoutArea bbox
  var Pointer:LayoutStyleButton s :> c:style button
  implicit s
    label_font bbox b:label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    b:bbox x0 := bx0*label_scale-s:padding_x
    b:bbox y0 := by0*label_scale-s:padding_y-border_size
    b:bbox x1 := bx1*label_scale+padding_x+border_size
    b:bbox y1 := by1*label_scale+padding_y
    if b:key<>"" and not (b:key parse word:"alt" any:(var Str key2)) or key2="" or (b:label search key2 -1)=(-1)
      b:bbox x1 += key_padding+key_scale*(key_font length b:key null)
    if (b:flags .and. 2)<>0
      void # FIXME: stretch b:bbox x1 := c:area x1
  bbox := b bbox

method b translate tx ty
  oarg_rw LayoutButton b ; arg Float tx ty
  b tx := tx ; b ty := ty

method b offset tx ty
  oarg_rw LayoutButton b ; arg Float tx ty
  b tx += tx ; b ty += ty


method b draw d c
  arg_rw LayoutButton b ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  var Pointer:LayoutStyleButton s :> c:style button
  implicit s
    var CBool selected := (b:flags .and. 4)<>0
    d rectangle b:bbox:x0+b:tx b:bbox:y0+b:ty b:bbox:x1-border_size+b:tx b:bbox:y1-border_size+b:ty round undefined (shunt b:id="" (c color inactive_border_color) selected (c color selected_border_color) (c color border_color))
    d rectangle b:bbox:x0+border_size+b:tx b:bbox:y0+border_size+b:ty b:bbox:x1+b:tx b:bbox:y1+b:ty round undefined (shunt b:id="" (c color inactive_background_color) selected (c color selected_background_color) (c color background_color))
    label_font bbox b:label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    var Transform2 t := transform b:bbox:x0+border_size+padding_x-label_scale*bx0+b:tx b:bbox:y0+border_size+padding_y-label_scale*by0+b:ty label_scale label_scale 0 0
    d text b:label label_font null t (shunt b:id="" (c color inactive_label_color) selected (c color selected_label_color) (c color label_color))
    if b:key=""
      void
    eif (b:key parse word:"alt" any:(var Str key2)) and key2<>"" and { var Int i := (cast b:label Str32) search key2 -1 ; i<>(-1) }
      t xt += label_scale*(label_font length ((cast b:label Str32) 0 i) null)
      d text key2 label_font null t (shunt b:id="" (c color inactive_key_color) selected (c color selected_key_color) (c color key_color))
    else
      t xt += label_scale*(label_font length b:label null)+key_padding
      t xx := key_scale ; t yy := key_scale
      d text b:key key_font null t (shunt b:id="" (c color inactive_key_color) selected (c color selected_key_color) (c color key_color))


method b event c
  oarg_rw LayoutButton b ; arg_rw LayoutEC c
  if c:mode=layout_event_pointer and c:x>=b:bbox:x0+b:tx and c:x<=b:bbox:x1+b:tx and c:y>=b:bbox:y0+b:ty and c:y<=b:bbox:y1+b:ty
    if c:event="press" and c:key="button1"
      if b:id<>""
        c focus_sync
        c:window:session:connection otag "run" b:id
        c:window:session:connection flush anytime
        c cancel := true
    eif c:event="move" and (b:flags .and. 1)<>0
      c set_over b
      c cancel := true
  eif c:mode=layout_event_shortcut
    if c:event="press" and c:key=b:key
      if b:id<>""
        c focus_sync
        c:window:session:connection otag "run" b:id
        c:window:session:connection flush anytime
        c cancel := true
  eif c:event="over"
    c:window:session:connection otag "over" b:id c:key="on"
    c:window:session:connection flush anytime


public
  type LayoutLink
    field Link:LayoutPrototype next
    field Int parent_and_flags <- 0
    field Str label
    field Str id
    field LayoutArea bbox ; field Float tx ty

LayoutPrototype maybe LayoutLink

function build l
  arg_w LayoutLink l
  l:bbox x0 := undefined


method l bbox c -> b
  arg_rw LayoutLink l ; arg_rw LayoutPC c ; arg LayoutArea b
  var Pointer:LayoutStyleText s :> c:style text
  implicit s
    font:0 bbox l:label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    l:bbox x0 := bx0*scale
    l:bbox y0 := by0*scale
    l:bbox x1 := bx1*scale
    l:bbox y1 := by1*scale
  b := l bbox

method l translate tx ty
  oarg_rw LayoutLink l ; arg Float tx ty
  l tx := tx ; l ty := ty

method l offset x y
  oarg_rw LayoutLink l ; arg Float x y
  l tx += x ; l ty += y


method l draw d c
  arg_rw LayoutLink l ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  var Pointer:LayoutStyleText s :> c:style text
  implicit s
    # font:0 bbox l:label null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1)
    d text l:label font:0 null (transform l:tx l:ty scale scale 0 0) (c color c:style:link:color)


method l event c
  arg_rw LayoutLink l ; arg_rw LayoutEC c
  if c:mode=layout_event_pointer and c:x>=l:bbox:x0+l:tx and c:x<=l:bbox:x1+l:tx and c:y>=l:bbox:y0+l:tx and c:y<=l:bbox:y1+l:ty
    if c:event="press" and c:key="button1"
      c focus_sync
      c:window:session:connection otag "run" l:id
      c:window:session:connection flush anytime