Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/browser/naive/context2.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/misc/float.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/math/vector.pli"
module "/pliant/math/curve.pli"
module "/pliant/language/type/text/str32.pli"
module "/pliant/util/encoding/utf8.pli"
module "document.pli"
submodule "document2.pli"
module "context.pli"
module "tag/prototype.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/antialiasing.pli"
module "/pliant/graphic/draw/image.pli"
module "/pliant/graphic/console/prototype.pli"
module "/pliant/util/crypto/channel.pli"
module "/pliant/language/stream/filesystembase.pli"
module "tcp.pli"
module "trace.pli"


method con browser_color s -> c
  arg BrowserConsole con ; arg Str s ; arg Int c
  function hexa s -> i
    arg Str s ; arg Int i
    i := 0
    for (var Int index) 0 s:len-1
      var Int c := s:index:number
      if c>="0":number and c<="9":number
        i := i*16+(c-"0":number)
      eif c>="A":number and c<="Z":number
        i := i*16+(c+10-"A":number)
      eif c>="a":number and c<="z":number
        i := i*16+(c+10-"a":number)
  if s:len=6 and { var Int rgb := hexa s ; rgb<>undefined }
    con:gamut convert con:rgb addressof:rgb addressof:c 1 null
  else
    c := undefined


method context jump node
  arg_rw BrowserContext context ; arg BrowserNode node
  var (List Pointer:BrowserNode) nodes
  var Pointer:BrowserNode n :> node
  while exists:n
    nodes += n
    n :> n parent
  var (Pointer Pointer:BrowserNode) p :>> nodes last
  while exists:p
    context set_attributes p
    p :>> nodes previous p


method s window name -> w
  arg BrowserSession s ; arg Str name ; arg_C BrowserWindow w
  each ww s:windows
    if ww:name=name
      w :> ww
      return
  w :> null map BrowserWindow
  

method s window n -> w
  arg BrowserSession s ; arg BrowserNode n ; arg_C BrowserWindow w
  if exists:n
    var Pointer:BrowserNode root :> n
    while (exists root:parent)
      root :> root parent
    each ww s:windows
      if ww:root=root:id
        w :> ww
        return
      if ww:overlay=root:id
        w :> ww
        return
  w :> null map BrowserWindow


export '. browser_color' '. jump' '. window' '. window'


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


method console connect url stream -> status
  arg_rw BrowserConsole console ; arg Str url ; arg_rw Stream stream ; arg ExtendedStatus status
  if not (url eparse any:(var Str protocol) "://" any:(var Str host_and_port) "/" any)
    return failure
  if protocol="loopback"
    status := stream open "loopback:/client/"+host_and_port in+out+safe+noautopost
  else
    if not (host_and_port parse any:(var Str host) ":" (var Int port))
      host := host_and_port ; port := browser_default_tcp_port
    status := stream open "tcp://"+host+"/client/"+string:port in+out+safe+noautopost


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


constant standard_font_family "[dq]Free Sans[dq] italic [dq] Oblique[dq]"
constant fixed_font_family "[dq]Free Monospaced[dq] italic [dq] Oblique[dq]"


method c font_name def -> name
  arg BrowserContext c ; arg Str def name
  if not (def parse (var Str face) any:(var Str options))
    face := def ; options := ""
  var Str regular := options option "regular" Str
  var Str bold := options option "bold" Str " Bold"
  var Str italic := options option "italic" Str " Italic"
  name := face+(shunt (c query "bold") bold regular)+(shunt (c query "italic") italic "")

method c font tag_id text f scale color -> status
  arg_rw BrowserContext c ;  arg Str tag_id ; arg Str32 text ; arg_w Link:Font f ; arg_w Float scale ; arg_rw Int color ; arg Status status
  if false
    f :> font (c font_name (c query tag_id "face"))
    if not exists:f
      f :> font (c query tag_id "face")
    if not exists:f
      var Str default := shunt (c query "fixed") fixed_font_family standard_font_family
      f :> font (c font_name default)
      if not exists:f
        console "Error: font '"+default+"' is missing in your system." eol
  else
    var Str fname := c font_name (shunt (c query tag_id "face")<>"" (c query tag_id "face") (c query "fixed") fixed_font_family standard_font_family)
    f :> (c:document:attached first "font "+fname) map Font
    if not exists:f or (entry_type addressof:f)<>Font
      c:console connect c:session:path (var Stream s)
      s writeline "font "+string:fname
      s flush anytime
      var Str answer := s readline
      if (answer parse word:"font" any:(var Str options))
        f :> new Font
        f fullname := fname
        f id := generate_id
        (options (options option_position "bbox" 0) options:len) parse word:"bbox" f:bbox_x0 f:bbox_y0 f:bbox_x1 f:bbox_y1 any
        (options (options option_position "vector" 0) options:len) parse word:"vector" f:vector:x " " f:vector:y any
        f fixed := options option "fixed"
        c:document:attached insert "font "+fname true addressof:f
  if not exists:f
    return failure
  if not ((c query tag_id "size") parse scale)
    scale := 12*25.4/72
  color := c:console browser_color (c query tag_id "color")
  var Str missings := ""
  for (var Int i) 0 text:len-1
    var Pointer:FontChar char :> f:chars first text:i:number
    if not exists:char
      var Str missing := utf8_encode (text i 1)
      if (missings search missing -1)=(-1)
        missings += missing
  if missings<>""
    # console "fetching "+string:missings+" "+(string missings:len)+"[lf]"
    c:console connect c:session:path (var Stream s)
    s writeline "char "+(string f:fullname)+" "+string:missings
    s flush anytime
    while { var Str l := s readline ; l parse word:"char" (var Int i) any:(var Str options) }
      var Pointer:FontChar char :> f:chars first i
      if not exists:char
        # console "receive character " i eol
        var FontChar ch
        (options (options option_position "bbox" 0) options:len) parse word:"bbox" ch:bbox_x0 ch:bbox_y0 ch:bbox_x1 ch:bbox_y1 any
        (options (options option_position "vector" 0) options:len) parse word:"vector" ch:vector:x " " ch:vector:y any
        ch:curves size := 0
        while { var Str l := s readline ; l parse word:"c" (var Int mode) }
          (var Curve curve) reset
          part read_point
            var Str l := s readline
            var CurvePoint point := curve_point 0 0 true
            if (l parse "a" point:x point:y)
              curve angle point:x point:y
              restart read_point
            eif (l parse "p" point:x point:y point:in_x point:in_y point:out_x point:out_y)
              curve += point
              restart read_point
            else
              s unreadline l
            curve compute mode
            ch:curves += curve
        s unreadline l
        f:chars insert i ch
  status := success

