next up previous
Next: A.20 vc-image.setl Up: A. WEBeye Source Code Previous: A.18 vc-go.setl

  
A.19 vc-httpd.setl

Service provided:
httpd

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])
webutil.setl     (Section A.44 [webutil.setl])

Source code: *

const yhwh = `vc-httpd.setl';
 
-- This program thinks it is a little Web server.  It ``instantiates''
-- the local file vc-template.html by substituting parameters (some
-- of which typically come from imagemap mouse clicks via a URL) for
-- keywords, and presents the result as HTTP-wrapped HTML.  The latter
-- in turn contains a reference to the server-push JPEG image producer
-- (the push service) and a self-reference that browsers usually
-- decorate with pixel locations when the imagemap is clicked.
--
-- It also sends camera control commands to the do service based on
-- those click parameters and the current state.
 
const want_nonsense = false;  -- true if you have no Canon hardware
 
const width = 320;
const height = 240;
--- These constants should go into a file, say vc-limits.setl, which
--- is #included by everything that uses them:
const panlo = -90;
const panhi = 90;
const tiltlo = -30;
const tilthi = 25;
const min_zoom = 1;
const max_zoom = 10;
 
const pi = 2 * asin 1;
const fmin = -1;
const fmax = 1;
const gmin = -1;
const gmax = 1;
const nsamp = 12;  -- how many segments in the ``circle''
 
-- This flag determines how the camera is controlled during
-- client inactivity:
const method = `move';  -- `move' or `speed'
 
const want_iato = false;  -- want inactivity timeout or not
const tick = if method = `movethen 5000 else 3000 end if;  -- ms
const inactivity_timeout = round (60 * 1000 / tick);  -- 60 sec
 
