Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/browser/naive/context.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/image/prototype.pli"
module "/pliant/graphic/draw/prototype.pli"
module "/pliant/graphic/console/prototype.pli"
module "document.pli"


public

  type BrowserArea
    field Float x0 y0 x1 y1

  type BrowserArea2
    field Float x0 y0 x1 y1
    field Float32 char_extra_spacing space_extra_spacing

  type BrowserSpace
    field Int x0 y0 x1 y1 ; field uInt color

  type BrowserWindowHistory
    field Str name
    field Int scroll_x scroll_y

  type BrowserFocusHistory
    field Str hook id
    field Int index
    field Str options

  type BrowserHistory
    field Str path options
    field List:BrowserWindowHistory windows
 
  type BrowserWindow
    field Str name
    field Address session_address
    field Str root overlay # id of the root node in the document
    field BrowserArea bbox
    field Int scroll_x scroll_y <- 0
    field Float fraction <- 0.25
    field Int x0 y0 x1 y1 <- undefined # visible area in the window or on the screen
    field Float scale <- 1
    field Int border_size <- 3 ; field Int border_color <- 0FFFFFFh
    field Int antialiasing <- 4
    field Int refresh <- 2 # 0, no refresh, 1 overlay only, 2 everything
    field Link:ImagePrototype underlay
    field Int memo
  
  type BrowserEvent
    field Str id event key ; field Int buttons ; field Float x y ; field Str options ; field Pointer:BrowserWindow window

  type BrowserSession
    field Link:BrowserDocument document
    field Address console_address
    field List:BrowserWindow windows
    field Str next_id_header <- character:1 ; field uInt next_id_counter <- 1
    field Int position <- 4
    field Int space_size <- 1 ; field Int space_color <- 0C0C0C0h ; field Int space_active_color <- 808080h
    field Str path options
    field List:BrowserHistory history
    field CBool scroll_lock <- false
    field Link:Stream connection
    field (List Link:Stream) extra_connections
    field Str focus_hook
    field Str focus_id
    field Int focus_index
    field Str focus_options
    field Float focus_thickness <- 0.5 ; field Int focus_color <- 0FF0000h
    field Float focus_fraction <- 1/8 ; field Float focus_space <- 20
    field List:BrowserFocusHistory focus_history
    field List:BrowserEvent event_list ; field Str event_ack
    field (Dictionary Str Str) keys
    field Str user password ; field CBool secured <- false

  type BrowserConsole
    field Link:ConsolePrototype console
    field (Array BrowserSession 12) session
    field Array:Int zorder
    field Int size_x size_y # screen or OS window size
    field Float unit_x unit_y # pixel size is mm
    field Float middle_x middle_y <- 0.5
    field Link:ColorGamut rgb gamut
    field List:BrowserSpace spaces
    field Sem sem

  method w session -> s
    arg BrowserWindow w ; arg_C BrowserSession s
    s :> w:session_address map BrowserSession

  method s console -> c
    arg BrowserSession s ; arg_C BrowserConsole c
    c :> s:console_address map BrowserConsole

  
function build c
  arg_w BrowserConsole c
  for (var Int i) 0 11
    var Pointer:BrowserSession s :> c:session i
    s console_address := addressof c
    s document :> new BrowserDocument
    var BrowserWindow w ; w session_address := addressof s
    w name := "main" ; w border_color := 0F8F8F8h ; s windows += w
    w name := "top" ; w border_color := 0F0F0F0h ; s windows += w
    w name := "bottom" ; w border_color := 0F0F0F0h ; s windows += w
    w name := "left" ; w border_color := 0F0F0F0h ; s windows += w
    w name := "right" ; w border_color := 0E0E0E0h ; s windows += w
    c zorder += i
    s document :> new BrowserDocument