method c font tag_id text f scale color -> status
  arg_rw BrowserContext c ;  arg Str tag_id text ; arg_w Link:Font f ; arg_w Float scale ; arg_rw Int color ; arg Status status
  status := c font tag_id utf8_decode:text f scale color

export '. font'


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


method c position_recurse n
  arg_rw BrowserContext c ; arg_rw BrowserNode n
  each sub n
    c position sub

method c position_container n
  arg_rw BrowserContext c ; arg_rw BrowserNode n
  function position_include b c
    arg_rw BrowserNode b c
    if b:has_area
      c:area x0 := min c:area:x0 b:area:x0
      c:area y0 := min c:area:y0 b:area:y0
      c:area x1 := max c:area:x1 b:area:x1
      c:area y1 := max c:area:y1 b:area:y1
    else
      each bb b
        position_include bb c
  n:area x0 := float_max
  n:area y0 := float_max
  n:area x1 := float_min
  n:area y1 := float_min
  each sub n
    position_include sub n
  if n:area:x0=float_max
    memory_free n:extra ; n extra := null

function position_translate n tx ty
  arg_rw BrowserNode n ; arg Float tx ty
  if n:has_area
    n:area x0 += tx
    n:area y0 += ty
    n:area x1 += tx
    n:area y1 += ty
  each sub n
    position_translate sub tx ty


method c draw_recurse n
  arg_rw BrowserContext c ; arg_rw BrowserNode n
  each sub n
    c draw sub


export '. position_recurse' '. position_container' position_translate
export '. draw_recurse'


#-------------------------------------------------------------------------------
#  screen layout and redraw


method w draw n1 n2 x0 y0 x1 y1
  arg_rw BrowserWindow w ; arg_rw BrowserNode n1 n2 ; arg Int x0 y0 x1 y1
  check w:x0<>undefined and x0>=w:x0 and y0>=w:y0 and x1<=w:x1 and y1<=w:y1 and x1>x0 and y1>y0
  var Pointer:BrowserConsole c :> w:session console
  var Link:ImagePixmap pm :> new ImagePixmap
  pm setup (image_prototype (w:scroll_x+x0-w:x0)*c:unit_x/w:scale (w:scroll_y+y0-w:y0)*c:unit_y/w:scale (w:scroll_x+x1-w:x0)*c:unit_x/w:scale (w:scroll_y+y1-w:y0)*c:unit_y/w:scale (x1-x0)*w:antialiasing (y1-y0)*w:antialiasing c:gamut) ""
  for (var Int y) 0 pm:size_y-1
    pm fill 0 y pm:size_x (addressof w:border_color)
  if exists:n1 or exists:n2
    var Link:DrawImage draw :> new DrawImage
    draw bind pm (shunt w:antialiasing>1 "text_speedup 1" "text_speedup 2")
    var BrowserContext context
    context bind w:session (null map Stream)
    var Float t := w:session:focus_thickness
    context draw_setup draw pm:x0-t pm:y0-t pm:x1+t pm:y1+t
    if exists:n1
      context mark
      context jump n1
      context draw n1
      context rewind
    if exists:n2
      context mark
      context jump n2
      context draw n2
      context rewind
  if w:antialiasing>1
    var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
    aa bind pm w:antialiasing w:antialiasing
    c:console paint aa x0 y0
  else
    c:console paint pm x0 y0
  # console "draw " w:root " " x0 " " y0 " " x1 " " y1 eol
  
method w draw x0 y0 x1 y1
  arg_rw BrowserWindow w ; arg Int x0 y0 x1 y1
  w draw (w:session:document search_node w:root) (w:session:document search_node w:overlay) x0 y0 x1 y1

method w draw_area x0 y0 x1 y1
  arg_rw BrowserWindow w ; arg Float x0 y0 x1 y1
  var Pointer:BrowserConsole c :> w:session console
  var Int ix0 := max (cast x0/c:unit_x*w:scale-0.5 Int)-w:scroll_x+w:x0 w:x0
  var Int iy0 := max (cast y0/c:unit_y*w:scale-0.5 Int)-w:scroll_y+w:y0 w:y0
  var Int ix1 := min (cast x1/c:unit_x*w:scale+0.5 Int)-w:scroll_x+w:x0 w:x1
  var Int iy1 := min (cast y1/c:unit_y*w:scale+0.5 Int)-w:scroll_y+w:y0 w:y1
  if ix1>ix0 and iy1>iy0
    w draw ix0 iy0 ix1 iy1


type BrowserDraw
  field Int dx0 dy0 dx1 dy1
  field Pointer:BrowserWindow w
  field Int sx0 sy0 sx1 sy1
  field CBool processed

function browser_draw dx0 dy0 dx1 dy1 w sx0 sy0 sx1 sy1 -> d
  arg Int dx0 dy0 dx1 dy1 ; arg BrowserWindow w ; arg Int sx0 sy0 sx1 sy1 ; arg BrowserDraw d
  if sx1<sx0 or sy1<sy0
    error "wrong copy area source "+string:sx0+" "+string:sy0+" "+string:sx1+" "+string:sy1
  if dx1<dx0 or dy1<dy0
    error "wrong copy area dest "+string:dx0+" "+string:dy0+" "+string:dx1+" "+string:dy1
  d dx0 := dx0 ; d dy0 := dy0 ; d dx1 := dx1 ; d dy1 := dy1 
  d w :> w 
  d sx0 := sx0 ; d sy0 := sy0 ; d sx1 := sx1 ; d sy1 := sy1 
  d processed := false

