Panning Camera Control

#!/usr/bin/perl -w # Copyright © 2004 Jamie Zawinski # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. # Control page for the Panasonic WV-NS324 servo-mounted video camera. # # This camera has a built-in web server, with controls that let you manually # zoom, save positions as presets, etc. Those web pages have some problems, # however. They've overly complicated (many commands are spread out across # multiple pages), but most importantly, the "joystick" control on the web # pages (by which you actually move the camera) doesn't work in Mozilla or # Safari (it was coded for MSIE and Netscape 4.x only.) # # So, I wrote my own UI for camera control, that works by posting to the # underlying "control" URLs on the camera, bypassing the on-camera user # interface. This is it. Works pretty good. # # Created: 7-Mar-2004. require 5; use diagnostics; use strict; $ENV{PATH} .= ":/opt/local/bin"; # for wget via DarwinPorts my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.11 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $verbose = 0; my $base_url = "http://cam.dnalounge.net/"; my $uid_base_url = $base_url; my $image_width = 320; my $image_height = 240; my $frameset_html = ' Panning Camera Control '; my $cheat_sheet_html = '

01: stage very wide
02: stage center close
03: stage left close
04: stage right close

05: dance floor wide
06: gogo platform north
07: gogo platform south
08: straight down

09: balcony bar
10: dj booth
11: corner booth north
12: corner booth south

13: coat check balcony
14: north kiosks
15: ...
16: ...

'; sub get_url { my ($url, $user, $pass) = @_; my $cmd = "wget -t1 -T5 -qO- '$url'"; $cmd .= " --http-user='$user' --http-passwd='$pass'" if ($user); print STDERR "$progname: loading $url\n" if ($verbose > 2); # print STDERR "$progname: cmd $cmd\n" if ($verbose > 2); open (IN, "$cmd |") || error ("couldn't load $url"); my $body = ''; while () { $body .= $_; } close (IN); return $body; } sub find_uid { my $url = $uid_base_url . "cgi-bin/getuid?FILE=indexnw.html"; local *IN; $_ = get_url ($url); m@/cgi-bin/[^\s\"<>\']+?[?&]UID=(\d+)\&@ || error ("couldn't find a UID in $url"); my $uid = $1; print STDERR "$progname: found UID $uid\n" if ($verbose > 2); return $uid; } sub this_url { my $url = "http://" . $ENV{SERVER_NAME}; $url .= ":" . $ENV{SERVER_PORT} unless ($ENV{SERVER_PORT} eq '80'); $url .= $ENV{REQUEST_URI}; return $url; } sub write_redirect { my ($url) = @_; print STDOUT "Location: $url\r\n"; print STDOUT "Content-Type: text/plain\r\n\r\n$url\r\n"; } sub write_html_and_headers { my ($body) = @_; my $L = length ($body); print STDOUT "Content-Type: text/html\r\n"; print STDOUT "Content-Length: $L\r\n"; print STDOUT "\r\n"; print STDOUT $body; } sub write_control_html { my ($uid) = @_; my $body = ''; $body .= ' Panning Camera Control

rotate
'; my @values = (-12, -8, -1, 0, 1, 8, 12); for (my $y = 0; $y <= $#values; $y++) { $body .= " \n"; for (my $x = 0; $x <= $#values; $x++) { my $xx = $values[$x]; my $yy = $values[$y]; if ($xx == 0 && $yy == 0) { $body .= " \n"; } else { my $url = ($base_url . "cgi-bin/directctrl" . "?PAN=" . $xx . "&TILT=" . $yy); $body .= " \n"; } } $body .= " \n"; } $body .= '
##
zoom
'; @values = (-4, -3, -2, 0, 2, 3, 4); for (my $x = 0; $x <= $#values; $x++) { my $xx = $values[$x]; if ($xx == 0) { $body .= " \n"; } else { my $url = ($base_url . "cgi-bin/directctrl" . "?ZOOM=" . $xx); my $t = ($xx < 0 ? '<<' : '>>'); $body .= " \n"; } } $body .= '

$t

