Patch title: Release 87 bulk changes
Abstract:
File: /pliant/graphic/browser/tag/prototype.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/unsafe.pli"
module "/pliant/admin/file.pli"
module "/pliant/graphic/draw/prototype.pli"

public


type XmlPrototype
  void

method t position c
  oarg_rw XmlPrototype t ; arg_rw XmlContext c
  generic

method t draw d c
  oarg_rw XmlPrototype t ; oarg_rw DrawPrototype d ; arg_rw D2Context c
  generic


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


gvar Link:Font default_font :> font "Times"
if false # not exists:default_font
  console "Scanning your /usr/ directory for fonts ..." eol
  font_scan "embedded:/usr/"
  default_font :> font "Times"
  if not exists:default_font
    console "Could not find Times font in your system !" eol
  else
    console "done." eol

function build c
  arg_w D2Context c
  c font :> default_font
  c scale := 4
  c color := 0


method b translate tx ty
  oarg_rw XmlPrototype b ; arg Float tx ty
  if b:x0=defined
    b x0 += tx
    b y0 += ty
    b x1 += tx
    b y1 += ty
  var Pointer:(List Link:XmlPrototype) l :> b list
  if exists:l
    each bb l
      bb translate tx ty


method c newline
  arg_rw D2Context c
  c line_y0 := c y0
  c line_x := c x0 ; c line_y := c y0
  c line_boxes := var (List Link:XmlPrototype) empty_boxes_list

method c newarea
  arg_rw D2Context c
  var Pointer:D2Area a :> c:areas first
  c x0 := a x0 ; c y0 := a y0 ; c x1 := a x1 ; c y1 := a y1
  c:areas remove a
  c newline

method c addtoline b
  arg_rw D2Context c ; oarg_rw XmlPrototype b
  # vcenter is not covered yet
  if c:line_x+b:x1-b:x0>c:x1 and c:line_x<>c:x0
    c newline
  var Float move_y := (-b:y0)-(c:line_y-c:line_y0)
  if move_y>0
    each lb c:line_boxes
      lb translate 0 move_y
    c line_y += move_y
    c y0 += move_y
  var Float move_y := b:y1-(c:y0-c:line_y)
  if move_y>0
    c y0 += move_y
    # might need to switch to next area
  b translate c:line_x c:line_y
  var Link:XmlPrototype l :> b ; c line_boxes += l
  c line_x += b:x1-b:x0


method b position_undefined c
  oarg_rw XmlPrototype b ; arg_rw D2Context c
  b x0 := undefined
  b y0 := undefined
  b x1 := undefined
  b y1 := undefined
  var Pointer:(List Link:XmlPrototype) l :> b list
  if exists:l
    each bb l
      bb position c

method b position_container c
  oarg_rw XmlPrototype b ; arg_rw D2Context c
  function position_include b c
    oarg_rw XmlPrototype b ; arg_rw XmlPrototype c
    if b:x0=defined
      c x0 := min c:x0 b:x0
      c y0 := min c:y0 b:y0
      c x1 := max c:x1 b:x1
      c y1 := max c:y1 b:y1
    else
      var Pointer:(List Link:XmlPrototype) l :> b list
      if exists:l
        each bb l
          position_include bb c
  b x0 := float_max
  b y0 := float_max
  b x1 := float_min
  b y1 := float_min
  var Pointer:(List Link:XmlPrototype) l :> b list
  if exists:l
    each bb l
      bb position c
      position_include bb b
  if b:x0=float_max
    b x0 := undefined
    b y0 := undefined
    b x1 := undefined
    b y1 := undefined

method b position_zero c
  oarg_rw XmlPrototype b ; arg_rw D2Context c
  var D2Context c2 := c
  c2 x0 := 0
  c2 y0 := 0
  c2 x1 := c:x1-c:x0
  c2 y1 := float_max/2
  c2 newline
  b position_container c2  

method b position_hidden c
  oarg_rw XmlPrototype b ; arg_rw D2Context c
  b x0 := undefined
  b y0 := undefined
  b x1 := undefined
  b y1 := undefined
  var Pointer:(List Link:XmlPrototype) l :> b list
  if exists:l
    each bb l
      bb position_hidden c


method b draw_recurse img c
  oarg_rw XmlPrototype b ; oarg_rw ImagePrototype img ; arg_rw D2Context c
  var Pointer:(List Link:XmlPrototype) l :> b list
  if exists:l
    each bb l
      if bb:x0=undefined
        bb draw img c
      eif bb:x0<=img:x1 and bb:y0<=img:y1 or bb:x1>=img:x0 and bb:y1>=img:y0
        bb draw img c


method c bind img
  arg_rw D2Context c ; arg ImagePrototype img
  c x0 := img x0
  c y0 := img y0
  c x1 := img x1
  c y1 := img y1
  c areas := var List:D2Area empty_areas_list
  c newline


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


enumerated D2EventType
  event_mouse
  event_key
  event_extended_key
  event_function_key
  event_other

flagset D2EventStatus
  mouse_button_1
  mouse_button_1_up
  mouse_button_1_pressed
  mouse_button_1_down
  mouse_button_1_released
  mouse_button_2
  mouse_button_2_up
  mouse_button_2_pressed
  mouse_button_2_down
  mouse_button_2_released
  mouse_button_3
  mouse_button_3_up
  mouse_button_3_pressed
  mouse_button_3_down
  mouse_button_3_released
  keyboard_alt
  keyboard_alt_1 
  keyboard_alt_2
  keyboard_shift
  keyboard_shift_1 
  keyboard_shitf_2 
  keyboard_ctrl
  keyboard_ctrl_1
  keyboard_ctrl_2

type D2Event
  field D2EventType type
  field Int key
  field D2EventStatus status
  field Float x y
  field Str options
  #
  field Str potencial_url
  field Link:XmlPrototype form_box
  field Str url form
 
method b event e
  oarg_rw XmlPrototype b ; arg_rw D2Event e
  generic
  var Pointer:(List Link:XmlPrototype) l :> b list
  if exists:l
    each bb l
      bb event e


function url_concat base extra -> url
  arg Str base extra url
  if (extra parse "http://" any)
    url := extra
  eif (extra parse "/" any) and (base parse "http://" any:(var Str server) "/" any)
    url := "http://"+server+extra
  else
    url := (base 0 (base search_last "/" -1)+1)+extra
  while (reverse:url eparse any:(var Str head) "/../" any "/" any:(var Str tail))
   url := reverse:tail+"/"+reverse:head


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


gvar Dictionary html_tags