method w move x0 y0 x1 y1 dl
  arg_rw BrowserWindow w ; arg Int x0 y0 x1 y1 ; arg_rw List:BrowserDraw dl
  var Pointer:BrowserConsole c :> w:session console
  if x0=undefined or w:refresh=2
    w x0 := x0 ; w y0 := y0 ; w x1 := x1 ; w y1 := y1
  eif w:x0=undefined
    check x0>=0 and y0>=0 and x1<=c:size_x and y1<=c:size_y and x1>x0 and y1>y0
    w x0 := x0 ; w y0 := y0 ; w x1 := x1 ; w y1 := y1
    dl += browser_draw x0 y0 x1 y1 w undefined undefined undefined undefined
  else
    check x0>=0 and y0>=0 and x1<=c:size_x and y1<=c:size_y and x1>x0 and y1>y0
    w x1 := min w:x1 w:x0+x1-x0
    w y1 := min w:y1 w:y0+y1-y0
    if w:x1>w:x0 and w:y1>w:y0 and (x0<>w:x0 or y0<>w:y0)
      dl += browser_draw x0 y0 x0+(w:x1-w:x0) y0+(w:y1-w:y0) (null map BrowserWindow) w:x0 w:y0 w:x1 w:y1
    w x1 += x0-w:x0 ; w x0 := x0
    w y1 += y0-w:y0 ; w y0 := y0
    if w:x1<x1
      var Int dx := x1-w:x1 ; w x1 := x1
      if w:y1>w:y0
        dl += browser_draw w:x1-dx w:y0 w:x1 w:y1 w undefined undefined undefined undefined
    if w:y1<y1
      var Int dy := y1-w:y1 ; w y1 := y1
      if w:x1>w:x0
        dl += browser_draw w:x0 w:y1-dy w:x1 w:y1 w undefined undefined undefined undefined
    check w:x0=x0 and w:y0=y0 and w:x1=x1 and w:y1=y1
  if w:overlay<>""
    var Link:ImagePixmap pm :> new ImagePixmap
    pm setup (image_prototype w:scroll_x*c:unit_x/w:scale w:scroll_y*c:unit_y/w:scale (w:scroll_x+x1-x0)*c:unit_x/w:scale (w:scroll_y+y1-y0)*c:unit_y/w:scale x1-x0 y1-y0 c:gamut) ""
    w underlay :> pm

method w scroll sx sy
  arg_rw BrowserWindow w ; arg Int sx sy
  var Pointer:BrowserConsole c :> w:session console
  var Int mini := cast w:bbox:x0/c:unit_x*w:scale-0.5 Int
  var Int maxi := (cast w:bbox:x1/c:unit_x*w:scale+0.5 Int)-(w:x1-w:x0)
  var Int dx := w:scroll_x-(max (min sx maxi) mini)
  w scroll_x -= dx
  var Int mini := cast w:bbox:y0/c:unit_y*w:scale-0.5 Int
  var Int maxi := (cast w:bbox:y1/c:unit_y*w:scale+0.5 Int)-(w:y1-w:y0)
  var Int dy := w:scroll_y-(max (min sy maxi) mini)
  w scroll_y -= dy
  if dx=0 and dy=0
    void
  eif abs:dx<w:x1-w:x0 and abs:dy<w:y1-w:y0
    c:console copy w:x0+(max -dx 0) w:y0+(max -dy 0) w:x1-(max dx 0) w:y1-(max dy 0) w:x0+(max dx 0) w:y0+(max dy 0)
    if dx>0
      w draw w:x0 w:y0 w:x0+dx w:y1
    eif dx<0
      w draw w:x1+dx w:y0 w:x1 w:y1
    if dy>0
      w draw w:x0 w:y0 w:x1 w:y0+dy
    eif dy<0
      w draw w:x0 w:y1+dy w:x1 w:y1
  else
    w draw w:x0 w:y0 w:x1 w:y1


method w position n x0 y0 x1 y1 extend
  arg_rw BrowserWindow w ; arg_rw BrowserNode n ; arg Float x0 y0 x1 y1 ; arg CBool extend
  var Pointer:BrowserConsole c :> w:session console
  if exists:n
    var BrowserContext context
    context bind w:session (null map Stream)
    context position_setup x0 y0 x1 y1 extend
    context mark
    context jump n
    context position n
    context rewind
  if addressof:n=addressof:(w:session:document search_node w:root)
    if exists:n and n:has_area
      w bbox := n area
    else
      w:bbox x0 := undefined ; w:bbox y0 := undefined ; w:bbox x1 := undefined ; w:bbox y1 := undefined
  
method w position extend
  arg_rw BrowserWindow w ; arg CBool extend
  var Pointer:BrowserConsole c :> w:session console
  if not extend
    w position (w:session:document search_node w:root) 0 0 c:size_x*c:unit_x/w:scale c:size_y*c:unit_y/w:scale extend
  else
    w position (w:session:document search_node w:root) 0 0 (w:x1-w:x0)*c:unit_x/w:scale (w:y1-w:y0)*c:unit_y/w:scale extend


