Patch title: Release 93 bulk changes
Abstract:
File: /graphic/browser/client.pli
Key:
    Removed line
    Added line
   
# pliant 'precompile /binary/browser.dump module /pliant/install/minimal.pli module /pliant/graphic/image/rip.pli' module /pliant/graphic/browser/client.pli command 'browser "path [dq][dq]"'

module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/memory.pli"
module "document.pli"
module "context.pli"
module "core.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/console/prototype.pli"
module "/pliant/graphic/browser/tag/prototype.pli"
module "/pliant/graphic/browser/tag/all.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/image/lazy.pli"
module "/pliant/graphic/image/antialiasing.pli"
module "/pliant/graphic/draw/image.pli"
module "/pliant/util/encoding/pack4.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/protocol/http/chunked.pli"


# todo:
#   motion async notify
#   scroll notify
#   multi sessions
#   send vector instructions, including outlines and fonts


method d delete_recurse n
  arg_rw BrowserDocument d ; arg_rw BrowserNode n
  each sub n
    d delete_recurse sub
  d delete_node n

method d reset n
  arg_rw BrowserDocument d ; arg_rw BrowserNode n
  each sub n
    d delete_recurse sub
  n reset_attributes

method n count_sons -> nb
  arg BrowserNode n ; arg Int nb
  nb := 0
  each sub n
    nb += 1
    
method n count_nodes -> nb
  arg BrowserNode n ; arg Int nb
  nb := 1
  each sub n
    nb += sub count_nodes
    

method context jump node
  arg_rw BrowserContext context ; arg BrowserNode node
  var (List Pointer:BrowserNode) nodes
  var Pointer:BrowserNode n :> node parent
  while exists:n
    nodes += n
    n :> n parent
  var (Pointer Pointer:BrowserNode) p :>> nodes last
  while exists:p
    var Str tag := p tag
    context set tag
    p first_attribute (var Str attr) (var Str value)
    while attr<>""
      context set tag attr value
      p next_attribute (var Str attr) (var Str value)
    p :>> nodes previous p

method context new_tag tag -> n
  arg_rw BrowserContext context ; arg Str tag ; arg_C BrowserNode n
  implicit context
    n :> document search_node next_id
    if exists:n
      document reset n
      n tag := tag
    else
      n :> document create_node next_id tag
    if previous_id<>""
      var Pointer:BrowserNode p :> document search_node previous_id 
      if exists:p
        document stick n stick_after p
    eif parent_id<>""
      var Pointer:BrowserNode p :> document search_node parent_id 
      if exists:p
        document stick n stick_tail p
    current_id := next_id
    next_id := generate_id
    

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


method s window_pointer i -> w
  arg BrowserSession s ; arg Int i ; arg_C BrowserWindow w
  check i>=0 and i<=4
  if i=0
    w :> s main
  eif i=1
    w :> s top
  eif i=2
    w :> s bottom
  eif i=3
    w :> s left
  eif i=4
    w :> s right

method s window_by_name name -> w
  arg BrowserSession s ; arg Str name ; arg_C BrowserWindow w
  if name="main"
    w :> s main
  eif name="top"
    w :> s top
  eif name="left"
    w :> s left
  eif name="right"
    w :> s right
  eif name="bottom"
    w :> s bottom
  else
    w :> null map BrowserWindow


method w draw n x0 y0 x1 y1
  arg_rw BrowserWindow w ; arg_rw BrowserNode n ; 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:n
    var Link:DrawImage draw :> new DrawImage
    draw bind pm "fast_text"
    var BrowserContext context
    context bind w (null map Stream)
    context draw_setup draw pm:x0 pm:y0 pm:x1 pm:y1
    context mark
    context jump n
    context draw n
    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
  
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) x0 y0 x1 y1


