Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/layout/prototype.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/color/color.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/graphic/draw/prototype.pli"

public


type LayoutArea
  field Float x0 y0 x1 y1

method a reset
  arg_rw LayoutArea a
  a x0 := undefined
  a y0 := undefined
  a x1 := undefined
  a y1 := undefined

method a extend a2
  arg_rw LayoutArea a ; arg LayoutArea a2
  if a:x0=undefined
    a := a2
  eif a2:x0<>undefined
    a x0 := min a:x0 a2:x0
    a y0 := min a:y0 a2:y0
    a x1 := max a:x1 a2:x1
    a y1 := max a:y1 a2:y1

method a finish
  arg_rw LayoutArea a
  if a:x0=undefined
    a x0 := 0
    a y0 := 0
    a x1 := 0
    a y1 := 0

method a intersects a2 -> c
  arg_rw LayoutArea a ; arg LayoutArea a2 ; arg CBool c
  c := a:x0<a2:x1 and a:y0<a2:y1 and a:x1>a2:x0 and a:y1>a2:y0
    

type LayoutColor
  field Link:ColorGamut gamut
  field Address value_or_address

function destroy c
  arg_w LayoutColor c
  if (exists c:gamut) and c:gamut:pixel_size>Address:size
    memory_free c:value_or_address
    
function copy src dest
  arg LayoutColor src ; arg_w LayoutColor dest
  if (exists dest:gamut) and dest:gamut:pixel_size>Address:size
    memory_free dest:value_or_address
  dest gamut :> src gamut
  if (exists dest:gamut) and dest:gamut:pixel_size>Address:size
    dest value_or_address := memory_allocate dest:gamut:pixel_size addressof:dest
    memory_copy src:value_or_address dest:value_or_address dest:gamut:pixel_size
  else
    dest value_or_address := src value_or_address

gvar Link:ColorGamut layout_gamut_rgb :> color_gamut "rgb"

function 'cast LayoutColor' rgb -> c
  arg ColorRGB888 rgb ; arg LayoutColor c
  extension
  if (exists c:gamut) and c:gamut:pixel_size>Address:size
    memory_free c:value_or_address
  c gamut :> layout_gamut_rgb
  memory_copy addressof:rgb (addressof c:value_or_address) 3


type LayoutPrototype
  field Link:LayoutPrototype next
  field Int parent_and_flags <- 0


type LayoutStyleText
  field (Array Link:Font) font
  field Float scale
  field Float slide
  field LayoutColor color
  field CBool bold
  field CBool italic
  field CBool fixed
  field CBool wrap
  field CBool justify
  field Int align
  field Float head_padding tail_padding

type LayoutStyleLink
  field LayoutColor color

type LayoutStyleTable
  field Float padding
  field Float border_size
  field LayoutColor border_color

type LayoutStyleCell
  field LayoutColor bg_color
  field LayoutColor header_bg_color

type LayoutStyleInput
  field Float padding_x padding_y
  field Float border_size
  field LayoutColor border_color
  field LayoutColor background_color
  field Float round
  field Link:Font value_font
  field Float value_scale
  field LayoutColor value_color

type LayoutStyleButton
  field Float padding_x padding_y
  field Float border_size
  field LayoutColor border_color
  field LayoutColor inactive_border_color
  field LayoutColor selected_border_color
  field LayoutColor background_color
  field LayoutColor inactive_background_color
  field LayoutColor selected_background_color
  field Float round
  field Link:Font label_font
  field Float label_scale
  field LayoutColor label_color
  field LayoutColor inactive_label_color
  field LayoutColor selected_label_color
  field LayoutColor key_color
  field LayoutColor inactive_key_color
  field LayoutColor selected_key_color
  field Link:Font key_font
  field Float key_scale
  field Float key_padding

type LayoutStyleFocus
  field Float thickness
  field LayoutColor color

type LayoutStyle
  field LayoutStyleText text
  field LayoutStyleText header
  field LayoutStyleText title
  field LayoutStyleLink link
  field LayoutStyleTable table
  field LayoutStyleCell cell
  field LayoutStyleInput input
  field LayoutStyleButton button
  field LayoutStyleFocus focus

method s reset
  arg_rw LayoutStyle s
  implicit s
    text:font size := 8
    constant ffamily "Bitstream Vera" # "Free"
    constant sans " Sans"
    constant bold " Bold"
    constant italic " Oblique"
    constant mono (shunt ffamily="Free" " Monospaced" ffamily="Bitstream Vera" " Sans Mono" " Mono")
    text:font 0 :> font ffamily+sans
    text:font 1 :> font ffamily+sans+bold
    text:font 2 :> font ffamily+sans+italic
    text:font 3 :> font ffamily+sans+bold+italic
    text:font 4 :> font ffamily+mono
    text:font 5 :> font ffamily+mono+bold
    text:font 6 :> font ffamily+mono+italic
    text:font 7 :> font ffamily+mono+bold+italic
    text scale := 12/72*25.4
    text slide := 0
    text color := color rgb 0 0 0
    text bold := false
    text italic := false
    text fixed := false
    text wrap := true
    text justify := false
    text align := -1
    text head_padding := 6/72*25.4
    text tail_padding := 6/72*25.4
    header := text
    header scale := 16/72*25.4
    header bold := true
    header head_padding := 12/72*25.4
    title := text
    title scale := 24/72*25.4
    title bold := true
    title align := 0
    title head_padding := 0
    title tail_padding := 0
    link color := color rgb 0 0 192
    table padding := 1
    table border_size := 0.5
    table border_color := color rgb 0 0 0
    cell header_bg_color := color rgb 208 208 208
    input padding_x := 2 ; input padding_y := 0
    input border_size := 0.5
    input border_color := color rgb 192 192 192
    input background_color := color rgb 248 248 224
    input round := 1
    input value_font :> font ffamily+sans
    input value_scale := 12/72*25.4
    input value_color := color rgb 0 0 0
    button padding_x := 5 ; button padding_y := 0
    button border_size := 0.5
    button border_color := color rgb 192 192 192
    button inactive_border_color := color rgb 224 224 224
    button selected_border_color := color rgb 168 168 168
    button background_color := color rgb 136 136 136
    button inactive_background_color := color rgb 208 208 208
    button selected_background_color := color rgb 96 96 96
    button round := 1
    button label_font :> font ffamily+sans
    button label_scale := 12/72*25.4
    button label_color := color rgb 255 255 255
    button inactive_label_color := color rgb 240 240 240
    button selected_label_color := color rgb 255 255 255
    button key_color := color rgb 255 255 80
    button inactive_key_color := color rgb 240 240 192
    button selected_key_color := color rgb 255 255 80
    button key_font :> font ffamily+sans
    button key_scale := 8/72*25.4
    button key_padding := 2
    focus thickness := 0.75
    focus color := color rgb 255 0 0