method w layout x0 y0 x1 y1 dl
  arg_rw BrowserWindow w ; arg Int x0 y0 x1 y1 ; arg_rw List:BrowserDraw dl
  var Pointer:BrowserConsole c :> w:session console
  check x0>=0 and y0>=0 and x1<=c:size_x and y1<=c:size_y and x1>x0 and y1>y0
  var Int wx0 wy0 wx1 wy1
  wx0 := x0 ; wy0 := y0 ; wx1 := x1 ; wy1 := y1
  var Int b := w border_size
  if b>0
    var BrowserSpace sp ; sp color := w border_color
    sp x0 := wx0 ; sp y0 := wy0 ; sp x1 := wx1 ; sp y1 := wy0+b ; c spaces += sp
    wy0 += b
    sp x0 := wx0 ; sp y0 := wy0 ; sp x1 := wx0+b ; sp y1 := wy1 ; c spaces += sp
    wx0 += b
    sp x0 := wx1-b ; sp y0 := wy0 ; sp x1 := wx1 ; sp y1 := wy1 ; c spaces += sp
    wx1 -= b
    sp x0 := wx0 ; sp y0 := wy1-b ; sp x1 := wx1 ; sp y1 := wy1 ; c spaces += sp
    wy1 -= b
  w move wx0 wy0 wx1 wy1 dl


method c layout1
  arg_rw BrowserConsole c
  var Int exclude := 0
  for (var Int i) 0 c:zorder:size-1
    var Pointer:BrowserSession s :> c:session c:zorder:i
    var Int ix := s:position%3
    var Int iy := s:position\3
    var Int cover := (shunt ix=2 or iy=2 0 1)+(shunt ix=0 or iy=2 0 2)+(shunt ix=2 or iy=0 0 4)+(shunt ix=0 or iy=0 0 8)
    each w s:windows
      var CBool border := w:name="left" or w:name="top" or w:name="right" or w:name="bottom"
      var CBool visible := shunt w:name="right" c:zorder:i=11 border i=0 (exclude .and. cover)=0
      if visible
        if w:x0=undefined
          w x0 := 0 ; w y0 := 0 ; w x1 := 0 ; w y1 := 0
      else
        w x0 := undefined ; w y0 := undefined ; w x1 := undefined ; w y1 := undefined
      if border and visible
        exclude := exclude .or. cover


