A.28 vc-mouse.setl

Service provided:
mouse

Client of service:
do    (vc-do.setl, Section A.11 [vc-do.setl])

Called by parent program:
vc-toplev.setl     (Section A.42 [vc-toplev.setl])

Textually #includes:
vc-exit.setl     (Section A.15 [vc-exit.setl])
vc-getname.setl     (Section A.16 [vc-getname.setl])
vc-msg.setl     (Section A.30 [vc-msg.setl])
vc-obtain.setl     (Section A.31 [vc-obtain.setl])
vc-provide.setl     (Section A.32 [vc-provide.setl])

Source code: *

const yhwh = `vc-mouse.setl';
 
-- This strange little service is for Java clients that take an
-- unusual view of mouse gestures by doing some local timing and
-- interpretation that result in mouse ``events'' we agree to call
-- `click', `linger', `jump', `zoom', and `stop'.  These are mapped
-- here to combinations of moving, ``jumping'' (which is just moving
-- without the usual sigmoid speed ramping of the motion trajectory),
-- and zooming (see vc-do.setl).
 
const width = 320;
const height = 240;
const panlo = -90;
const panhi = 90;
const tiltlo = -30;
const tilthi = 25;
 
const sigterm_fd = open (`SIGTERM', `signal');  -- catch TERM signals
const server_fd = fileno provide_service (`mouse');
 
var clients := {};
var do_fd := om;
 
loop
 
  [ready] := select ([{sigterm_fd, server_fd} + domain clients]);
 
  if sigterm_fd in ready then
    msg (yhwh + ` (' + str pid + `) caught SIGTERM');
    quit_gracefully;
  end if;
 
  for client = clients(pump_fd) | pump_fd in ready loop
    done_client (pump_fd);
  end loop;
 
  if server_fd in ready then
    fd := accept (server_fd);
    if fd  om then
      name := getname fd;
      msg (name+` accepted');
      pump_fd := pump();
      if pump_fd = -1 then
        -- child
        do_fd := fileno obtain_service (`do');
        loop
          if (line := getline fd)  om and
             #(t := split (line))  1 then
            case
            when t(1) = `click'
                 and #t = 3
                 and is_num t(2)
                 and is_num t(3)  
              x := val t(2);
              y := val t(3);
              pan_norm := (x - width/2) / (width/2);
              tilt_norm := (height/2 - y) / (height/2);
              zoom := do_get (`zoom_factor');
              dist_norm := sqrt (pan_norm**2 + tilt_norm**2);
              zoom_scale := 1.618 ** (2 - 4*dist_norm);
              dpan := pan_norm * 40 / zoom;
              dtilt := tilt_norm * 30 / zoom; 
              if zoom_scale  1 then
                do_zoom_by (zoom_scale);
                do_move_by (dpan, dtilt);
              else
                do_move_by (dpan, dtilt);
                do_zoom_by (zoom_scale);
              end if;
              printa (fd);  -- reply with empty line
            when t(1) = `linger'
                 and #t = 3
                 and is_num t(2)
                 and is_num t(3)  
              x := val t(2);
              y := val t(3);
              pan_norm := (x - width/2) / (width/2);
              tilt_norm := (height/2 - y) / (height/2);
              zoom := do_get (`zoom_factor');
              pan_rate  := sign pan_norm  * pan_norm**2 * 60 / zoom;
              tilt_rate := sign tilt_norm * tilt_norm**2 * 60 / zoom;
              do_move_speed (pan_rate, tilt_rate);
              do_move_start;
              printa (fd);  -- reply with empty line
            when t(1) = `jump'
                 and #t = 3
                 and is_num t(2)
                 and is_num t(3)  
              -- this command uses the ``natural'' units
              pan := val t(2);
              tilt := val t(3);
              do_jump_to (pan, tilt);
              printa (fd);  -- reply with empty line
            when t(1) = `zoom'
                 and #t = 2
                 and is_num t(2)  
              zoom := val t(2);
              do_zoom_to (zoom max 1 min 10);
              printa (fd);  -- reply with empty line
            when t(1) = `stop'
                 and #t = 1  
              do_move_stop;
              printa (fd);  -- reply with empty line
            otherwise  
              stop;
            end case;
          else
            stop;
          end if;
        end loop;
        assert false;
      end if;
      -- parent continues here
      close (fd);
      client := {};
      client.name := name;
      clients(pump_fd) := client;
    end if;
  end if;
 
end loop;
 
proc new_cmd (name);
  cmd := {};
  cmd.name := name;
  return cmd;
end proc;
 
proc do_cmd (cmd);
  writea (do_fd, cmd);
  geta (do_fd, response_line);
  return response_line;  --- currently with no check
end proc;
 
proc do_jump_to (pan, tilt);
  do_jump (`To', pan, tilt);
end proc;
 
proc do_jump_by(pan, tilt);
  do_jump (`By', pan, tilt);
end proc;
 
proc do_jump (toby, pan, tilt);
  cmd := new_cmd (`Jump');
  cmd.subcmd := toby;
  cmd.pan := pan;
  cmd.tilt := tilt;
  do_cmd (cmd);
end proc;
 
proc do_move_to (pan, tilt);
  do_move (`To', pan, tilt);
end proc;
 
proc do_move_by (pan, tilt);
  do_move (`By', pan, tilt);
end proc;
 
proc do_move (toby, pan, tilt);
  cmd := new_cmd (`Move');
  cmd.subcmd := toby;
  cmd.pan := pan;
  cmd.tilt := tilt;
  do_cmd (cmd);
end proc;
 
proc do_move_start;
  cmd := new_cmd (`Move');
  cmd.subcmd := `Start';
  do_cmd (cmd);
end proc;
 
proc do_move_stop;
  cmd := new_cmd (`Move');
  cmd.subcmd := `Stop';
  do_cmd (cmd);
end proc;
 
proc do_move_speed (pan_speed, tilt_speed);
  cmd := new_cmd (`Move');
  cmd.subcmd := `Speed';
  cmd.pan_speed := pan_speed;
  cmd.tilt_speed := tilt_speed;
  do_cmd (cmd);
end proc;
 
proc do_zoom_to (factor);
  cmd := new_cmd (`Zoom');
  cmd.subcmd := `To';
  cmd.zoom_factor := factor;
  do_cmd (cmd);
end proc;
 
proc do_zoom_by (scale);
  cmd := new_cmd (`Zoom');
  cmd.subcmd := `By';
  cmd.zoom_scale := scale;
  do_cmd (cmd);
end proc;
 
proc do_get (what);
  cmd := new_cmd (`Get');
  cmd.what := what;
  return unstr do_cmd (cmd);
end proc;
 
op is_num (a);
  return a(`^[+-]?[0-9]+(\\.[0-9]+)?$')  om;
end op;
 
proc done_client (pump_fd);
  msg (clients(pump_fd).name + ` done');
  close (pump_fd);
  clients(pump_fd) := om;
end proc done_client;
 
proc quit_gracefully;
  exit_gracefully ([[`pump for client ' + client.name, pump_fd] :
                                          client = clients(pump_fd)]);
end proc;
 
#include ``vc-provide.setl''
#include ``vc-obtain.setl''
#include ``vc-getname.setl''
#include ``vc-exit.setl''
#include ``vc-msg.setl''