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


public

  type BrowserArea
    field Float x0 y0 x1 y1

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

 
  type BrowserWindow
    field Str name
    field Address session_address
    field Str root # id of the root node in the document
    field BrowserArea bbox focus
    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 # FIXME: will be replaced by an image based mechanism
    field Int antialiasing <- 4
  
  type BrowserSession
    field Link:BrowserDocument document
    field Address console_address
    field BrowserWindow main top left right bottom
    field Int position <- 15 # 1=top left, 2 = top right, 4 = bottom_left, 8 = bottom_right
    field Int space_size <- 1 ; field Int space_color <- 0C0C0C0h # FIXME: will be replaced by an image based mechanism
    field List:Str history # URLs

  type BrowserConsole
    field Link:ConsolePrototype console
    field (Array BrowserSession 13) session
    field Array:Int zorder
    field Float unit_x unit_y # pixel size is mm
    field Int size_x size_y # screen or OS window size
    field Link:ColorGamut rgb gamut
    field Int left_border top_border right_border bottom_border # borders pixels size
    field Int space_min_size <- 1 ; field Int space_max_size <- 16
    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

  
  type BrowserStage
    field Str parent_id previous_id

  type BrowserContext
    field Pointer:BrowserDocument document
    field Pointer:BrowserConsole console
    field Pointer:BrowserSession session
    field Pointer:BrowserWindow window
    field Pointer: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
    # current line
    field Float line_y0 line_x line_y
    field (List Pointer:BrowserArea) line_content
    field CBool line_center
    # parse instructions
    field Str next_id current_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 Float target_x0 target_y0 target_x1 target_y1
    field Int target_index
    field CBool process_instructions_flag
    field CBool discard_event_flag


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


method c bind window connection
  arg_rw BrowserContext c ; arg BrowserWindow window ; arg_rw Stream connection
  c document :> window:session document
  c console :> window:session console
  c session :> window session
  c window :> window
  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+" "+attr value
  var (Pointer List:Str) l :> c:stack last
  l += tag+" "+attr

method c query tag attr -> value
  arg BrowserContext c ; arg Str tag attr value
  var Pointer:Str p :> c:values first tag+" "+attr
  if exists:p
    value := p
  else
    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 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

method c newline
  arg_rw BrowserContext c
  if c:line_center
    var Float move_x := 0.5*(c:area_x1-c:line_x)
    each lc c:line_content
      lc x0 += move_x
      lc x1 += move_x
  c line_y0 := c area_y0
  c line_x := c area_x0 ; c line_y := c area_y0
  c line_content := var (List Pointer:BrowserArea) empty_list
  c line_center := false

method c addtoline a
  arg_rw BrowserContext c ; arg_rw BrowserArea a
  # vcenter is not covered yet
  var Float move_y := (-a:y0)-(c:line_y-c:line_y0)
  if move_y>0
    each lc c:line_content
      lc y0 += move_y
      lc 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 Pointer:BrowserArea p :> a ; c line_content += p
  c line_x += a:x1-a:x0

method c addtoline n
  arg_rw BrowserContext c ; arg_rw BrowserNode n
  c addtoline n:area


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


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


method c position_setup x0 y0 x1 y1
  arg_rw BrowserContext c ; arg Float x0 y0 x1 y1
  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 newline


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 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 length t color
  arg_rw BrowserContext c ; arg Str32 txt ; arg Font font ; arg Address kerning ; arg Float length ; arg Transform2 t ; arg Address color
  c:draw text txt font kerning length t color


method c event_setup event key buttons x y
  arg_rw BrowserContext c ; arg Str event key ; arg Int buttons ; arg Float x y
  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 process_instructions_flag := false
  c discard_event_flag := false

method c process_instructions
  arg_rw BrowserContext c
  c process_instructions_flag := true

method c discard_event
  arg_rw BrowserContext c
  c discard_event_flag := true


export '. bind'

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

export '. position_setup'
export '. mark' '. set' '. query' '. rewind'
export '. newline' '. addtoline' '. line_center' '. newarea'

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

export '. event_setup' '. process_instructions' '. discard_event'