method c layout2
  arg_rw BrowserConsole c
  var Pointer:BrowserSession s :> c:session c:zorder:0
  var Pointer:BrowserWindow left :> s window "left"
  var Pointer:BrowserWindow top :> s window "top"
  var Pointer:BrowserWindow right :> c:session:11 window "right"
  var Pointer:BrowserWindow bottom :> s window "bottom"
  c spaces := var List:BrowserSpace empty_space_list
  var List:BrowserDraw dl
  var Int x0 := 0
  var Int y0 := 0
  var Int x1 := c size_x
  var Int y1 := c size_y
  if exists:top and top:bbox:x0=defined
    var Int n := min (cast (top:bbox:y1-top:bbox:y0)/c:unit_y+0.5 Int)+2*top:border_size (cast c:size_y*top:fraction Int)
    if x1-x0>2*bottom:border_size and n>2*top:border_size
      top layout x0 y0 x1 y0+n dl
      y0 += n
      if s:space_size>0
        var BrowserSpace sp ; sp x0 := x0 ; sp y0 := y0 ; sp x1 := x1 ; sp y1 := y0+s:space_size ; sp color := s space_color ; c spaces += sp
        y0 += s space_size    
    else
      top x0 := undefined ; top y0 := undefined ; top x1 := undefined ; top y1 := undefined
  else
    top x0 := undefined ; top y0 := undefined ; top x1 := undefined ; top y1 := undefined
  if exists:bottom and bottom:bbox:x0=defined
    var Int n := min (cast (bottom:bbox:y1-bottom:bbox:y0)/c:unit_y+0.5 Int)+2*bottom:border_size (cast c:size_y*bottom:fraction Int)
    if x1-x0>2*bottom:border_size and n>2*bottom:border_size
      bottom layout x0 y1-n x1 y1 dl
      y1 -= n
      if s:space_size>0
        var BrowserSpace sp ; sp x0 := x0 ; sp y0 := y1-s:space_size ; sp x1 := x1 ; sp y1 := y1 ; sp color := s space_color ; c spaces += sp
        y1 -= s space_size    
    else
      bottom x0 := undefined ; bottom y0 := undefined ; bottom x1 := undefined ; bottom y1 := undefined
  else
    bottom x0 := undefined ; bottom y0 := undefined ; bottom x1 := undefined ; bottom y1 := undefined
  if exists:left and left:bbox:x0=defined
    var Int n := min (cast (left:bbox:x1-left:bbox:x0)/c:unit_x+0.5 Int)+2*left:border_size (cast c:size_x*left:fraction Int)
    if n>2*left:border_size and y1-y0>2*left:border_size
      left layout x0 y0 x0+n y1 dl
      x0 += n
      if s:space_size>0
        var BrowserSpace sp ; sp x0 := x0 ; sp y0 := y0 ; sp x1 := x0+s:space_size ; sp y1 := y1 ; sp color := s space_color ; c spaces += sp
        x0 += s space_size    
    else
      left x0 := undefined ; left y0 := undefined ; left x1 := undefined ; left y1 := undefined
  else
    left x0 := undefined ; left y0 := undefined ; left x1 := undefined ; left y1 := undefined
  if exists:right and right:bbox:x0=defined
    var Int n := min (cast (right:bbox:x1-right:bbox:x0)/c:unit_x+0.5 Int)+2*right:border_size (cast c:size_x*right:fraction Int)
    if n>2*right:border_size and y1-y0>2*right:border_size
      right layout x1-n y0 x1 y1 dl
      x1 -= n
      if s:space_size>0
        var BrowserSpace sp ; sp x0 := x1-s:space_size ; sp y0 := y0 ; sp x1 := x1 ; sp y1 := y1 ; sp color := s space_color ; c spaces += sp
        x1 -= s space_size    
    else
      right x0 := undefined ; right y0 := undefined ; right x1 := undefined ; right y1 := undefined
  else
    right x0 := undefined ; right y0 := undefined ; right x1 := undefined ; right y1 := undefined
  var Int exclude := 0
  var Int mx0 := cast x0*(1-c:middle_x)+x1*c:middle_x-s:space_size/2 Int
  var Int mx1 := mx0+s:space_size
  var Int my0 := cast y0*(1-c:middle_y)+y1*c:middle_y-s:space_size/2 Int
  var Int my1 := my0+s:space_size
  for (var Int i) 0 c:zorder:size-1
    var Pointer:BrowserSession s :> c:session c:zorder:i
    var Pointer:BrowserWindow w :> s window "main"
    if exists:w
      var Int ix := s:position%3
      var Int iy := s:position\3
      var Int wx0 := shunt ix<2 x0 mx1
      var Int wy0 := shunt iy<2 y0 my1
      var Int wx1 := shunt ix>0 x1 mx0
      var Int wy1 := shunt iy>0 y1 my0
      var Int cover := (shunt ix=2 or iy=2 0 1)+(shunt ix=0 or iy=2 0 2)+(shunt ix=2 or iy=0 0 4)+(shunt ix=0 or iy=0 0 8)
      if (exclude .and. cover)=0
        w layout wx0 wy0 wx1 wy1 dl
        if ix<>1 or iy<>1
          var BrowserSpace sp ; sp x0 := mx0 ; sp y0 := my0 ; sp x1 := mx1 ; sp y1 := my1 ; sp color := s space_color ; c spaces += sp
          if ix<>1
            var BrowserSpace sp ; sp x0 := mx0 ; sp y0 := wy0 ; sp x1 := mx1 ; sp y1 := wy1 ; sp color := s space_color ; c spaces += sp
          if iy<>1
            var BrowserSpace sp ; sp x0 := wx0 ; sp y0 := my0 ; sp x1 := wx1 ; sp y1 := my1 ; sp color := s space_color ; c spaces += sp
        exclude := exclude .or. cover
      else
        w x0 := undefined ; w y0 := undefined ; w x1 := undefined ; w y1 := undefined
  for (var Int i) 0 3
    if (exclude .and. 2^i)=0
      var Pointer:BrowserWindow w :> c:session:0 window "right"
      if exists:w
        var Int wx0 := shunt i%2=0 x0 mx1
        var Int wy0 := shunt i\2=0 y0 my1
        var Int wx1 := shunt i%2=1 x1 (shunt (exclude .and. 2^(i+1))=0 mx1 mx0)
        var Int wy1 := shunt i\2=1 y1 (shunt (exclude .and. 2^(i+2))=0 my1 my0)
        var BrowserSpace sp ; sp x0 := wx0 ; sp y0 := wy0 ; sp x1 := wx1 ; sp y1 := wy1 ; sp color := w border_color ; c spaces += sp
  var Pointer:BrowserSession s :> c:session c:zorder:0
  var Pointer:BrowserWindow w :> s window "main"
  if exists:w and s:position<>4
    var BrowserSpace sp ; sp color := s space_active_color
    var Int b := w border_size
    sp x0 := max w:x0-b-1 0 ; sp y0 := max w:y0-b-1 0 ; sp x1 := min w:x1+b+1 c:size_x ; sp y1 := w:y0-b
    if sp:x1>sp:x0 and sp:y1>sp:y0
      c spaces += sp
    sp x0 := max w:x0-b-1 0 ; sp y0 := max w:y0-b-1 0 ; sp x1 := w:x0-b ; sp y1 := min w:y1+b+1 c:size_y
    if sp:x1>sp:x0 and sp:y1>sp:y0
      c spaces += sp
    sp x0 := w:x1+b ; sp y0 := max w:y0-b-1 0 ; sp x1 := min w:x1+b+1 c:size_x ; sp y1 := min w:y1+b+1 c:size_y
    if sp:x1>sp:x0 and sp:y1>sp:y0
      c spaces += sp
    sp x0 := max w:x0-b-1 0 ; sp y0 := w:y1+b ; sp x1 := min w:x1+b+1 c:size_x ; sp y1 := min w:y1+b+1 c:size_y
    if sp:x1>sp:x0 and sp:y1>sp:y0
      c spaces += sp
  function process d dl c
    arg_rw BrowserDraw d ; arg_rw List:BrowserDraw dl ; arg_rw BrowserConsole c
    d processed := true
    each d2 dl
      if not d2:processed and d2:sx0<d:dx1 and d2:sy0<d:dy1 and d2:sx1>d:dx0 and d2:sy1>d:dy0
        process d2 dl c
    if (exists d:w)
      d:w draw d:dx0 d:dy0 d:dx1 d:dy1
    else
      c:console copy d:sx0 d:sy0 d:sx1 d:sy1 d:dx0 d:dy0
  each d dl
    if not d:processed
      process d dl c


method c draw x0 y0 x1 y1 force
  arg_rw BrowserConsole c ; arg Int x0 y0 x1 y1 ; arg CBool force
  each sp c:spaces
    var Int xx0 := max x0 sp:x0
    var Int yy0 := max y0 sp:y0
    var Int xx1 := min x1 sp:x1
    var Int yy1 := min y1 sp:y1
    if xx1>xx0 and yy1>yy0
      var Link:ImagePixmap pm :> new ImagePixmap
      pm setup (image_prototype 0 0 1 1 xx1-xx0 yy1-yy0 c:gamut) ""
      for (var Int y) 0 pm:size_y-1
        pm fill 0 y pm:size_x (addressof sp:color)
      c:console paint pm xx0 yy0
  var Pointer:BrowserSession s :> c:session c:zorder:0
  var Pointer:BrowserWindow w :> s window "background"
  if exists:w and w:x0<>undefined
    var Int xx0 := max x0 w:x0
    var Int yy0 := max y0 w:y0
    var Int xx1 := min x1 w:x1
    var Int yy1 := min y1 w:y1
    if xx1>xx0 and yy1>yy0
      w draw xx0 yy0 xx1 yy1
  for (var Int i) 0 11
    var Pointer:BrowserSession s :> c:session i
    each w s:windows
      if force or w:refresh<>0
        if w:x0<>undefined
          var Int xx0 := max x0 w:x0
          var Int yy0 := max y0 w:y0
          var Int xx1 := min x1 w:x1
          var Int yy1 := min y1 w:y1
          if xx1>xx0 and yy1>yy0
            w draw xx0 yy0 xx1 yy1