method w move x0 y0 x1 y1
  arg_rw BrowserWindow w ; arg Int x0 y0 x1 y1
  var Pointer:BrowserConsole c :> w:session console
  if x0=undefined
    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
    w draw x0 y0 x1 y1
  else
    check x0>=0 and y0>=0 and x1<=c:size_x and y1<=c:size_y and x1>x0 and y1>y0
    for (var Int i) 0 12
      var Pointer:BrowserSession s :> c:session i
      for (var Int j) 0 4
        var Pointer:BrowserWindow ww :> s window_pointer j
        if addressof:ww<>addressof:w and ww:x0<>undefined and ww:x0<w:x1 and ww:y0<w:y0 and ww:x1>w:x0 and ww:y1>w:y0
          if ww:y0<w:y0
            ww y1 := w y0
          eif ww:y1>w:y1
            ww y0 := w y1
          eif ww:x0<w:x0
            ww x1 := w x0
          eif ww:x1>w:x1
            ww x0 := w x1
          else
            ww x0 := undefined ; ww y0 := undefined ; ww x1 := undefined ; ww y1 := undefined
    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)
      c:console copy w:x0 w:y0 w:x1 w:y1 x0 y0
    w x1 += x0-w:x0 ; w x0 := x0
    w y1 += y0-w:y0 ; w y0 := y0
    if w:x1<x1 and w:y1>w:y0
      var Int dx := x1-w:x1 ; w x1 := x1
      w draw w:x1-dx w:y0 w:x1 w:y1
    if w:y1<y1 and w:x1>w:x0
      var Int dy := y1-w:y1 ; w y1 := y1
      w draw w:x0 w:y1-dy w:x1 w:y1
    check w:x0=x0 and w:y0=y0 and w:x1=x1 and w:y1=y1

        
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
  arg_rw BrowserWindow w ; arg_rw BrowserNode n ; arg Float x0 y0 x1 y1
  var Pointer:BrowserConsole c :> w:session console
  if exists:n
    var BrowserContext context
    context bind w (null map Stream)
    context position_setup x0 y0 x1 y1
    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 constrained
  arg_rw BrowserWindow w ; arg CBool constrained
  var Pointer:BrowserConsole c :> w:session console
  if constrained
    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
  else
    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


method w layout x0 y0 x1 y1
  arg_rw BrowserWindow w ; arg Int x0 y0 x1 y1
  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

