Patch title: Release 90 bulk changes
Abstract:
File: /protocol/vnc/client.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/linux/input/keyboard.pli"
module "/pliant/linux/input/mouse.pli"
module "/pliant/language/os.pli"


module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/linux/input/keyboard.pli"
module "/pliant/linux/input/mouse.pli"
module "/pliant/language/os.pli"


constant os_FBIOBLANK 4611h

type os_vt_stat
  field uInt16 v_active
  field uInt16 v_signal
  field uInt16 v_state


type os_vt_stat
  field uInt16 v_active
  field uInt16 v_signal
  field uInt16 v_state


function kbd_map ch -> c

function kbd_map0 ch -> c
  arg Str ch ; arg Int c
  if (ch parse c)
    void
  eif ch="enter"
    c := 0FF0Dh
  eif ch="backspace"
    c := 0FF08h
  eif ch="tab"
    c := 0FF09h
  eif ch="escape"
    c := 0FF1Bh
  eif ch="insert"
    c := 0FF63h
  eif ch="delete"
    c := 0FFFFh
  eif ch="home"
    c := 0FF50h
  eif ch="end"
    c := 0FF57h
  eif ch="pageup"
    c := 0FF55h
  eif ch="pagedown"
    c := 0FF56h
  eif ch="left"
    c := 0FF51h
  eif ch="up"
    c := 0FF52h
  eif ch="right"
    c := 0FF53h
  eif ch="down"
    c := 0FF54h
  eif (ch parse "F" (var Int i)) and i>=1 and i<=12
    c := 0FFBDh+i
  arg Str ch ; arg Int c
  if (ch parse c)
    void
  eif ch="enter"
    c := 0FF0Dh
  eif ch="backspace"
    c := 0FF08h
  eif ch="tab"
    c := 0FF09h
  eif ch="escape"
    c := 0FF1Bh
  eif ch="insert"
    c := 0FF63h
  eif ch="delete"
    c := 0FFFFh
  eif ch="home"
    c := 0FF50h
  eif ch="end"
    c := 0FF57h
  eif ch="pageup"
    c := 0FF55h
  eif ch="pagedown"
    c := 0FF56h
  eif ch="left"
    c := 0FF51h
  eif ch="up"
    c := 0FF52h
  eif ch="right"
    c := 0FF53h
  eif ch="down"
    c := 0FF54h
  eif (ch parse "F" (var Int i)) and i>=1 and i<=12
    c := 0FFBDh+i
  eif ch="press left shift"
  eif ch="left shift"
    c := 0FFE1h
    c := 0FFE1h
  eif ch="release left shift"
    c := -0FFE1h
  eif ch="press right shift"
  eif ch="right shift"
    c := 0FFE2h
    c := 0FFE2h
  eif ch="release right shift"
    c := -0FFE2h
  eif ch="press left ctrl"
  eif ch="left ctrl"
    c := 0FFE3h
    c := 0FFE3h
  eif ch="release left ctrl"
    c := -0FFE3h
  eif ch="press right ctrl"
  eif ch="right ctrl"
    c := 0FFE4h
    c := 0FFE4h
  eif ch="release right ctrl"
    c := -0FFE4h
  eif ch="press left alt"
  eif ch="left alt"
    c := 0FFE9h
    c := 0FFE9h
  eif ch="release left alt"
    c := -0FFE9h
  eif false # ch="press right alt"
  eif false # ch="right alt"
    c := 0FFEAh
    c := 0FFEAh
  eif false # ch="release right alt"
    c := -0FFEAh
  eif (ch parse word:"shift" any:(var Str remain)) or (ch pa
  eif (ch parse word:"shift" any:(var Str remain)) or (ch pa
    c := kbd_map remain
    c := kbd_map0 remain
  else
    c := undefined

  else
    c := undefined

function kbd_map ch -> c
  arg Str ch ; arg Int c
  if (ch parse word:"press" any:(var Str k))
    c := undefined
  eif (ch parse word:"release" any:(var Str k))
    c := kbd_map0 k
    if c<>undefined
      c := -c
  else
    c := kbd_map0 ch



function vnc_client server password -> status
  arg Str server password ; arg ExtendedStatus status
  if not (server eparse any:(var Str host) ":" (var Int disp
    host := server ; display := 0
  var Link:Stream s :> new Stream
  s open "tcp://"+host+"/client/"+(string 5900+display) in+o
  var Str handshake := s readline
  if (handshake 0 3)<>"RFB"
    return failure:"Failed to connect to the VNC server"
  s writeline "RFB 003.003" ; s flush anytime
  s raw_read addressof:(var uInt32_hi auth) uInt32:size
  if auth=2
    s raw_read addressof:(var (Array Byte 16) challenge) 16
    vncEncryptBytes addressof:challenge password
    s raw_write addressof:(var (Array Byte 16) challenge) 16
    s raw_read addressof:(var uInt32_hi ack) uInt32:size
    if ack<>0
      return failure:"Password is wrong"
  var uInt8 share := 1 ; s raw_write addressof:share uInt8:s
  s raw_read addressof:(var uInt16_hi size_x) uInt16:size
  s raw_read addressof:(var uInt16_hi size_y) uInt16:size
  s raw_read addressof:(var VncPixelFormat pixel_format) Vnc
  s raw_read addressof:(var uInt32_hi length) uInt32:size
  var Str name := repeat length " "
  s raw_read name:characters name:len
  console "VNC screen " name " is " (cast size_x Int) " x " 
  # console "depth = " (cast pixel_format:depth Int) eol
  # console "red max = " (cast pixel_format:red_max Int) eol
  # console "green max = " (cast pixel_format:green_max Int)
  # console "red shift = " (cast pixel_format:red_shift Int)
  # console "green shift = " (cast pixel_format:green_shift 


  thread # keyboard
    var CBool verbose := false
function vnc_client server password -> status
  arg Str server password ; arg ExtendedStatus status
  if not (server eparse any:(var Str host) ":" (var Int disp
    host := server ; display := 0
  var Link:Stream s :> new Stream
  s open "tcp://"+host+"/client/"+(string 5900+display) in+o
  var Str handshake := s readline
  if (handshake 0 3)<>"RFB"
    return failure:"Failed to connect to the VNC server"
  s writeline "RFB 003.003" ; s flush anytime
  s raw_read addressof:(var uInt32_hi auth) uInt32:size
  if auth=2
    s raw_read addressof:(var (Array Byte 16) challenge) 16
    vncEncryptBytes addressof:challenge password
    s raw_write addressof:(var (Array Byte 16) challenge) 16
    s raw_read addressof:(var uInt32_hi ack) uInt32:size
    if ack<>0
      return failure:"Password is wrong"
  var uInt8 share := 1 ; s raw_write addressof:share uInt8:s
  s raw_read addressof:(var uInt16_hi size_x) uInt16:size
  s raw_read addressof:(var uInt16_hi size_y) uInt16:size
  s raw_read addressof:(var VncPixelFormat pixel_format) Vnc
  s raw_read addressof:(var uInt32_hi length) uInt32:size
  var Str name := repeat length " "
  s raw_read name:characters name:len
  console "VNC screen " name " is " (cast size_x Int) " x " 
  # console "depth = " (cast pixel_format:depth Int) eol
  # console "red max = " (cast pixel_format:red_max Int) eol
  # console "green max = " (cast pixel_format:green_max Int)
  # console "red shift = " (cast pixel_format:red_shift Int)
  # console "green shift = " (cast pixel_format:green_shift 


  thread # keyboard
    var CBool verbose := false
    var CBool pause := false
    while s=success
      var Str ch := keyboard_read
      if (ch parse word:"alt" word:"ctrl" any:(var Str remai
        ch := "ctrl alt "+remain
      if ch="ctrl alt escape"
        s configure "shutdown"
      eif (ch eparse "ctrl alt F" (var Int i)) and i>=1 and 
        os_ioctl 0 os_VT_ACTIVATE (cast i Address)
    while s=success
      var Str ch := keyboard_read
      if (ch parse word:"alt" word:"ctrl" any:(var Str remai
        ch := "ctrl alt "+remain
      if ch="ctrl alt escape"
        s configure "shutdown"
      eif (ch eparse "ctrl alt F" (var Int i)) and i>=1 and 
        os_ioctl 0 os_VT_ACTIVATE (cast i Address)
        active := false
      eif ch="ctrl alt F11"
        verbose := true
      eif ch="ctrl alt F12"
        verbose := false
      eif ch="ctrl alt F11"
        verbose := true
      eif ch="ctrl alt F12"
        verbose := false
      eif ch="pause"
        pause := not pause
        var Int handle := os_open "/dev/fb0" os_O_RDWR 0
        if handle>=0
          os_ioctl handle os_FBIOBLANK (cast (shunt pause 4 0) Address)
          os_close handle
      if verbose
        console ch eol
      var Int c := kbd_map ch
      if c<>undefined
      if verbose
        console ch eol
      var Int c := kbd_map ch
      if c<>undefined
        if verbose
          console " -> " c eol
        sem request
        var uInt8 message := 4 ; s raw_write addressof:messa
        var uInt8 down_flags := shunt c>=0 1 0 ; s raw_write
        for (var Int i) 1 2
          var uInt8 padding := 0 ; s raw_write addressof:pad
        var uInt32_hi key := abs c  ; s raw_write addressof:
        if active
          var uInt8 message := 3 ; s raw_write addressof:mes
          var uInt8 incremental := 1 ; s raw_write addressof
          var uInt16_hi x_position := 0 ; s raw_write addres
          var uInt16_hi y_position := 0 ; s raw_write addres
          var uInt16_hi width := size_x ; s raw_write addres
          var uInt16_hi height := size_y ; s raw_write addre
        s flush anytime
        sem release

  thread # mouse
    while s=success
        sem request
        var uInt8 message := 4 ; s raw_write addressof:messa
        var uInt8 down_flags := shunt c>=0 1 0 ; s raw_write
        for (var Int i) 1 2
          var uInt8 padding := 0 ; s raw_write addressof:pad
        var uInt32_hi key := abs c  ; s raw_write addressof:
        if active
          var uInt8 message := 3 ; s raw_write addressof:mes
          var uInt8 incremental := 1 ; s raw_write addressof
          var uInt16_hi x_position := 0 ; s raw_write addres
          var uInt16_hi y_position := 0 ; s raw_write addres
          var uInt16_hi width := size_x ; s raw_write addres
          var uInt16_hi height := size_y ; s raw_write addre
        s flush anytime
        sem release

  thread # mouse
    while s=success
      mouse_read (var Int x) (var Int y) (var Int buttons)
      var Str ch := mouse_read (var Int x) (var Int y) (var Int buttons)
      sem request
      sem request
      if ch<>"" and { var Int c := kbd_map ch ; c<>undefined }
        var uInt8 message := 4 ; s raw_write addressof:message 1
        var uInt8 down_flags := shunt c>=0 1 0 ; s raw_write addressof:down_flags 1
        for (var Int i) 1 2
          var uInt8 padding := 0 ; s raw_write addressof:padding 1
        var uInt32_hi key := abs c  ; s raw_write addressof:key uInt32_hi:size
      var uInt8 message := 5 ; s raw_write addressof:message
      var Int buttons8 := (buttons .and. 1)+(buttons .and. 2
      var uInt16_hi mouse_x16 := x ; s raw_write addressof:m
      var uInt16_hi mouse_y16 := y ; s raw_write addressof:m
      if active
        var uInt8 message := 3 ; s raw_write addressof:messa
        var uInt8 incremental := 1 ; s raw_write addressof:i
        var uInt16_hi x_position := 0 ; s raw_write addresso
        var uInt16_hi y_position := 0 ; s raw_write addresso
        var uInt16_hi width := size_x ; s raw_write addresso
        var uInt16_hi height := size_y ; s raw_write address
      s flush anytime
      sem release


export vnc_client
      var uInt8 message := 5 ; s raw_write addressof:message
      var Int buttons8 := (buttons .and. 1)+(buttons .and. 2
      var uInt16_hi mouse_x16 := x ; s raw_write addressof:m
      var uInt16_hi mouse_y16 := y ; s raw_write addressof:m
      if active
        var uInt8 message := 3 ; s raw_write addressof:messa
        var uInt8 incremental := 1 ; s raw_write addressof:i
        var uInt16_hi x_position := 0 ; s raw_write addresso
        var uInt16_hi y_position := 0 ; s raw_write addresso
        var uInt16_hi width := size_x ; s raw_write addresso
        var uInt16_hi height := size_y ; s raw_write address
      s flush anytime
      sem release


export vnc_client