Patch title: Release 85 bulk changes
Abstract:
File: /pliant/graphic/sample/browser.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/protocol/http/client.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/image/pixmap.pli"
module "/pliant/graphic/image/packed.pli"
module "/pliant/graphic/image/antialiasing.pli"
module "/pliant/graphic/image/convert.pli"
module "/pliant/graphic/browser/prototype.pli"
module "/pliant/graphic/browser/parser.pli"
module "/pliant/graphic/os/x11.pli"
module "/pliant/graphic/filter/io.pli"
module "/pliant/graphic/browser/common.pli"
# module "/pliant/graphic/browser/debug.pli"


function rgb_color r g b -> rgb
  arg Int r g b rgb
  check r>=0 and r<256 and g>=0 and g<256 and b>=0 and b<256
  rgb := r+g*2^8+b*2^16

constant dpi 72
constant page_mm_x 210
constant page_mm_y 297
constant ground_color (rgb_color 208 208 208)
constant antialiasing 1
constant margin 5
constant window_size_x (cast page_mm_x/25.4*dpi Int)+2*margin
constant window_size_y (cast page_mm_y/25.4*dpi Int)+2*margin
constant memory_maximum_buffer 8*2^20
constant window_max_x 8192
constant window_max_y 8192


gvar Pointer:XDisplay display :> XOpenDisplay ":0.0"
if not exists:display
  error "Failed to open X11 display"
gvar Pointer:XScreen screen :> (display:screens translate XScreen display:default_screen) map XScreen
gvar Pointer:XVisual visual :> screen root_visual
if screen:root_depth<>24
  error "Pliant requires X11 to work in truecolor mode (either 24 or 32 bits per pixel)"

function x11_gamut_name -> name
  arg Str name
  name := "rgb"
  if visual:red_mask=255*2^16
    name := shunt name="rgb" "bgr" "rgb"
  if (shunt processor_is_low_indian LSBFirst MSBFirst)<>display:byte_order
    name := shunt name="rgb" "bgr" "rgb"
  check display:bitmap_unit=24 or display:bitmap_unit=32
  if display:bitmap_unit=32
    name += "32"


function x11_color rgb -> c
  arg Int rgb ; arg Str c
  function hexa2 i -> h2
    arg Int i ; arg Str h2
    h2 := right (string i "radix 16") 2 "0"
  c := "rgb:"+(hexa2 rgb%256)+"/"+(hexa2 rgb\256%256)+"/"+(hexa2 rgb\256^2)

if (XAllocNamedColor display screen:cmap x11_color:ground_color (gvar XColor x11_ground_exact) (gvar XColor x11_ground))=0
  error "Failed to allocate X11 ground color"


function redraw drawing ux uy ix0 iy0 ix1 iy1 window x y
  oarg_rw D2Box drawing ; arg Float ux uy ; arg Int ix0 iy0 ix1 iy1 ; arg XWindow window ; arg Int x y
  if ix1<=ix0 or iy1<=iy0
    return
  if (ix1-ix0)*(iy1-iy0)*antialiasing*antialiasing*3>memory_maximum_buffer
    var Int m := (iy0+iy1)\2
    redraw drawing ux uy ix0 iy0 ix1 m window x y
    redraw drawing ux uy ix0 m ix1 iy1 window x y+m-iy0
    return
  if antialiasing=1
    var Link:ImagePixmap pixmap :> new ImagePixmap
    pixmap setup (image_prototype ix0*ux iy0*uy ix1*ux iy1*uy ix1-ix0 iy1-iy0 color_gamut:"rgb") ""
    var Link:ImagePrototype initial :> pixmap
    var Link:ImagePrototype final :> pixmap
  else
    var Link:ImagePixmap packed :> new ImagePixmap
    # var Link:ImagePacked packed :> new ImagePacked
    packed setup (image_prototype ix0*ux iy0*uy ix1*ux iy1*uy (ix1-ix0)*antialiasing (iy1-iy0)*antialiasing color_gamut:"rgb") ""
    var Link:ImageAntiAliasing aa :> new ImageAntiAliasing
    aa bind packed antialiasing
    var Link:ImagePrototype initial :> packed
    var Link:ImagePrototype final :> aa
  var Link:ImageConvert conv :> new ImageConvert
  conv bind final color_gamut:x11_gamut_name ""
  final :> conv
  var Address linebuf := memory_allocate final:line_size null
  # var Int background := rgb_color 240 240 240
  # for (var Int y) 0 initial:size_y-1
  #   initial fill 0 y initial:size_x addressof:background
  (var D2Context context) bind initial
  initial fill initial:x0 initial:y0 initial:x1 initial:y1 addressof:ground_color
  drawing draw initial context
  var XGC gc := XCreateGC display window 0 (var XGCValues gcvalues) 
  var XImage img
  img width := final size_x
  img height := 1
  img xoffset := 0
  img format := ZPixmap
  img byte_order := display byte_order
  check display:bitmap_unit=final:pixel_size*8
  img bitmap_unit := display bitmap_unit
  img bitmap_bit_order := display bitmap_bit_order
  img bitmap_pad := display bitmap_pad
  img depth := screen root_depth
  img bytes_per_line := final line_size
  img bits_per_pixel := final:pixel_size*8
  img red_mask := visual red_mask
  img green_mask := visual green_mask
  img blue_mask := visual blue_mask
  img data := linebuf
  if not (XInitImage img)
    error "Failed to setup X11 image"
  for (var Int iy) 0 final:size_y-1
    final read 0 iy final:size_x linebuf
    if (XPutImage display window gc img 0 0 x y+iy final:size_x 1)<>0
      error "Failed to draw X11 image"
  # XSetForeground display gc (rgb_color 255 128 128)
  # XFillRectangle display window gc final:size_x-5 0 5 5
  XFreeGC display gc
  memory_free linebuf


