Patch title: Release 96 bulk changes
Abstract:
File: /pliant/graphic/ui/client/main.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/graphic/color/gamut.pli"
module "/pliant/graphic/console/prototype.pli"
module "/pliant/graphic/layout/prototype.pli"
module "/pliant/graphic/layout/hook.pli"
module "/pliant/graphic/layout/sequence.pli"
module "/pliant/graphic/layout/helper/event.pli"
module "context.pli"
module "connect.pli"
module "instructions.pli"
module "window.pli"

constant scroll_invert true
constant wheel_divisor 16


function ui_client options -> status
  arg Str options ; arg ExtendedStatus status

  var Link:UIConsole c :> new UIConsole
  c:sem request
  var Int dpi := options option "dpi" Int 100
  var Float scale := options option "scale" Float 1
  c unit_x := 25.4/dpi/scale ; c unit_y := 25.4/dpi/scale
  var Int aa := options option "antialiasing" Int 1
  for (var Int i) 0 c:session:size-1
    c:session:i focus_window :> null map UIWindow
    each w c:session:i:windows
      w antialiasing := aa
      w padding_size := cast 1/c:unit_x Int
  c console :> graphic_console (options option "console" Str "x11")
  if not (exists c:console)
    return (failure "There is no '"+(options option "console" Str "x11")+"' console driver.")
  var Int size_x := cast 480*dpi/75 Int ; var Int size_y := cast 600*dpi/75 Int
  var Link:LayoutStyle st :> new LayoutStyle
  st reset c:unit_x c:unit_y
  c default_style :> st
  var ImagePrototype proto := image_prototype 0 0 size_x*c:unit_x size_y*c:unit_y size_x size_y color_gamut:"rgb"
  status := c:console open proto options+" label [dq]Pliant ui[dq]"
  if status=failure
    return
  proto := c:console query
  c size_x := proto size_x
  c size_y := proto size_y
  c gamut :> proto gamut
  var Str positions := options option "positions" Str

  if ((options (options option_position "login" 0) options:len) parse "login" (var Str user) (var Str password))
    var UILogin login ; login user := user ; login password := password ; login secured := true
    c:login insert "" login

  var Pointer:UISession s0 :> c:session 0
  s0 connect_main (options option "url" Str "/") (var Dictionary empty_context)
  var Pointer:UISession s11 :> c:session 11
  s11 connect_main (options option "windows_manager" Str "/windows_manager") (var Dictionary empty_context)
  s11:connection otag "console" (cast addressof:c Int)
  s11:connection flush anytime
  
  part events_handler "ui events handler"
    var CBool hq := false
    while true
      thread
        sleep 0 # FIXME: don't know why it's required
        c attempt_redraw_now
        c:sem release
      var Str event := c:console event (var Str key) (var Int buttons) (var Int x0) (var Int y0) (var Int x1) (var Int y1) (var Str ev_options)
      # console "event " event " " key " " x0 " " y0 " " buttons " " ev_options eol
      c request_sem
      if event="press" and key="button2"
        c:console lock_pointer true
      eif event="release" and key="button2"
        c:console lock_pointer false
      if event="scroll"
        for (var Int i) 0 11
          var Pointer:UISession s :> c:session i
          each w s:windows
            if w:x0<>undefined and x1>=w:x0 and y1>=w:y0 and x1<w:x1 and y1<w:y1
              if key="wheel"
                w scroll w:scroll_x+x0*(max (w:x1-w:x0)\wheel_divisor 1) w:scroll_y+y0*(max (w:y1-w:y0)\wheel_divisor 1)
              else
                var Int speed_x := max (min (cast (w:bbox:x1-w:bbox:x0)/c:unit_x/c:size_x Int) c:size_x\8) 1
                var Int speed_y := max (min (cast (w:bbox:y1-w:bbox:y0)/c:unit_y/c:size_y Int) c:size_y\8) 1
                if scroll_invert
                  w scroll w:scroll_x-x0*speed_x w:scroll_y-y0*speed_y
                else
                  w scroll w:scroll_x+x0*speed_x w:scroll_y+y0*speed_y
      eif event="redraw"
        c draw x0 y0 x1 y1 true
      eif event="resize"
        c size_x := x0 ; c size_y := y0
        c refresh true
      eif event="press" and (key eparse "shift F" (var Int i)) and i>=1 and i<12 and c:zorder:0<>11
        c raise i-1 true
        c refresh false # FIXME (c:session c:zorder:0) display
      eif event="press" and (key eparse "ctrl F" (var Int i)) and i>=1 and i<=12
        c raise i-1 false
        c refresh false # (c:session c:zorder:0) display
      eif event="press" and (key parse word:"ctrl" any:(var Str k2)) and k2:len=1 and { var Int i := positions search k2 -1 ; i>=0 and i<9 }
        if c:zorder:0<>11
          var Pointer:UISession s :> c:session c:zorder:0 
          s position := i
          c refresh true
      eif event="press" and (key parse word:"ctrl" any:(var Str k2)) and k2:len=1 and { var Int kc := ev_options option "keycode" Int ; kc<>undefined } and { var Int i := shunt kc=24 0 kc=25 1 kc=26 2 kc=38 3 kc=39 4 kc=40 5 kc=52 6 kc=53 7 kc=54 8 -1 ; i<>(-1) } # was { var Int i := "azeqsdwxc" search k2 -1 ; i<>(-1) }
        if c:zorder:0<>11
          var Pointer:UISession s :> c:session c:zorder:0 
          s position := i
          c refresh true
      eif event="press" and (key parse word:"ctrl" any:(var Str k2)) and k2<>"" and (" left up right down " search " "+k2+" " -1)<>(-1)
        var Float step := 0.05
        if k2="left"
          c middle_x := max c:middle_x-step step
        eif k2="up"
          c middle_y := max c:middle_y-step step
        eif k2="right"
          c middle_x := min c:middle_x+step 1-step
        eif k2="down"
          c middle_y := min c:middle_y+step 1-step
        c refresh true
      eif event="press" and key="ctrl pageup" and c:unit_x>0.02
        c unit_x /= 1.1 ; c unit_y /= 1.1
        # console "zoom in " c:unit_x eol
        c refresh true
      eif event="press" and key="ctrl pagedown" and c:unit_x<1
        c unit_x *= 1.1 ; c unit_y *= 1.1
        # console "zoom out " c:unit_x eol
        c refresh true
      eif hq and event="release" and (key="ctrl" or key="button2")
        var List:Int laa := var List:Int empty_list
        for (var Int i) 0 c:session:size-1
          each w c:session:i:windows
            laa += w antialiasing ; w antialiasing := max w:antialiasing 4
        c refresh false
        c last_successfull_redraw:= undefined
        c attempt_redraw_now
        var Pointer:Int paa :> laa first
        for (var Int i) 0 c:session:size-1
          each w c:session:i:windows
            w antialiasing := paa
            paa :> laa next paa
      eif key="button2"
        void
      eif event<>"scroll" # FIXME
        var LayoutEC ec := var LayoutEC empty_event
        ec style :> c default_style
        ec event := event
        ec key := key
        ec buttons := buttons
        ec mode := layout_event_pointer
        ec focus_was := (c:session c:zorder:0) focus_index
        ec cancel := false
        for (var Int i) 0 11
          var Pointer:UISession s :> c:session i
          each w s:windows
            if w:x0<>undefined and x0>=w:x0 and y0>=w:y0 and x0<w:x1 and y0<w:y1
              if event="press" and (key parse "button" any)
                c raise i false
              ec window :> w
              ec x := (x0-w:x0+w:scroll_x+0.5)*c:unit_x
              ec y := (y0-w:y0+w:scroll_y+0.5)*c:unit_y
              if (exists w:overlay)
                w:overlay event ec
              if (exists w:root)
                w:root event ec
        if not ec:cancel and event="press"
          var Pointer:UISession s :> c:session c:zorder:0
          var (Pointer Link:LayoutPrototype) k :>> s:keys first key
          if exists:k # and (addressof:k map Int -2)<>1
            var Pointer:LayoutPrototype r :> k
            while (exists r:parent)
              r :> r parent
            each w s:windows
              if addressof:r=(addressof w:root) or addressof:r=(addressof w:overlay)
                ec mode := layout_event_shortcut
                ec window :> w
                k event ec
        if not ec:cancel
          var Pointer:UISession s :> c:session c:zorder:0
          if (exists s:focus_target)
            var Pointer:UIWindow w :> s focus_window
            ec mode := layout_event_focus
            ec window :> w
            if exists:w and w:x0<>undefined and x0>=w:x0 and x1<w:x1 and y0>=w:y0 and y0<w:y1
              ec x := (x0-w:x0+w:scroll_x+0.5)*c:unit_x
              ec y := (y0-w:y0+w:scroll_y+0.5)*c:unit_y
            var Link:LayoutPrototype p :> s focus_target
            while exists:p
              p event ec
              p :> p parent
        if not ec:cancel and event="move"
          var Pointer:UISession s :> c:session c:zorder:0
          ec window :> s window "main"
          ec set_over (null omap LayoutPrototype)
      hq := event="press" and (key="ctrl" or key="button2")

export ui_client