move to
preset
'; for (my $y = 0; $y < 4; $y++) { $body .= " \n"; for (my $x = 0; $x < 4; $x++) { my $i = ($y * 4) + $x + 1; my $url = ($base_url . "cgi-bin/camctrl?PRESET=" . $i); $body .= " \n"; } $body .= " \n"; } $body .= '
$i
save as
preset
'; for (my $y = 0; $y < 4; $y++) { $body .= " \n"; for (my $x = 0; $x < 4; $x++) { my $i = ($y * 4) + $x + 1; my $url = ($base_url . "cgi-bin/camposiset" . "?UID=" . $uid . "&PRESETSET=" . $i); $body .= " \n"; } $body .= " \n"; } $body .= '
$i

focus
'; { my $url = $base_url . "cgi-bin/directctrl?FOCUS="; $body .= " \n"; $body .= " \n"; $body .= " \n"; } $body .= '

<< >>

autofocus
'; { my $url = $base_url . "cgi-bin/camctrl?AF="; $body .= " \n"; $body .= " \n"; $body .= " \n"; } $body .= '

on off

brightness '; { my $url = $base_url . "cgi-bin/camctrl?IRIS="; $body .= " \n"; $body .= " \n"; $body .= " \n"; $body .= " \n"; $body .= " \n"; } $body .= '

dark light reset

pan '; { my $url = $base_url . "cgi-bin/camctrl?ATPAN="; $body .= " \n"; $body .= " \n"; $body .= " \n"; } $body .= '

start stop

save pan points '; { my $url = $base_url . "cgi-bin/camposiset?"; $body .= " \n"; $body .= " \n"; $body .= " \n"; $body .= " \n"; $body .= " \n"; } $body .= '

one two reverse

Toggle Self-Clean '; { my $url = this_url(); $url =~ s/\?.*$//; $body .= "Reload\n"; } $body .= '

'; write_html_and_headers ($body); } sub write_image_html { my ($uid) = @_; my $body = ''; $body .= ' Camera Image '; my $url = $base_url . "cgi-bin/cameraid?UID=$uid"; $body .= "

\n"; $body .= " \n"; $body .= " \n"; $body .= "
\n"; $body .= " />/g; s/\"/"/g; return $_; } sub error { my ($err) = @_; if (defined($ENV{REQUEST_URI})) { print STDOUT "Content-Type: text/html\n\n"; print STDOUT "Error\n"; print STDOUT "\n"; print STDOUT "
\n"; print STDOUT "
\n"; print STDOUT "
Error: "; print STDOUT html_quote ($err); print STDOUT "\n
\n"; print STDOUT "
\n"; exit (0); } else { print STDERR "$progname: $err\n"; exit 1; } } sub usage { print STDERR "usage: $progname [--verbose]\n"; exit 1; } sub main { $|=1; my $uid = undef; my $page = undef; # Only parse argv if we're not running as a CGI. # if (!defined ($ENV{REQUEST_URI})) { while ($_ = $ARGV[0]) { shift @ARGV; if ($_ eq "--verbose") { $verbose++; } elsif ($_ eq "--uid") { $uid = shift (@ARGV); } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^-./) { usage; } else { usage; } } } if (defined($ENV{PATH_INFO}) && $ENV{PATH_INFO} ne "") { error ("extraneous crap in URL: $ENV{PATH_INFO}"); } my $args = ""; if (defined($ENV{REQUEST_METHOD}) && $ENV{REQUEST_METHOD} eq "POST") { while () { $args .= $_; } } elsif (defined($ENV{QUERY_STRING})) { $args = $ENV{QUERY_STRING}; } foreach (split (/&/, $args)) { my ($key, $val) = m/^([^=]+)=(.*)$/; error ("unparsable args") unless (defined ($key) && defined ($val)); $key = url_unquote ($key); $val = url_unquote ($val); if ($key =~ m/^UID$/i) { error "multiple `uid' arguments are not allowed." if (defined($uid)); $uid = $val; } elsif ($key =~ m/^page$/i) { error "multiple `page' arguments are not allowed." if (defined($page)); $page = $val; } else { error "unknown option: $key."; } } if ($ENV{REMOTE_ADDR} && $ENV{REMOTE_ADDR} =~ m/^209\.157\./) { # assumes that I did: ssh -f nucleus -L 1111:cam:80 'sleep 999999' $base_url = "http://localhost:1111/"; } $page = 'main' unless defined ($page); write_html ($uid, $page); } main; exit 0;