type BrowserPage
  field Str url form
  field Int tx ty


constant trace false

function browse url0 user password
  arg Str url0 user password
  var List:BrowserPage backward
  var List:BrowserPage forward
  var Str url := url0 ; var Str form := ""
  var Str options := ""
  if user<>""
    options := "user "+string:user+" password "+string:password
  var Int tx := -margin ; var Int ty := -margin
  var DateTime dt := datetime
  var Link:D2Box drawing :> html_parse url form options
  console "loaded in " string:(cast (datetime:seconds-dt:seconds)*1000 Int) " ms" eol
  (var D2Context context) bind (image_prototype 0 0 page_mm_x page_mm_y window_size_x window_size_y color_gamut:"rgb")
  drawing position context
  # drawing display_position ""
  var Int memo_x memo_y ; var CBool scroll
  var XSetWindowAttributes a
  a background_pixel := x11_ground pixel
  a override_redirect := false # true
  a event_mask := PointerMotionMask+ButtonPressMask+ButtonReleaseMask+KeyPressMask+KeyReleaseMask+ExposureMask
  var uInt mask := CWBackPixel+CWBorderPixel+CWOverrideRedirect+CWEventMask
  var XWindow window := XCreateWindow display screen:root 0 0 window_size_x window_size_y 0 screen:root_depth InputOutput screen:root_visual mask a
  XStoreName display window "Pliant browser"
  XMapWindow display window
  while true
    XNextEvent display (var XEvent event)
    if event:type=Expose or event:type=GraphicsExpose
      var Pointer:XExposeEvent expose :> addressof:event map XExposeEvent
      if trace
        console "redraw " expose:x " " expose:y " " expose:x+expose:width " " expose:y+expose:height " (" expose:count ")" eol
      var DateTime dt := datetime
      redraw drawing 25.4/dpi 25.4/dpi expose:x+tx expose:y+ty expose:x+expose:width+tx expose:y+expose:height+ty window expose:x expose:y
      # console (cast (datetime:seconds-dt:seconds)*1000 Int) " ms" eol
      if event:type=GraphicsExpose and expose:count=0
        scroll := true
    eif event:type=NoExpose
      if trace
        console "noexpose" eol
      scroll := true
    eif event:type=KeyPress or event:type=KeyRelease
      var Pointer:XKeyEvent k :> addressof:event map XKeyEvent
      console "key " k:keycode " state " k:state
      var Str key := "                     "
      memory_clear addressof:(var XComposeStatus cstatus) XComposeStatus:size
      XLookupString k key:characters key:len (var XKeySym keysym) cstatus
      key := key 0 (key search "[0]" 0)
      (var Str compose) set cstatus:compose_ptr cstatus:chars_matched false
      console " -> keysym " keysym:id " [dq]" key "[dq] compose [dq]" compose "[dq]" eol
      var D2Event ev
      ev type := shunt event:type=KeyPress event_key event_other
      ev key := undefined
      if key:len=1
        ev key := key:0:number
      ev status := shunt (k:state .and. 256)<>0 mouse_button_1_up mouse_button_1_down 
      ev status += shunt (k:state .and. 512)<>0 mouse_button_2_up mouse_button_2_down
      ev status += shunt (k:state .and. 1024)<>0 mouse_button_3_up mouse_button_3_down
      ev x := (k:x+tx)*25.4/dpi
      ev y := (k:y+ty)*25.4/dpi
      ev options := "x11_key_"+(shunt event:type=KeyPress "pressed" "released")+" x11_keysym "+(string keysym:id)+" x11_state "+(string k:state)+" x11_keycode "+(string k:keycode)
      ev url := ""
      drawing event ev
      if event:type=KeyPress
        if keysym:id=XK_F0+1 and (exists backward:last)
          var BrowserPage bp ; bp url := url ; bp form := form ; bp tx := tx ; bp ty := ty
          forward += bp
          url := backward:last url
          form := backward:last form
          tx := backward:last tx
          ty := backward:last ty
          backward remove backward:last
          var Str options := ""
          if user<>"" and (url0 parse "http://" any:(var Str server0) "/" any) and (url parse "http://" any:(var Str server) "/" any) and server=server0
            options := "user "+string:user+" password "+string:password
          console "backward " url eol
          drawing :> html_parse url form options
          (var D2Context context) bind (image_prototype 0 0 page_mm_x page_mm_y window_size_x window_size_y color_gamut:"rgb")
          drawing position context
          XClearArea display window 0 0 window_max_x window_max_y true
        eif keysym:id=XK_F0+2 and (exists forward:last)
          var BrowserPage bp ; bp url := url ; bp form := form ; bp tx := tx ; bp ty := ty
          backward += bp
          url := forward:last url
          form := forward:last form
          tx := forward:last tx
          ty := forward:last ty
          forward remove forward:last
          var Str options := ""
          if user<>"" and (url0 parse "http://" any:(var Str server0) "/" any) and (url parse "http://" any:(var Str server) "/" any) and server=server0
            options := "user "+string:user+" password "+string:password
          console "forward " url eol
          drawing :> html_parse url form options
          (var D2Context context) bind (image_prototype 0 0 page_mm_x page_mm_y window_size_x window_size_y color_gamut:"rgb")
          drawing position context
          XClearArea display window 0 0 window_max_x window_max_y true
    eif event:type=ButtonPress or event:type=ButtonRelease
      var Pointer:XButtonEvent button :> addressof:event map XButtonEvent
      if true # trace
        console "button " button:button " state " button:state " position " button:x " " button:y eol
      if event:type=ButtonPress and button:button=2
        memo_x := button x ; memo_y := button y ; scroll := true
      var D2Event ev
      ev type := event_mouse
      ev key := undefined
      ev status := shunt (button:button=1 and event:type=ButtonPress) mouse_button_1_pressed (button:button=1 and event:type=ButtonRelease) mouse_button_1_released (button:state .and. 256)<>0 mouse_button_1_up mouse_button_1_down
      ev status += shunt (button:button=2 and event:type=ButtonPress) mouse_button_2_pressed (button:button=2 and event:type=ButtonRelease) mouse_button_2_released (button:state .and. 512)<>0 mouse_button_2_up mouse_button_2_down
      ev status += shunt (button:button=3 and event:type=ButtonPress) mouse_button_3_pressed (button:button=3 and event:type=ButtonRelease) mouse_button_3_released (button:state .and. 1024)<>0 mouse_button_3_up mouse_button_3_down
      ev x := (button:x+tx)*25.4/dpi
      ev y := (button:y+ty)*25.4/dpi
      ev options := "x11_state "+(string button:state)+" x11_button "+(string button:button)
      ev url := "" ; ev form := ""
      drawing event ev
      if event:type=ButtonPress
        if button:button=1 and ev:url<>""
          var BrowserPage bp ; bp url := url ; bp form := form ; bp tx := tx ; bp ty := ty
          backward += bp
          forward := var List:BrowserPage empty_list
          url := url_concat url ev:url
          form :=  ev form
          tx := -margin ; ty := -margin
          var Str options := ""
          if user<>"" and (url0 parse "http://" any:(var Str server0) "/" any) and (url parse "http://" any:(var Str server) "/" any) and server=server0
            options := "user "+string:user+" password "+string:password
          console url eol
          drawing :> html_parse url form options
          (var D2Context context) bind (image_prototype 0 0 page_mm_x page_mm_y window_size_x window_size_y color_gamut:"rgb")
          drawing position context
          XClearArea display window 0 0 window_max_x window_max_y true
    eif event:type=MotionNotify
      var Pointer:XMotionEvent motion :> addressof:event map XMotionEvent
      if trace
        console "motion " motion:x " " motion:y " (" motion:state ")" eol
      if motion:state=512 and scroll # middle button is down
        var Int delta_x := min motion:x-memo_x tx+margin ; var Int delta_y := min motion:y-memo_y ty+margin
        if delta_x<>0 or delta_y<>0
          var XGC gc := XCreateGC display window 0 (var XGCValues gcvalues)
          XCopyArea display window window gc -delta_x -delta_y window_max_x+abs:delta_x window_max_y+abs:delta_y 0 0
          XFreeGC display gc
          scroll := false
        tx -= delta_x ; ty -= delta_y
        memo_x := motion x ; memo_y := motion y
    else
      console "unknown event " event:type eol

function browse url
  arg Str url
  browse url "" ""

export browse

console "Pliant browser is running." eol
console "F1 = back" eol
console "F2 = forward" eol
console "mouse middle button = scroll" eol