method c layout
  arg_rw BrowserConsole c
  var Pointer:BrowserSession s :> c:session c:zorder:0
  var Pointer:BrowserWindow left :> s left
  var Pointer:BrowserWindow top :> s top
  var Pointer:BrowserWindow right :> c:session:0 right
  var Pointer:BrowserWindow bottom :> s bottom
  for (var Int i) 0 c:zorder:size-1
    var Pointer:BrowserSession s :> c:session c:zorder:i
    for (var Int j) 1 4
      var Pointer:BrowserWindow w :> s window_pointer j
      if addressof:w<>addressof:(c:session:(shunt j=4 0 c:zorder:0) window_pointer j)
        w x0 := undefined ; w y0 := undefined ; w x1 := undefined ; w y1 := undefined
  c spaces := var List:BrowserSpace empty_space_list
  var Int x0 := 0
  var Int y0 := 0
  var Int x1 := c size_x
  var Int y1 := c size_y
  if 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
      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 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
      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 left:bbox:x0=defined
    var Int n := min (cast (left:bbox:x1-left:bbox:x0)/c:unit_y+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
      x0 += n
      if s:space_size>0
        var BrowserSpace sp ; sp x0 := x0 ; sp y0 := y0 ; sp x1 := x0+s:space_size ; sp color := s space_color ; sp y1 := y1 ; 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 right:bbox:x0=defined
    var Int n := min (cast (right:bbox:x1-right:bbox:x0)/c:unit_y+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
      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 position := 15
  for (var Int i) 0 c:zorder:size-1
    var Pointer:BrowserSession s :> c:session c:zorder:i
    if (s:position .and. .not. position)=0
      var Pointer:BrowserWindow w :> s main
      if s:position=15
        w layout x0 y0 x1 y1
      position := position .and. .not. s:position
    else
      w x0 := undefined ; w y0 := undefined ; w x1 := undefined ; w y1 := undefined


method c hide
  arg_rw BrowserConsole c
  for (var Int i) 0 c:zorder:size-1
    var Pointer:BrowserSession s :> c:session c:zorder:i
    for (var Int j) 0 4
      var Pointer:BrowserWindow w :> s window_pointer j
      w x0 := undefined ; w y0 := undefined ; w x1 := undefined ; w y1 := undefined


method c position constrained
  arg_rw BrowserConsole c ; arg CBool constrained
  for (var Int i) 0 c:zorder:size-1
    var Pointer:BrowserSession s :> c:session c:zorder:i 
    for (var Int j) 0 4
      var Pointer:BrowserWindow w :> s window_pointer j
      w position constrained


method c draw x0 y0 x1 y1 content
  arg_rw BrowserConsole c ; arg Int x0 y0 x1 y1 ; arg CBool content
  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
  if content
    for (var Int i) 0 c:zorder:size-1
      var Pointer:BrowserSession s :> c:session c:zorder:i
      for (var Int j) 0 4
        var Pointer:BrowserWindow w :> s window_pointer j
        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


#-------------------------------------------------------------------------------
#  communication protocol


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

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


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


method session process_instructions connection
  arg_rw BrowserSession session ; arg_rw Stream connection
  var BrowserContext context
  context document :> session document
  context console :> session console
  context session :> session
  context window :> session main
  context connection :> connection
  context next_id := generate_id
  while { var Str line := connection readline ; line<>"" }
    # 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"
  if context:status=failure
    console "error in browser instructions name: " context:status:message eol


# compact tree instructions

browser_instruction i (var Str id)
  next_id := id

browser_instruction l (var Str tag) # leaf tag
  document:sem request
  new_tag tag
  document:sem release
  parent_id := "" ; previous_id := current_id

browser_instruction t (var Str txt)
  document:sem request
  var Pointer:BrowserNode n :> new_tag "text"
  n attribute "" := txt
  document:sem release
  parent_id := "" ; previous_id := current_id

browser_instruction a (var Str attr) (var Str value)
  document:sem request
  var Pointer:BrowserNode n :> document search_node current_id
  if exists:n
    n attribute attr := value
  document:sem release

browser_instruction o (var Str tag)
  document:sem request
  new_tag tag
  document:sem release
  var BrowserStage s ; s parent_id := "" ; s previous_id := current_id
  stage += s
  parent_id := current_id ; previous_id := ""

browser_instruction c
  var Pointer:BrowserStage s :> stage last
  if exists:s
    parent_id := s parent_id ; previous_id := s previous_id
    stage remove s

browser_instruction push
  var BrowserStage s ; s parent_id := parent_id ; s previous_id := previous_id
  stage += s
  parent_id := "" ; previous_id := ""

browser_instruction pop
  var Pointer:BrowserStage s :> stage last
  if exists:s
    parent_id := s parent_id ; previous_id := s previous_id
    stage remove s


# modify tree instructions

browser_instruction tag (var Str id) (var Str tag)
  document:sem request
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    document delete_node n
  document create_node id tag
  document:sem release

browser_instruction attr (var Str id) (var Str attr) (var Str value)
  document:sem request
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    n attribute attr := value
  document:sem release

browser_instruction stick (var Str id) any:(var Str where)
  var Int mode := stick_before
  if (where parse word:"before" (var Str ref))
    mode := stick_before
  eif (where parse word:"after" (var Str ref))
    mode := stick_after
  eif (where parse word:"head" (var Str ref))
    mode := stick_head
  eif (where parse word:"tail" (var Str ref))
    mode := stick_tail
  else
    mode := undefined
  if mode<>undefined
    document:sem request
    var Pointer:BrowserNode n :> document search_node id
    var Pointer:BrowserNode r :> document search_node ref
    if exists:n and exists:r
      document stick n mode r
    document:sem release

browser_instruction unstick (var Str id)
  document:sem request
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    document unstick n
  document:sem release

browser_instruction drop (var Str id)
  document:sem request
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    document delete_node n
  document:sem release


# windows layout and screen refresh

browser_instruction window (var Str name)
  window :> session window_by_name name
  if not exists:window
    syntax_error "incorrect parameter '"+name+"' provided to 'window' instruction"
    window :> session main

browser_instruction display (var Str id)
  window root := id
  window scroll_x := 0
  window scroll_y := 0
  window scale := 1

browser_instruction scale (var Float f)
  if f>=1e-3 and f<=1e3
    window scroll_x := cast window:scroll_x*f/window:scale Int
    window scroll_y := cast window:scroll_y*f/window:scale Int
    window scale := f

browser_instruction position (var Str id) (var Float x0) (var Float y0) (var Float x1) (var Float y1)
  window position (document search_node id) x0 y0 x1 y1

browser_instruction window_position
  window position true

browser_instruction scroll (var Float x0) (var Float y0) (var Float x1) (var Float y1)
  var Int ix0 := cast x0/console:unit_x*window:scale-0.5 Int
  var Int iy0 := cast y1/console:unit_y*window:scale-0.5 Int
  var Int ix1 := cast x1/console:unit_x*window:scale+0.5 Int
  var Int iy1 := cast y1/console:unit_y*window:scale+0.5 Int
  window scroll (min (max window:scroll_x ix1-(window:x1-window:x0)) ix0) (min (max window:scroll_y iy1-(window:y1-window:y0)) iy0)

browser_instruction draw (var Str id) (var Float x0) (var Float y0) (var Float x1) (var Float y1)
  var Int ix0 := max (cast x0/console:unit_x*window:scale-0.5 Int)-window:scroll_x+window:x0 window:x0
  var Int iy0 := max (cast y0/console:unit_y*window:scale-0.5 Int)-window:scroll_y+window:y0 window:y0
  var Int ix1 := min (cast x1/console:unit_x*window:scale+0.5 Int)-window:scroll_x+window:x0 window:x1
  var Int iy1 := min (cast y1/console:unit_y*window:scale+0.5 Int)-window:scroll_y+window:y0 window:y1
  if ix1>ix0 and iy1>iy0
    window draw (document search_node id) ix0 iy0 ix1 iy1

browser_instruction window_draw
  if window:x0<>undefined
    window draw window:x0 window:y0 window:x1 window:y1

browser_instruction layout
  console layout

browser_instruction once
  console hide
  console position false
  console layout
  console position true
  console draw 0 0 console:size_x console:size_y true


browser_instruction border any # will be changed
  window border_size := line option "size" Int 1
  window border_color := console browser_color (line option "color" Str "rgb:FFFFFF")

browser_instruction space any # will be changed
  session space_size := line option "size" Int 1
  session space_color := console browser_color (line option "color" Str "rgb:000000")

browser_instruction antialiasing (var Int i)
  window antialiasing := shunt i=1 or i=2 or i=4 or i=8 i 1


# bitmaps

browser_instruction image (var Str id) (var Float x0) (var Float y0) (var Float x1) (var Float y1) (var Int size_x) (var Int size_y) (var Str gamutname) any:(var Str extra)
  var Link:ColorGamut gamut :> color_gamut gamutname
  if gamut=success
    var Link:ImagePacked img :> new ImagePacked
    img setup (image_prototype x0 y0 x1 y1 size_x size_y gamut) extra
    document:attached insert id true addressof:img
  else
    syntax_error "Unknown gamut '"+gamutname+"'"

browser_instruction paint (var Str id) (var Int x0) (var Int y0) (var Int x1) (var Int y1)
  var Link:ImagePacked img :> (document:attached first id) map ImagePacked
  if exists:img and (entry_type addressof:img)=ImagePacked
    if x0>=0 and y0>=0 and x1>x0 and y1>y0 and x1<=img:size_x and y1<=img:size_y
      var Address previous := memory_zallocate (x1-x0)*img:pixel_size null
      var Address cbuffer := memory_allocate (x1-x0)*img:pixel_size*2+Int:size null 
      var Address buffer := memory_allocate (x1-x0)*img:pixel_size null
      for (var Int iy) y0 y1-1
        if (connection:readline parse word:"b" (var Int csize)) and csize>=0 and csize<=memory_size:cbuffer
          connection raw_read cbuffer csize
          pack4_decode cbuffer buffer img:pixel_size x1-x0 previous
          img write x0 iy x1-x0 buffer
          swap buffer previous
    else
      syntax_error "Bounds overflow in '"+id+"' image"
  else
    syntax_error "There is no '"+id+"' image"

browser_instruction overpaint (var Str id) (var Int x0) (var Int y0) (var Int x1) (var Int y1)
  var Link:ImagePacked img :> (document:attached first id) map ImagePacked
  if exists:img and (entry_type addressof:img)=ImagePacked
    if x0>=0 and y0>=0 and x1>x0 and y1>y0 and x1<=img:size_x and y1<=img:size_y
      var Address previous := memory_allocate (x1-x0)*img:pixel_size null
      var Address cbuffer := memory_allocate (x1-x0)*img:pixel_size*2+Int:size null 
      var Address buffer := memory_allocate (x1-x0)*img:pixel_size null
      for (var Int iy) y0 y1-1
        if (connection:readline parse word:"b" (var Int csize)) and csize>=0 and csize<=memory_size:cbuffer
          connection raw_read cbuffer csize
          img read x0 iy x1-x0 previous
          pack4_decode cbuffer buffer img:pixel_size x1-x0 previous
          img write x0 iy x1-x0 buffer
    else
      syntax_error "Bounds overflow in '"+id+"' image"
  else
    syntax_error "There is no '"+id+"' image"

browser_instruction jpeg (var Str id) (var Int x0) (var Int y0) (var Int x1) (var Int y1)
  var Link:ImagePacked img :> (document:attached first id) map ImagePacked
  if exists:img and (entry_type addressof:img)=ImagePacked
    var Link:Stream s :> new Stream
    s open "chunked:" "pliant_browser_chunking" in+safe pliant_default_file_system connection
    var Link:ImageLazy lazy :> new ImageLazy
    lazy bind s "filter [dq].jpeg[dq]"
    if x0>=0 and y0>=0 and x1>x0 and y1>y0 and x1<=img:size_x and y1<=img:size_y and x1-x0=lazy:size_x and y1-y0=lazy:size_y and img:pixel_size=lazy:pixel_size
      var Address buffer := memory_allocate (x1-x0)*img:pixel_size null
      for (var Int iy) y0 y1-1
        lazy read 0 iy-y0 x1-x0 buffer
        img write x0 iy x1-x0 buffer
    else
      syntax_error "Bounds overflow in '"+id+"' image"
  else
    syntax_error "There is no '"+id+"' image"

browser_instruction copy (var Str sid) (var Int sx0) (var Int sy0) (var Int sx1) (var Int sy1) (var Str did) (var Int dx0) (var Int dy0)
  var Link:ImagePacked src :> (document:attached first sid) map ImagePacked
  var Link:ImagePacked dest :> (document:attached first did) map ImagePacked
  if exists:src and (entry_type addressof:src)=ImagePacked and exists:dest and (entry_type addressof:dest)=ImagePacked
    if sx0>=0 and sy0>=0 and sx1>sx0 and sy1>sy0 and sx1<=src:size_x and sy1<=src:size_y and dx0>=0 and dy0>=0 and dx0+(sx1-sx0)<=dest:size_x and dy0+(sy1-sy0)<=dest:size_y and src:pixel_size=dest:pixel_size
      var Address buffer := memory_allocate (sx1-sx0)*src:pixel_size null
      if dy0<=sy0
        for (var Int iy) sy0 sy1-1
          src read sx0 iy sx1-sx0 buffer
          dest write dx0 dy0+(iy-sy0) sx1-sx0 buffer
      else
        for (var Int iy) sy1-1 sy0 step -1
          src read sx0 iy sx1-sx0 buffer
          dest write dx0 dy0+(iy-sy0) sx1-sx0 buffer
    else
      syntax_error "Bounds overflow in '"+sid+"' or '"+did+"' image"
    void
  else
    syntax_error "There is no '"+sid+"' or '"+did+"' image"


# server queries about positions

browser_instruction query_tag (var Str id)
  document:sem request
  var Pointer:BrowserNode n :> document search_node id
  if exists:n and n:has_area
    connection writeline (string n:area:x0)+" "+(string n:area:y0)+" "+(string n:area:x1)+" "+(string n:area:y1)
  else
    connection writeline ""
  document:sem release

browser_instruction query_bbox
  connection writeline (string window:bbox:x0)+" "+(string window:bbox:y0)+" "+(string window:bbox:x1)+" "+(string window:bbox:y1)

browser_instruction query_scroll
  if window:x0<>undefined
    connection writeline "? ? ? ?"
  else
    connection writeline (string window:scroll_x*console:unit_x/window:scale)+" "+(string window:scroll_y*console:unit_y/window:scale)+" "+(string (window:scroll_x+window:x1-window:x0)*console:unit_x/window:scale)+" "+(string (window:scroll_y+window:y1-window:y0)*console:unit_y/window:scale)

browser_instruction query_scale
  connection writeline (string window:scale)

browser_instruction query_screen
  connection writeline (string console:size_x*console:unit_x)+" "+(string console:size_y*console:unit_y)+" "+(string console:size_x)+" "+(string console:size_y)


# server queries about content

browser_instruction path (var Str id)
  var Pointer:BrowserNode n :> document search_node id
  while exists:n
    connection writeline "i "+(string n:id)
    connection writeline "l "+(string n:tag)
    var CBool found := n first_attribute (var Str a) (var Str v)
    while found
      connection writeline "a "+string:a+" "+string:v
      found := n next_attribute a v
    n :> n parent
  connection writeline ""

method n send_tree_recurse stream
  arg BrowserNode n ; arg_rw Stream stream
  stream writeline "i "+(string n:id)
  stream writeline (shunt (exists n:first) "o " "l ")+(string n:tag)
  var CBool found := n first_attribute (var Str a) (var Str v)
  while found
    stream writeline "a "+string:a+" "+string:v
    found := n next_attribute a v
  if (exists n:first)
    each sub n
      sub send_tree_recurse stream
    stream writeline "c"
    
browser_instruction tree (var Str id)
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    n send_tree_recurse connection
  connection writeline ""

browser_instruction small_tree (var Str id) (var Int limit)
  var Pointer:BrowserNode n :> document search_node id
  if exists:n and n:count_nodes<=limit
    connection writeline "yes"
    n send_tree_recurse connection
    connection writeline ""
  else
    connection writeline "no"

browser_instruction sons (var Str id)
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    each sub n
      connection writeline "i "+(string sub:id)
      connection writeline "l "+(string sub:tag)
      var CBool found := sub first_attribute (var Str a) (var Str v)
      while found
        connection writeline "a "+string:a+" "+string:v
        found := sub next_attribute a v
  connection writeline ""

browser_instruction count_tree (var Str id)
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    connection writeline (string n:count_nodes)
  else
    connection writeline "0"

browser_instruction count_sons (var Str id)
  var Pointer:BrowserNode n :> document search_node id
  if exists:n
    var Int count := 0
    each sub n
      count += 1
    connection writeline string:count
  else
    connection writeline ""


# misc instructions

browser_instruction multi # reduce latency
  var List:Str lines
  while { var Str l2 := connection readline ; l2<>"" }
    lines += l2
  each l lines
    var Pointer:Function fun :> (browser_instructions first (l 0 (l search " " l:len))) map Function
    if exists:fun
      process_browser_instruction l context fun
    else
      context syntax_error "unknown '"+(l 0 (l search " " l:len))+"' instruction"

browser_instruction status
  connection writeline (shunt status=success "success" "failure "+(string status:message))
  status := success


#-------------------------------------------------------------------------------
#  main loop


function browser options -> status
  arg Str options ; arg ExtendedStatus status
  var BrowserConsole c
  var Int dpi := options option "dpi" Int 75
  c unit_x := 25.4/dpi ; c unit_y := 25.4/dpi
  c console :> graphic_console (options option "console" Str "x11")
  if not (exists c:console)
    return (failure "There is no '"+(options option "console" Str "x11")+"' console driver.")
  var ImagePrototype proto := image_prototype 0 0 480*c:unit_x 600*c:unit_y 480 600 color_gamut:"rgb"
  c:console open proto options
  c rgb :> color_gamut "rgb"
  proto := c:console query ; c size_x := proto size_x ; c size_y := proto size_y ; c gamut :> proto gamut
  var Link:Stream stream :> new Stream
  status := stream open "tcp://127.0.0.1/client/4" in+out+safe
  if status=failure
    return
  stream writeline "connect "+string:(options option "path" Str)
  c:session:0 process_instructions stream
  var Int last_x last_y
  while true
    var Str event := c:console event (var Str key) (var Int buttons) (var Int x0) (var Int y0) (var Int x1) (var Int y1)
    if false
      console "event " event " key " key " buttons " buttons " at " x0 " " y0 " " x1 " " y1 eol
    if event="press"
      last_x := x0 ; last_y := y0
    if event="move"
      if buttons<>undefined and (buttons .and. 4)<>0
        for (var Int i) 0 c:zorder:size-1
          var Pointer:BrowserSession s :> c:session c:zorder:i
          for (var Int j) 0 4
            var Pointer:BrowserWindow w
            if j=0
              w :> s top
            eif j=1
              w :> s left
            eif j=2
              w :> s right
            eif j=3
              w :> s bottom
            else
              w :> s main
            if w:x0<>undefined and x0>=w:x0 and y0>=w:y0 and x0<w:x1 and y0<w:y1
              w scroll w:scroll_x+last_x-x0 w:scroll_y+last_y-y0
      last_x := x0 ; last_y := y0
    eif event="redraw"
      c draw x0 y0 x1 y1 true
    eif event="resize"
      c size_x := x0 ; c size_y := y0
      c position false
      c layout
      c position true
      c draw 0 0 x0 y0 true
    eif event<>""
      part handle_event
        for (var Int i) 0 c:zorder:size-1
          var Pointer:BrowserSession s :> c:session c:zorder:i
          for (var Int j) 0 4
            var Pointer:BrowserWindow w
            if j=0
              w :> s top
            eif j=1
              w :> s left
            eif j=2
              w :> s right
            eif j=3
              w :> s bottom
            else
              w :> s main
            var Pointer:BrowserNode n :> s:document search_node w:root
            if exists:n and w:x0<>undefined and x0>=w:x0 and y0>=w:y0 and x0<w:x1 and y0<w:y1
              var BrowserContext context
              context bind w stream
              context event_setup event key buttons (x0-w:x0+w:scroll_x+0.5)*c:unit_x/w:scale (y0-w:y0+w:scroll_y+0.5)*c:unit_y/w:scale
              context event n
              context event := ""
              if context:process_instructions_flag
                c:session:0 process_instructions stream
                leave handle_event
  status := success

export browser