const do_fd = fileno if want_nonsense then
  open (getfile `nonsense.tcp', `socket')
else
  obtain_service (`do')
end if;
 
const timer_fd = if want_iato then
  open (str tick, `real-ms')
else
  om
end if;
 
const sigterm_fd = open (`SIGTERM', `signal');  -- catch TERM signals
 
const httpd_fd = fileno provide_service (`httpd');
 
var clients := {};
 
cycling := want_iato;
ticker := 0;
r := 1;  -- starting ``radius''
 
do_ramp (500);
zoom := do_get (`zoom_factor');
 
loop
 
  [ready] := select ([{sigterm_fdhttpd_fdtimer_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
    geta (pump_fdaction);
    if action = `clickedthen
      if cycling then
        if method = `speedthen
          do_move_stop;
        end if;
        cycling := false;
      end if;
      reada (pump_fdzoom_scalepantilt);
      if zoom_scale <= 1 then
        do_zoom_by (zoom_scale);
        do_move_by (pantilt);
      else
        do_move_by (pantilt);
        do_zoom_by (zoom_scale);
      end if;
    end if;
    if action = `newthen
      if want_iato then
        zoom := 1 + random 2.0;
        do_zoom_to (zoom);
        if method = `speedthen
          do_move_start;
        end if;
        cycling := true;
      end if;
    end if;
    if action = `initialthen
      if cycling then
        if method = `speedthen
          do_move_stop;
        end if;
        cycling := false;
      end if;
      reada (pump_fdold_zoomzoompantilt);
      if zoom <= old_zoom then  -- like zoom_scale <= 1 above
        do_zoom_to (zoom);
        do_move_to (pantilt);
      else
        do_move_to (pantilt);
        do_zoom_to (zoom);
      end if;
    end if;
    done_client (pump_fd);
  end loop;
 
  if httpd_fd in ready then  -- new client
    fd := accept (httpd_fd);
    if fd /= om then
      name := getname fd;
      msg (name+` accepted');
      [old_panold_tilt] := do_get (`position');
      --- confusing use of variable names (zoom, but old_pan etc.):
      zoom := do_get (`zoom_factor');
      pump_fd := pump();
      if pump_fd = -1 then
        -- child (pumping co-process);
        [uriprotocolmime_headers] := get_request (fd);
        mu := massage_uri uri ? {};
        protocol ?:= `';
        mu.cmd ?:= `JPEG';
        if mu.click = om then
          mu.top_blurb := `Try clicking in this image!\n'+
                          `<p>\n\n'+
                          `PWM_EQUIV\n'+
                          `<p>';
          -- Let explicit initial pan, tilt, and zoom specifications
          -- from the URL override the ``old'' settings that would
          -- otherwise be initially used:
          old_zoom := zoom;  --- is ``old'' (see ``confusing'' above)
          zoom := mu.zoom ? old_zoom;
          pan := mu.pan ? old_pan;
          tilt := mu.tilt ? old_tilt;
          mu.pwm := `Initial pan = '+fixed(pan,0,1)+` deg, '+
                           `tilt = '+fixed(tilt,0,1)+` deg\n<p>'+
                    `Initial zoom factor = '+fixed(zoom,0,2)+`\n<p>';
          if mu.zoom ? mu.pan ? mu.tilt = om then
            print (`new');
          else
            print (`initial');
            print (old_zoomzoompantilt);
          end if;
        else
          --- N.B. For the Canon, I will abuse PWM_EQUIV just to
          --- quote pan and tilt in degrees.
          mu.top_blurb := `Clicked at:  '+str mu.click+`\n'+
                          `<p>\n\n'+
                          `PWM_EQUIV\n'+
                          `<p>';
          [x,y] := mu.click;
          pan_norm := (x - width/2) / (width/2);
          tilt_norm := (height/2 - y) / (height/2);
          dist_norm := sqrt (pan_norm**2 + tilt_norm**2);
          zoom_scale := 1.618 ** (2 - 4*dist_norm);
          pan := pan_norm * 40 / zoom;
          tilt := tilt_norm * 30 / zoom;
          -- This string replaces PWM_EQUIV in the HTML template:
          req_pan := old_pan + pan;
          req_tilt := old_tilt + tilt;
          req_zoom := zoom * zoom_scale;
          pan_tilt_clamp_blurb :=
            if req_pan < -90 or req_pan > 90 or
               req_tilt < -30 or req_tilt > 25 then
              `<br>clamped to ['+fixed(req_pan max -90 min 90,0,1)+` '+
                                fixed(req_tilt max -30 min 25,0,1)+`]\n'
            else `'
            end if;
          zoom_clamp_blurb :=
            if req_zoom < min_zoom or req_zoom > max_zoom then
              `<br>clamped to '+fixed(req_zoom
                                  max min_zoom
                                  min max_zoom,0,2)+`\n'
            else `'
            end if;
          mu.pwm := `Requested pan = '+fixed(req_pan,0,1)+` deg, '+
                      `tilt = '+fixed(req_tilt,0,1)+` deg\n'+
                    `<br>(delta pan = '+fixed(pan,0,1)+` deg, '+
                      `tilt = '+fixed(tilt,0,1)+` deg)\n'+
                    pan_tilt_clamp_blurb+`<p>'+
                    `Requested zoom factor = '+
                       fixed(req_zoom,0,2)+`\n'+
                    `<br>('+fixed(zoom,0,2)+` scaled by '+
                       fixed(zoom_scale,0,3)+`)\n'+
                    zoom_clamp_blurb+`<p>';
          print (`clicked');
          print (zoom_scalepantilt);
        end if;
        html := instantiate (getfile `vc-template.html', mu);
        spew_html (fdhtmlprotocol);
        stop;
      end if;
      -- parent continues here
      close (fd);  -- child deals with this client fd
      client := {};
      client.pump_fd := pump_fd;
      client.name := name;
      clients(pump_fd) := client;
    end if;
  end if;
 
  if timer_fd /= om and timer_fd in ready then
    ticker +:= 1;
    geta (timer_fddummy);
    if cycling then
      -- Clock the camera through some pattern during client inactivity
      -- (note that this cycling only happens if want_iato = true)
      if ticker mod nsamp = 0 then
        r := 0.2 + random 0.8;
        zoom := 1 + random 4.0;
        do_zoom_to (zoom);
      end if;
      x := (ticker mod nsamp) / nsamp;  -- a real in [0..1)
      y := (pan_cycle (x) - fmin) / (fmax - fmin);  -- also normalized
      z := y * (panhi - panlo) + panlo;  -- scaled to output range
      pan := r * z;
      y := (tilt_cycle (x) - gmin) / (gmax - gmin);  -- also normalized
      z := y * (tilthi - tiltlo) + tiltlo;  -- scaled to output range
      tilt := r * z;
      if method = `movethen
        s := max_zoom/zoom;
        t := 4/zoom;
        do_move_to (pan + (random s - s/2),
                   tilt + (random t - t/2));
      elseif method = `speedthen
        do_move_speed (pan/10 + (random 4.0 - 2.0),
                      tilt/10 + (random 1.2 - 0.6));
      end if;
    elseif want_iato and ticker = inactivity_timeout then
      ticker := random nsamp;
      zoom := 1 + random 2.0;
      do_zoom_to (zoom);
      if method = `speedthen
        do_move_start;
      end if;
      cycling := true;
    end if;
  end if;
 
end loop;
 
proc spew_html (fdhtmlprotocol);
  if (to_upper protocol)(`^HTTP') /= om then
    printa (fd, `HTTP/1.0 200 OK');
    printa (fd, `Server: WEBeye');
    printa (fd, `Expires: 0');
    printa (fd, `Pragma: no-cache');
    printa (fd, `Content-type: text/html');
    printa (fd, `Content-length: '+str #html);
    printa (fd);
  end if;
  putc (fdhtml);
  flush (fd);
end proc spew_html;
 
proc instantiate (templatemu);
  gsub (template, `DATE', fdate(tod));
  gsub (template, `TOP_BLURB', mu.top_blurb);
  gsub (template, `PWM_EQUIV', mu.pwm);  -- must go after TOP_BLURB sub.
  gsub (template, `WEB_HOME', hostaddr);
  -- Look ourselves up, even though port httpd_fd should be the same
  -- as the looked-up httpd port, for consistency with the others (and
  -- as a sort of silly doublecheck):
  gsub (template, `HTTPD_HOME', public_service (`httpd'));
  gsub (template, `VIDEO_HOME', public_service (`push'));
  gsub (template, `CAMERA_TCP', public_service (`camera'));
  gsub (template, `/MAX_RATE', if mu.rate = om then `' else
                                     `/rate='+str mu.rate end);
  return template;
end proc instantiate;
 
-- Look up a service name and present it as host:port for the public:
proc public_service (name);
  [serv_nameserv_port] := find_service (name);
  if serv_name = `localhostthen
    serv_name := hostaddr;
  end if;
  return serv_name+`:'+str serv_port;
end proc;
 
proc pan_cycle (x);
  return sin (2*pi*x);
end;
 
proc tilt_cycle (x);
  return cos (2*pi*x);
end;
 
proc new_cmd (name);
  cmd := {};
  cmd.name := name;
  return cmd;
end proc;
 
proc do_cmd (cmd);
  writea (do_fdcmd);
  geta (do_fdresponse_line);
  return response_line;
end proc;
 
proc do_ramp (ms);
  cmd := new_cmd (`Ramp');
  cmd.ms := ms;
  do_cmd (cmd);
end proc;
 
proc do_move_to (pantilt);
  do_move (`To', pantilt);
end proc;
 
proc do_move_by (pantilt);
  do_move (`By', pantilt);
end proc;
 
proc do_move (tobypantilt);
  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_speedtilt_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;
 
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.namepump_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''
#include ``webutil.setl''


next up previous
Next: A.20 vc-image.setl Up: A. WEBeye Source Code Previous: A.18 vc-go.setl
David Bacon
1999-12-10