Patch title: Release 93 bulk changes
Abstract:
File: /graphic/console/x11.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/graphic/color/gamut.pli"
module "prototype.pli"
module "x11_api.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 ground_color (rgb_color 255 255 255)
constant trace false


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"


type ConsoleX11
  field XWindow window
  field Int size_x size_y

ConsolePrototype maybe ConsoleX11


method c open p options
  oarg_rw ConsoleX11 c ; arg ImagePrototype p ; arg Str options
  var XSetWindowAttributes a
  a background_pixel := x11_ground pixel
  a override_redirect := false # true
  a event_mask := PointerMotionMask+ButtonPressMask+ButtonReleaseMask+KeyPressMask+KeyReleaseMask+ExposureMask+StructureNotifyMask
  var uInt mask := CWBackPixel+CWBorderPixel+CWOverrideRedirect+CWEventMask
  c size_x := p size_x ; c size_y := p size_y
  c window := XCreateWindow display screen:root 0 0 c:size_x c:size_y 0 screen:root_depth InputOutput screen:root_visual mask a
  XStoreName display c:window "Pliant browser"
  XMapWindow display c:window


method c query -> p
  oarg_rw ConsoleX11 c ; arg ImagePrototype p
  p := image_prototype 0 0 c:size_x/75*25.4 c:size_y/75*25.4 c:size_x c:size_y color_gamut:x11_gamut_name


method c paint img tx ty
  oarg_rw ConsoleX11 c ; oarg_rw ImagePrototype img ; arg Int tx ty
  var Address linebuf := memory_allocate img:line_size null
  var XGC gc := XCreateGC display c:window 0 (var XGCValues gcvalues) 
  var XImage ximg
  ximg width := img size_x
  ximg height := 1
  ximg xoffset := 0
  ximg format := ZPixmap
  ximg byte_order := display byte_order
  check display:bitmap_unit=img:pixel_size*8
  ximg bitmap_unit := display bitmap_unit
  ximg bitmap_bit_order := display bitmap_bit_order
  ximg bitmap_pad := display bitmap_pad
  ximg depth := screen root_depth
  ximg bytes_per_line := img line_size
  ximg bits_per_pixel := img:pixel_size*8
  ximg red_mask := visual red_mask
  ximg green_mask := visual green_mask
  ximg blue_mask := visual blue_mask
  ximg data := linebuf
  if not (XInitImage ximg)
    error "Failed to setup X11 image"
  for (var Int iy) 0 img:size_y-1
    img read 0 iy img:size_x linebuf
    if (XPutImage display c:window gc ximg 0 0 tx ty+iy img:size_x 1)<>0
      error "Failed to draw X11 image"
  XFreeGC display gc
  memory_free linebuf


method c copy x0 y0 x1 y1 xx yy
  oarg_rw ConsoleX11 c ; arg Int x0 y0 x1 y1 xx yy
  var XGC gc := XCreateGC display c:window 0 (var XGCValues gcvalues)
  XCopyArea display c:window c:window gc x0 y0 x1-x0 y1-y0 xx yy
  XFreeGC display gc


function x11_keyboard_mapping id -> key
  arg Int id ; arg Str key
  if id<256
    key := string id
  eif id=XK_Return
    key := "enter"
  eif id=XK_BackSpace
    key := "backspace"
  eif id=XK_Tab
    key := "tab"
  eif id=XK_Escape
    key := "escape"
  eif id=XK_Left
    key := "left"
  eif id=XK_Up
    key := "up"
  eif id=XK_Right
    key := "right"
  eif id=XK_Down
    key := "down"
  eif id=XK_Page_Up
    key := "pageup"
  eif id=XK_Page_Down
    key := "pagedown"
  eif id=XK_Home
    key := "home"
  eif id=XK_End
    key := "end"
  eif id=XK_Insert
    key := "insert"
  eif id=XK_Delete
    key := "delete"
  eif id>=XK_F1 and id<=XK_F12
    key := "F"+(string id-XK_F0)
  else
    key := ""

method c event key buttons x_or_x0 y_or_y0 x1 y1 -> event
  oarg_rw ConsoleX11 c ; arg_w Str key ; arg_w Int buttons x_or_x0 y_or_y0 x1 y1 ; arg Str event
  key := "" ; buttons := undefined ; x_or_x0 := undefined ; y_or_y0 := undefined ; x1 := undefined ; y1 := undefined ; event := ""
  XNextEvent display (var XEvent ev)
  if ev:type=Expose or ev:type=GraphicsExpose
    var Pointer:XExposeEvent expose :> addressof:ev map XExposeEvent
    if trace
      console "redraw " expose:x " " expose:y " " expose:x+expose:width " " expose:y+expose:height " (" expose:count ")" eol
    x_or_x0 := expose x ; y_or_y0 := expose y ; x1 := expose:x+expose:width ; y1 := expose:y+expose:height
    event := "redraw"
    while (XCheckMaskEvent display ExposureMask ev)
      x_or_x0 := min x_or_x0 expose:x
      y_or_y0 := min y_or_y0 expose:y
      x1 := max expose:x+expose:width x1
      y1 := max expose:y+expose:height y1
  eif ev:type=NoExpose
    if trace
      console "noexpose" eol
  eif ev:type=KeyPress or ev:type=KeyRelease
    var Pointer:XKeyEvent k :> addressof:ev map XKeyEvent
    if trace
      console "key " k:keycode " state " k:state
    x_or_x0 := k x ; y_or_y0 := k y
    buttons := k:state\256%7
    key := "                     "
    memory_clear addressof:(var XComposeStatus cstatus) XComposeStatus:size
    XLookupString k key:characters key:len (var XKeySym keysym) cstatus
    key := x11_keyboard_mapping keysym:id
    event := shunt ev:type=KeyPress "press" "release"
  eif ev:type=ButtonPress or ev:type=ButtonRelease
    var Pointer:XButtonEvent button :> addressof:ev map XButtonEvent
    if trace
      console "button " button:button " state " button:state " position " button:x " " button:y eol
    x_or_x0 := button x ; y_or_y0 := button y
    buttons := button:state\256%7
    if button:button>=1 and button:button<=3
      key := "button"+(string button:button)
      event := shunt ev:type=ButtonPress "press" "release"
  eif ev:type=MotionNotify
    while (XCheckMaskEvent display ButtonMotionMask ev)
      void
    var Pointer:XMotionEvent motion :> addressof:ev map XMotionEvent
    event := "move"
    x_or_x0 := motion x ; y_or_y0 := motion y
    buttons := motion:state\256%7
  eif ev:type=ConfigureNotify
    var Pointer:XConfigureEvent configure :> addressof:ev map XConfigureEvent
    x_or_x0 := configure width ; y_or_y0 := configure height
    event := "resize"
  eif trace
    console "unknown event " ev:type eol


method c close
  oarg_rw ConsoleX11 c
  XDestroyWindow display c:window


graphic_console_record "x11" ConsoleX11