method s node_draw id
  arg_rw BrowserSession s ; arg Str id
  var Pointer:BrowserNode n :> s:document search_node id
  if exists:n and n:has_area
    var Pointer:BrowserWindow w :> s window n
    if exists:w and w:refresh<2
      var Float t := s focus_thickness
      w draw_area n:area:x0-t n:area:y0-t n:area:x1+t n:area:y1+t


method s node_refresh id mm_x mm_y options
  arg_rw BrowserSession s ; arg Str id ; arg Float mm_x mm_y ; arg Str options
  var Pointer:BrowserWindow w :> s window (s:document search_node id)
  if not exists:w
    console "no window" eol
    return
  var Int level := -1 ; var CBool localdraw := options option "localdraw"
  part stage
    var Str id2 ; var Float mm_x2 mm_y2
    if level>=0
      var Int pos := options option_position "cascade" level options:len
      if not ((options pos options:len) parse word:"cascade" id2 mm_x2 mm_y2 any)
        leave stage
    else
      id2 := id ; mm_x2 := mm_x ; mm_y2 := mm_y
    var Pointer:BrowserNode n :> s:document search_node id2
    if not exists:n or not n:has_area
      leave stage
    var Float memo_x0 := n:area x0 ; var Float memo_y0 := n:area y0 ; var Float memo_x1 := n:area x1 ; var Float memo_y1 := n:area y1
    var Int memo_r := w refresh ; w refresh := 2
    w position n n:area:x0 n:area:y0 (max n:area:x0+mm_x n:area:x1) (max n:area:y0+mm_y n:area:y1) true
    w refresh := memo_r
    if n:area:x0<>memo_x0 or n:area:y0<>memo_y0 or n:area:x1<>memo_x1 or n:area:y1<>memo_y1
      level += 1
      restart stage
    localdraw := true
  if (options option "nodraw")
    void
  eif localdraw
    var Pointer:BrowserConsole c :> s console
    var Int x0 := max (cast (min memo_x0 n:area:x0)/c:unit_x*w:scale-0.5 Int)-w:scroll_x+w:x0 w:x0
    var Int y0 := max (cast (min memo_y0 n:area:y0)/c:unit_y*w:scale-0.5 Int)-w:scroll_y+w:y0 w:y0
    var Int x1 := min (cast (max memo_x1 n:area:x1)/c:unit_x*w:scale+0.5 Int)-w:scroll_x+w:x0 w:x1
    var Int y1 := min (cast (max memo_y1 n:area:y1)/c:unit_y*w:scale+0.5 Int)-w:scroll_y+w:y0 w:y1
    if x1>x0 and y1>y0
      w draw x0 y0 x1 y1
  else
    w refresh := 2


method s focus_set hook id index options
  arg_rw BrowserSession s ; arg Str hook id ; arg Int index ; arg Str options
  var Pointer:BrowserNode n :> null map BrowserNode
  if s:focus_id<>""
    n :> s:document search_node s:focus_id
  var Pointer:BrowserNode n2 :> null map BrowserNode
  if s:focus_hook<>"" and s:focus_hook<>s:focus_id
    n2 :> s:document search_node s:focus_hook
  s focus_hook := ""
  s focus_id := ""
  if exists:n2
    var BrowserContext c
    c bind s s:connection
    c event_setup "focus" "off" false
    c mark
    c jump n2
    c event n2
    c rewind
  if exists:n
    var BrowserContext c
    c bind s s:connection
    c event_setup "focus" "off" false
    c mark
    c jump n
    # c focus_adjust n false true true
    c event n
    c rewind
  s focus_hook := hook
  s focus_id := id
  s focus_index := index
  s focus_options := options
  if id<>""
    var Pointer:BrowserNode n :> s:document search_node id
    if exists:n
      var BrowserContext c
      c bind s s:connection
      c event_setup "focus" "on" false
      c mark
      c jump n
      c event n
      c rewind
  if hook<>"" and hook<>id
    var Pointer:BrowserNode n :> s:document search_node hook
    if exists:n
      var BrowserContext c
      c bind s s:connection
      c event_setup "focus" "on" false
      c mark
      c jump n
      c event n
      c rewind

method s focus_flush
  arg_rw BrowserSession s
  if s:focus_hook<>""
    var Pointer:BrowserNode n :> s:document search_node s:focus_hook
    if exists:n
      var BrowserContext c
      c bind s s:connection
      c event_setup "focus" "flush" false
      c mark
      c jump n
      c event n
      c rewind
  if s:focus_id<>"" and s:focus_id<>s:focus_hook
    var Pointer:BrowserNode n :> s:document search_node s:focus_id
    if exists:n
      var BrowserContext c
      c bind s s:connection
      c event_setup "focus" "flush" false
      c mark
      c jump n
      c event n
      c rewind


method s display
  arg_rw BrowserSession s
  while not exists:(s:document search_node s:focus_id) and (exists s:focus_history:last)
    var Pointer:BrowserFocusHistory h :> s:focus_history last
    s focus_set h:hook h:id h:index h:options
    s:focus_history remove h
  var Pointer:BrowserConsole c :> s console
  c layout1
  each w s:windows
    if w:x0<>undefined and w:refresh=2 and w:name<>"main"
      w position false
  c layout2
  each w s:windows
    if w:x0<>undefined and w:refresh=2
      w position true
  if false
    each w s:windows
      if w:x0<>undefined and w:refresh=2
        w position 2
  c draw 0 0 c:size_x c:size_y false
  each w s:windows
    if w:x0<>undefined
      w refresh := 0


export '. position' '. layout' '. draw' '. scroll'
export '. node_draw' '. node_refresh'
export '. focus_set' '. focus_flush'
export '. display'


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