public

  type BrowserStage
    field Str parent_id previous_id

  constant draw_foreground 1
  constant draw_background 1
  constant selected_no 0
  constant selected_partial 1
  constant selected_yes 2
  constant line_extend 1
  constant line_adjust 2
  constant line_align_tail 100h
  constant line_align_center 200h
  constant line_align_justify 400h

  type BrowserLineArea
    field Pointer:BrowserArea area
    field Int flags
    field Link:Font font
    field Float scale
    field Str32 text

  type BrowserContext
    field Pointer:BrowserDocument document
    field Pointer:BrowserConsole console
    field Pointer:BrowserSession session
    field Link:Stream connection
    # attributes forwarding
    field (Dictionary Str Str) values
    field (List List:Str) stack
    #
    field Link:DrawPrototype draw
    field Float clip_x0 clip_y0 clip_x1 clip_y1
    # available space
    field Float area_x0 area_y0 area_x1 area_y1
    field List:BrowserArea areas
    field CBool position_extend_flag
    # current line
    field Float line_y0 line_x line_y
    field List:BrowserLineArea line_content
    field Int line_flags # 1 center, 2 align right
    # status
    field Int draw_mode <- draw_foreground+draw_background
    field Int selected_mode <- selected_no
    # parse instructions
    field Str next_id current_id ; field List:Str stack_id
    field Str parent_id previous_id
    field List:BrowserStage stage
    field ExtendedStatus status <- success
    # event
    field Str event ; field Str key ; field Int buttons ; field Float x y
    field Str target_id ; field Int target_index ; field Str target_options
    field Float target_x0 target_y0 target_x1 target_y1
    field CBool event_recurse_flag event_discard_flag

method c bind session connection
  arg_rw BrowserContext c ; arg BrowserSession session ; arg_rw Stream connection
  c document :> session document
  c console :> session console
  c session :> session
  c connection :> connection


#-----------------------------------------------------------------------------
#   attributes forwarding


method c mark
  arg_rw BrowserContext c
  c stack += var List:Str empty_list

method c set tag
  arg_rw BrowserContext c ; arg Str tag
  c:values insert tag "[0]"
  var (Pointer List:Str) l :> c:stack last
  l += tag

method c reset tag
  arg_rw BrowserContext c ; arg Str tag
  c:values insert tag ""
  var (Pointer List:Str) l :> c:stack last
  l += tag

method c query tag -> value
  arg BrowserContext c ; arg Str tag ; arg CBool value
  var Pointer:Str p :> c:values first tag
  if exists:p
    value := p:len<>0
  else
    value := false

method c set tag attr value
  arg_rw BrowserContext c ; arg Str tag attr value
  c:values insert tag+"[0]"+attr value
  var (Pointer List:Str) l :> c:stack last
  l += tag+"[0]"+attr

method c query tag attr -> value
  arg BrowserContext c ; arg Str tag attr value
  var Pointer:Str p :> c:values first tag+"[0]"+attr
  if exists:p
    value := p
  else
    value := ""

method c set_attributes n
  arg_rw BrowserContext c ; arg BrowserNode n
  var Str tag := n tag
  c set tag
  n first_attribute (var Str attr) (var Str value)
  while attr<>""
    var Int i := attr search ":" -1
    if i<>(-1)
      c set (attr 0 i) (attr i+1 attr:len) value
    else
      c set tag attr value
      if attr="style"
        var Pointer:Dictionary style :> (c:document:attached first value) map Dictionary
        if exists:style and (entry_type addressof:style)=Dictionary
          each svalue style type Str getkey skey
            if (skey parse (var Str stag) (var Str sattr))
              c set stag sattr svalue
    n next_attribute (var Str attr) (var Str value)

method c rewind
  arg_rw BrowserContext c
  var (Pointer List:Str) l :> c:stack last
  var Pointer:Str p :> l last
  while exists:p
    c:values remove (c:values first p)
    p :> l previous p
  c:stack remove l


#-----------------------------------------------------------------------------
#   positioning


method a setup x0 y0 x1 y1
  arg_rw BrowserArea2 a ; arg Float x0 y0 x1 y1
  a x0 := x0 ; a y0 := y0 ; a x1 := x1 ; a y1 := y1
  a char_extra_spacing := 0 ; a space_extra_spacing := 0

method n has_area -> c
  arg_rw BrowserNode n ; arg CBool c
  c := n:extra<>null

method n area -> a
  arg_rw BrowserNode n ; arg_C BrowserArea a
  if n:extra=null
    n extra := memory_allocate BrowserArea:size addressof:n
    a :> n:extra map BrowserArea
    a x0 := undefined ; a y0 := undefined ; a x1 := undefined ; a y1 := undefined
  else
    a :> n:extra map BrowserArea

module "/pliant/util/encoding/utf8.pli"