type LayoutPC
  field Link:LayoutStyle style
  field List:LayoutArea all_areas
  field Pointer:LayoutArea current_area
  field LayoutArea area
  field Int flags # 1 clip, 2 test_x, 4 test_y
  field Address window_address <- null

constant layout_pos_clip 1
constant layout_pos_test_x 2
constant layout_pos_test_y 4
constant layout_pos_verify 8


type LayoutDC
  field Link:LayoutStyle style
  field LayoutArea bbox
  field Link:ColorGamut gamut
  field Link:ColorGamut convert_gamut
  field Arrow convert_speedup
  field ColorBuffer convert_buffer
  field Address window_address <- null
  field CBool focus_scroll_study <- false

method dc color c -> pixel
  arg_rw LayoutDC dc ; arg LayoutColor c ; arg Address pixel
  pixel := shunt c:gamut:pixel_size>Address:size c:value_or_address (addressof c:value_or_address)
  if (addressof c:gamut)<>(addressof dc:gamut)
    if (addressof dc:convert_gamut)<>(addressof c:gamut)
      dc convert_gamut :> c gamut
      dc:convert_speedup := dc:gamut speedup c:gamut ""
    dc:gamut convert c:gamut pixel (addressof dc:convert_buffer) 1 dc:convert_speedup
    pixel := addressof dc:convert_buffer


type LayoutEC
  field Link:LayoutStyle style
  field Str event key ; field Int buttons ; field Float x y <- undefined ; field Str options
  field Address window_address <- null
  field Int mode
  field Link:LayoutPrototype pointer_target
  field Int pointer_index <- undefined
  field Int focus_was
  field CBool cancel <- false

constant layout_event_shortcut 0
constant layout_event_pointer 1
constant layout_event_focus 2


method l position c -> b
  oarg_rw LayoutPrototype l ; arg_rw LayoutPC c ; arg LayoutArea b
  generic
  console "'position' method should not be called for '"+(entry_type addressof:l):name+"'" eol
  error "'position' method should not be called for '"+(entry_type addressof:l):name+"'"

method l bbox c -> b
  oarg_rw LayoutPrototype l ; arg_rw LayoutPC c ; arg LayoutArea b
  # query within paragraph objects bbox
  generic
  console "'box' method should not be called for '"+(entry_type addressof:l):name+"'" eol
  error "'box' method should not be called for '"+(entry_type addressof:l):name+"'"

method l translate tx ty
  oarg_rw LayoutPrototype l ; arg Float tx ty
  # set within paragraph objects position
  generic
  console "'translate' method should not be called for '"+(entry_type addressof:l):name+"'" eol
  error "'translate' method should not be called for '"+(entry_type addressof:l):name+"'"

method l offset tx ty
  oarg_rw LayoutPrototype l ; arg Float tx ty
  # offset within paragraph objects position
  generic
  console "'offset' method should not be called for '"+(entry_type addressof:l):name+"'" eol
  error "'offset' method should not be called for '"+(entry_type addressof:l):name+"'"


method l draw d c
  oarg_rw LayoutPrototype l ; oarg_rw DrawPrototype d ; arg_rw LayoutDC c
  generic


method l event c
  oarg_rw LayoutPrototype l ; arg_rw LayoutEC c
  generic


method l set_parent p
   arg_rw LayoutPrototype l ; arg LayoutPrototype p
   l parent_and_flags := cast addressof:p Int

method l parent -> p
   arg LayoutPrototype l ; arg_C LayoutPrototype p
   p :> (cast (l:parent_and_flags .and. -2) Address) map LayoutPrototype

method l set_position
   arg_rw LayoutPrototype l
   l parent_and_flags := (l:parent_and_flags .and. -2) .or. 1

method l reset_position
   arg_rw LayoutPrototype l
   l parent_and_flags := (l:parent_and_flags .and. -2)

method l positioned -> c
   arg LayoutPrototype l ; arg CBool c
   c := (l:parent_and_flags .and. 1)<>0


gvar Link:LayoutPrototype null_ptr

method l first -> p
  oarg_rw LayoutPrototype l ; arg_C Link:LayoutPrototype p
  generic
  check not exists:null_ptr
  p :>> null_ptr


if false
  method l unlink
    oarg_rw LayoutPrototype l
    var Link:LayoutPrototype cur :> l first
    while exists:cur
      var Link:LayoutPrototype next :> cur next
      cur next :> null map LayoutPrototype
      cur :> next