gvar Dictionary browser_instructions

named_expression browser_instruction_prototype
  function 'pliant browser instruction function' line context
    arg Str line ; arg_rw BrowserContext context
    if (line parse word:instruction parameters)
      implicit context
        body
    else
      context syntax_error "syntax error in '"+instruction+"' instruction"

meta browser_instruction e
  if e:size>=2 and e:0:is_pure_ident and (e e:size-1):ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate browser_instruction_prototype substitute parameters (e 1 e:size-2) substitute body (e e:size-1) substitute instruction (expression constant e:0:ident near e:0) near e
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
    var Link:Function f :> (pliant_general_dictionary first "pliant browser instruction function") map Function
    e:module rewind mark
    if exists:f
      browser_instructions insert e:0:ident true addressof:f
      e set_void_result


method context syntax_error msg
  arg_rw BrowserContext context ; arg Str msg
  if context:status=success
    context status := failure msg

method context compute_next_id
  arg_rw BrowserContext context
  var Pointer:BrowserSession session :> context session
  implicit context session
    next_id := next_id_header+(string next_id_counter "radix 36")
    next_id_counter += 1


function process_browser_instruction line context fun
  arg Str line ; arg_rw BrowserContext context ; arg Function fun
  indirect

constant profile false
if profile
  module "/pliant/language/debug/profiler.pli"

method context process_instructions
  arg_rw BrowserContext context
  if profile
    profiler_recurse := 256
    profiler_start
    console "<"
  context compute_next_id
  while { var Str line := context:connection readline ; line<>"" }
    context:session:console:sem request
    if browser_trace
      console "-> " line eol
    var Pointer:Function fun :> (browser_instructions first (line 0 (line search " " line:len))) map Function
    if exists:fun
      process_browser_instruction line context fun
    else
      context syntax_error "unknown '"+(line 0 (line search " " line:len))+"' instruction"
    context:session:console:sem release
  if context:status=failure
    console "error in browser instructions name: " context:status:message eol
  if profile
    console ">" eol
    profiler_stop
    (var Stream s1) open "file:/tmp/profiler.txt" out+safe
    profiler_report "" "" s1
    (var Stream s1) open "file:/tmp/profiler.txt" in+safe
    (var Stream s2) open "file:/tmp/profiler2.txt" out+safe
    while not s1:atend
      var Str l := s1 readline
      if (l parse (var Str pfun) (var Str pos) (var Int ticks))
        s2 writeline l
        profiler_report pfun pos s2
        s2 writeline ""
    s1 close
    s2 close


export browser_instruction '. syntax_error' '. compute_next_id' # '. process_instructions'


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


method context focus_scroll node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  implicit context node
    if id=session:focus_id and node:has_area
      var Pointer:BrowserWindow w :> session window node
      if exists:w
        var Array:BrowserArea boxes := split node false
        var Pointer:BrowserArea a
        if session:focus_index>=0 and session:focus_index<boxes:size
          a :> boxes session:focus_index
        else
          a :> node area
        var Float space_x := (min (max (w:x1-w:x0)*console:unit_x/w:scale-(a:x1-a:x0) 0)/8 40)
        var Float space_y := (min (max (w:y1-w:y0)*console:unit_y/w:scale-(a:y1-a:y0) 0)/8 40)
        var Int ix0 := cast (a:x0-space_x)/console:unit_x*w:scale-0.5 Int
        var Int iy0 := cast (a:y0-space_y)/console:unit_y*w:scale-0.5 Int
        var Int ix1 := cast (a:x1+space_x)/console:unit_x*w:scale+0.5 Int
        var Int iy1 := cast (a:y1+space_y)/console:unit_y*w:scale+0.5 Int
        w scroll (min (max w:scroll_x ix1-(w:x1-w:x0)) ix0) (min (max w:scroll_y iy1-(w:y1-w:y0)) iy0)


method context focus_draw node font_vector
  arg_rw BrowserContext context ; arg_rw BrowserNode node ; arg Vector2 font_vector
  implicit context node
    if id=session:focus_id
      var Array:BrowserArea boxes := context split node false
      var BrowserArea b
      if session:focus_index>=0 and session:focus_index<boxes:size
        b := boxes session:focus_index
        if font_vector:x>0
          if (session:focus_options option "tail")
            b x0 := b:x1-session:focus_thickness
          else
            b x1 := b:x0+session:focus_thickness
      eif session:focus_index=boxes:size
        if boxes:size>0
          b := boxes boxes:size-1
          if font_vector:x>0
            b x0 := b x1
            b x1 += session:focus_thickness
          else
            return
        eif node:has_area
          b := node area
          if font_vector:x>0
            b x1 := b:x0+session:focus_thickness
          else
            return
      else
        return
      context rectangle b:x0 b:y0 b:x1 b:y1 (addressof session:focus_color)

method context focus_find_previous
  arg_rw BrowserContext context 
  implicit context
    var BrowserContext c
    c bind session connection
    c event_setup "focus" "set" false
    var Pointer:BrowserNode n :> document search_node session:focus_id
    while not c:event_discard_flag
      n :> document previous_node n
      if not exists:n
        return
      c event n

method context focus_find_next
  arg_rw BrowserContext context 
  implicit context
    var BrowserContext c
    c bind session connection
    c event_setup "focus" "set" false
    var Pointer:BrowserNode n :> document search_node session:focus_id
    while not c:event_discard_flag
      n :> document next_node n
      if not exists:n
        return
      c event n


method c event_discard
  arg_rw BrowserContext c
  c event_discard_flag := true


method context event_auto_focus node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  implicit context node
    if event="focus"
      if key="set"
        if x<>undefined
          var Array:BrowserArea boxes := split node true
          for (var Int i) 0 boxes:size-1
            var Pointer:BrowserArea b :> boxes i
            if x>=b:x0 and y>=b:y0 and x<=b:x1 and y<=b:y1
              session focus_set id id i ""
              event_discard
              return
        else
          session focus_set id id 0 ""
          event_discard
      eif key="on"
        focus_scroll node
        session node_draw node:id
      eif key="off"
        session node_draw node:id