method c newline complete
  arg_rw BrowserContext c ; arg CBool complete
  if (c:line_flags .and. line_align_center)<>0
    var Float move_x := 0.5*(c:area_x1-c:line_x)
    each lc c:line_content
      lc:area x0 += move_x
      lc:area x1 += move_x
  if (c:line_flags .and. line_align_justify)<>0 and complete and (exists c:line_content:last)
    var Int count := 0
    each lc c:line_content
      if (lc:flags .and. line_adjust)<>0
        for (var Int i) 0 lc:text:len-1
          if lc:text:i=" "
            count += 1
    var Pointer:BrowserLineArea lc :> c:line_content last
    var Int i := lc:text:len
    while i>0 and (lc:text i-1)=" "
      count -= 1
      i -= 1
    if count>0
      var Float extra := c:area_x1-lc:area:x1
      if (exists lc:font)
        lc:font bbox (lc:text i lc:text:len) null 0 (var Float ax0) (var Float ay0) (var Float ax1) (var Float ay1)
        extra += (ax1-ax0)*lc:scale
      extra /= count
      var Int count := 0
      each lc c:line_content
        lc:area x0 += count*extra ; lc:area x1 += count*extra
        if (lc:flags .and. line_adjust)<>0
          ((addressof lc:area) map BrowserArea2) space_extra_spacing := extra/lc:font:vector:length/lc:scale
        for (var Int i) 0 lc:text:len-1
          if lc:text:i=" "
            count += 1
  if c:position_extend_flag
    var Pointer:BrowserLineArea lc :> c:line_content last
    if exists:lc and (lc:flags .and. line_extend)<>0 and lc:area:x1<c:area_x1
      lc:area x1 := c area_x1
  c line_y0 := c area_y0
  c line_x := c area_x0 ; c line_y := c area_y0
  c line_content := var List:BrowserLineArea empty_list
  c line_flags := 0

method c addtoline a flags font scale text
  arg_rw BrowserContext c ; arg_rw BrowserArea a ; arg Int flags ; arg Font font ; arg Float scale ; arg Str32 text
  var Float move_y := (-a:y0)-(c:line_y-c:line_y0)
  if move_y>0
    each lc c:line_content
      lc:area y0 += move_y
      lc:area y1 += move_y
    c line_y += move_y
    c area_y0 += move_y
  var Float move_y := a:y1-(c:area_y0-c:line_y)
  if move_y>0
    c area_y0 += move_y
    # might need to switch to next area
  a x0 += c line_x ; a y0 += c line_y
  a x1 += c line_x ; a y1 += c line_y
  var BrowserLineArea la
  la area :> a
  la flags := flags
  la font :> font
  la scale := scale
  la text := text
  c line_content += la
  c line_x += a:x1-a:x0

method c addtoline n
  arg_rw BrowserContext c ; arg_rw BrowserNode n
  c addtoline n:area 0 (null map Font) undefined ""


method c newarea
  arg_rw BrowserContext c
  var Pointer:BrowserArea a :> c:areas first
  c area_x0 := a x0 ; c area_y0 := a y0 ; c area_x1 := a x1 ; c area_y1 := a y1
  c:areas remove a
  c newline false


#-----------------------------------------------------------------------------
#   tags helper functions


method c position_setup x0 y0 x1 y1 extend
  arg_rw BrowserContext c ; arg Float x0 y0 x1 y1 ; arg CBool extend
  c area_x0 := x0
  c area_y0 := y0
  c area_x1 := x1
  c area_y1 := y1
  c areas := var List:BrowserArea empty_areas_list
  c position_extend_flag := extend
  c newline false

method c set_position n x0 y0 x1 y1
  arg_rw BrowserContext c ; arg_rw BrowserNode n ; arg Float x0 y0 x1 y1
  var Pointer:BrowserArea a :> n area
  a x0 := x0 ; a y0 := y0 ; a x1 := x1 ; a y1 := y1

method c clear_position n
  arg_rw BrowserContext c ; arg_rw BrowserNode n
  if n:extra<>null
    memory_free n:extra ; n extra := null  


method c draw_setup draw x0 y0 x1 y1
  arg_rw BrowserContext c ; oarg_rw DrawPrototype draw ; arg Float x0 y0 x1 y1
  c draw :> draw
  c clip_x0 := x0 ; c clip_y0 := y0 ; c clip_x1 := x1 ; c clip_y1 := y1

method c gamut -> g
  arg_rw BrowserContext c ; oarg_R ColorGamut g
  g :> (c:draw image_prototype "") gamut