method context event_auto_target node
  arg_rw BrowserContext context ; arg_rw BrowserNode node
  implicit context node
    if event="target"
      if key="set"
        var Array:BrowserArea boxes := split node true
        for (var Int i) 0 boxes:size-1
          var Pointer:BrowserArea b :> boxes i
          if x>=b:x0 and y>=b:y0 and x<=b:x1 and y<=b:y1
            target_id := id
            target_index := i
            target_options := ""
            target_x0 := b x0 ; target_y0 := b y0 ; target_x1 := b x1 ; target_y1 := b y1
            boxes := split node false
            if i>=boxes:size or { var Pointer:BrowserArea b :> boxes i ; not (x>=b:x0 and y>=b:y0 and x<=b:x1 and y<=b:y1) }
              target_options := "tail"
            event_discard
            return


export '. focus_scroll' '. focus_draw' '. focus_find_previous''. focus_find_next'
export '. event_discard' '. event_auto_focus' '. event_auto_target'


#-----------------------------------------------------------------------------
#  history


method s connect path options -> status
  arg_rw BrowserSession s ; arg Str path options ; arg ExtendedStatus status
  if (exists s:connection)
    s:connection safe_configure "shutdown"
  each extra s:extra_connections
    extra safe_configure "shutdown"
  var Link:Stream stream :> new Stream
  status := s:console connect path stream
  if status=success
    s path := path
    s options := options
    s document :> new BrowserDocument
    each w s:windows
      w refresh := 2
    s connection :> stream
    if s:user<>""
      if s:secured
        s:connection writeline "channel"
        var Link:Stream channel :> new Stream
        if not (path eparse any "://" any:(var Str host_and_port) "/" any)
          host_and_port := "127.0.0.1"
        if not (host_and_port parse any:(var Str host) ":" (var Int port))
          host := host_and_port ; port := browser_default_tcp_port
        channel open "zchannel://"+host+"/client/"+(string port+500)+"/"+host+"/"+s:user+"/"+s:password "" in+out+safe+noautopost pliant_default_file_system s:connection
        if channel=success
          s:connection :> channel
        else
          console "failed to securely connect to " host eol
      else
        s:connection writeline "login "+(string s:user)+" "+(string s:password)
    s:connection writeline "connect "+string:path+" "+string:options
    s:connection flush anytime
    thread
      share s
      var BrowserContext c
      c bind s s:connection
      c process_instructions

method s restore_connection
  arg_rw BrowserSession s
  if s:connection=failure
    s connect s:path s:options


method s process_events
  arg_rw BrowserSession s
  while s:event_ack="" and (exists s:event_list:first)
    var BrowserEvent e := s:event_list first
    s:event_list remove s:event_list:first
    var BrowserContext context
    context bind s s:connection
    if e:event="press" and (e:key parse "button" (var Int i)) and (exists e:window)
      part set_focus
        for (var Int k) 0 1
          var Pointer:BrowserNode n :> s:document search_node (shunt k=0 e:window:overlay e:window:root)
          if exists:n
            context event_setup "focus" "set" e:buttons e:x e:y true
            context event n
            if context:event_discard_flag
              leave set_focus
    if e:event="press" and { var Pointer:Str pid :> s:keys first e:key ; exists pid }
      context event_setup e:event e:key e:buttons e:x e:y false
      s focus_flush
      s:connection writeline "key "+(string e:key)
      s:connection flush anytime
      # context process_instructions
      s restore_connection
    eif ( e:event="character" or e:event="uncharacter" or ((e:event="press" or e:event="release") and not (e:key parse "button" any)) ) and { var Pointer:BrowserNode n :> s:document search_node s:focus_hook ; exists n }
      context event_setup e:event e:key e:buttons e:x e:y false
      context mark
      context jump n
      context event n
      context rewind
    eif (exists e:window)
      part dispatch_event
        for (var Int k) 0 1
          var Pointer:BrowserNode n :> s:document search_node (shunt k=0 e:window:overlay e:window:root)
          if exists:n
            context event_setup e:event e:key e:buttons e:x e:y true
            context event n
            if context:event_discard_flag
              leave dispatch_event
  

export '. connect' '. restore_connection' '. process_events'


method s history_push
  arg_rw BrowserSession s
  var BrowserHistory h
  h path := s path
  h options := s options
  each w s:windows
    var BrowserWindowHistory wh ; wh name := w name
    wh scroll_x := w scroll_x ; wh scroll_y := w scroll_y
    h windows += wh
  s history += h

method s history_pull
  arg_rw BrowserSession s
  var Pointer:BrowserHistory h :> s:history last
  if not exists:h
    return
  s path := h path
  s options := h options
  each wh h:windows
    var Pointer:BrowserWindow w :> s window wh:name
    if exists:w
      w scroll_x := wh scroll_x ; w scroll_y := wh scroll_y
  s:history remove h

export '. history_push' '. history_pull'


method c raise i clone
  arg_rw BrowserConsole c ; arg Int i ; arg CBool clone
  if i=c:zorder:0
    return
  var Int j := 0
  while c:zorder:j<>i
    j += 1
  while j>0
    c:zorder j := c:zorder j-1
    j -= 1
  c:zorder 0 := i
  if clone
    j := c:zorder 1
    c:session:j history_push
    c:session:i history := c:session:j history
    c:session:j history_pull
    c:session:i history_pull
    c:session:i scroll_lock := true
    c:session:i connect c:session:j:path c:session:j:options
    c:session:i scroll_lock := false
  c:session:i display

method c refresh
  arg_rw BrowserConsole c
  for (var Int i) 0 11
    var Pointer:BrowserSession s :> c:session i
    each w s:windows
      w refresh := 2
  (c:session c:zorder:0) display

export '. raise' '. refresh'