method c image img t
  arg_rw BrowserContext c ; oarg_rw ImagePrototype img ; arg Transform2 t
  c:draw image img t

method c rectangle x0 y0 x1 y1 color
  arg_rw BrowserContext c ; arg Float x0 y0 x1 y1 ; arg Address color
  c:draw rectangle x0 y0 x1 y1 color

method ctx rectangle x0 y0 x1 y1 round thickness color
  arg_rw BrowserContext ctx ; arg Float x0 y0 x1 y1 ; arg Float round thickness ; arg Address color
  (var Array:Curve curves) size := shunt thickness=defined 2 1
  var Pointer:Curve c :> curves 0 ; var CurvePoint p
  p := curve_point x0+round y0 false ; p tg_in -1 0 ; p tg_out 1 0 ; c += p
  p := curve_point x1-round y0 false ; p tg_in -1 0 ; p tg_out 1 0 ; c += p
  p := curve_point x1 y0+round false ; p tg_in 0 -1 ; p tg_out 0 1 ; c += p
  p := curve_point x1 y1-round false ; p tg_in 0 -1 ; p tg_out 0 1 ; c += p
  p := curve_point x1-round y1 false ; p tg_in 1 0 ; p tg_out -1 0 ; c += p
  p := curve_point x0+round y1 false ; p tg_in 1 0 ; p tg_out -1 0 ; c += p
  p := curve_point x0 y1-round false ; p tg_in 0 1 ; p tg_out 0 -1 ; c += p
  p := curve_point x0 y0+round false ; p tg_in 0 1 ; p tg_out 0 -1 ; c += p
  c compute outline
  if thickness=defined
    var Pointer:Curve c :> curves 1
    p := curve_point x0+round y0+thickness false ; p tg_in -1 0 ; p tg_out 1 0 ; c += p
    p := curve_point x1-round y0+thickness false ; p tg_in -1 0 ; p tg_out 1 0 ; c += p
    p := curve_point x1-thickness y0+round false ; p tg_in 0 -1 ; p tg_out 0 1 ; c += p
    p := curve_point x1-thickness y1-round false ; p tg_in 0 -1 ; p tg_out 0 1 ; c += p
    p := curve_point x1-round y1-thickness false ; p tg_in 1 0 ; p tg_out -1 0 ; c += p
    p := curve_point x0+round y1-thickness false ; p tg_in 1 0 ; p tg_out -1 0 ; c += p
    p := curve_point x0+thickness y1-round false ; p tg_in 0 1 ; p tg_out 0 -1 ; c += p
    p := curve_point x0+thickness y0+round false ; p tg_in 0 1 ; p tg_out 0 -1 ; c += p
    c compute outline
  ctx:draw fill curves fill_evenodd transform color

method c fill curves mode t color
  arg_rw BrowserContext c ; arg Array:Curve curves ; arg Int mode ; arg Transform2 t ; arg Address color
  c:draw fill curves mode t color

method c text txt font kerning t color
  arg_rw BrowserContext c ; arg Str32 txt ; arg Font font ; arg Address kerning ; arg Transform2 t ; arg Address color
  c:draw text txt font kerning t color


public

  type BrowserRawEvent
    field Str event ; field Str key ; field Int buttons ; field Int x0 y0 x1 y1 ; field Str options

method c event_setup event key buttons x y recurse
  arg_rw BrowserContext c ; arg Str event key ; arg Int buttons ; arg Float x y ; arg CBool recurse
  c event := event ; c key := key ; c buttons := buttons
  c x := x ; c y := y
  c target_id := "" ; c target_x0 := undefined ; c target_y0 := undefined ; c target_x1 := undefined ; c target_y1 := undefined ; c target_index := undefined
  c event_recurse_flag := recurse
  c event_discard_flag := false
  
method c event_setup event key recurse
  arg_rw BrowserContext c ; arg Str event key ; arg CBool recurse
  c event_setup event key undefined undefined undefined recurse


export '. bind'

export BrowserArea '. x0' '. y0' '. x1' '. y1'
export '. has_area' '. area'

export '. position_setup'
export '. mark' '. set' '. query' '. set_attributes' '. rewind'
export '. setup'
export '. newline' '. addtoline' '. line_flags' '. newarea'

export '. draw_setup'
export '. gamut' '. image' '. rectangle' '. fill' '. text'

export '. event_setup'