#!/usr/bin/perl

# TeleCam UDP daemon
# http://fastolfe.net/features/telecam/
#
# Copyright (c) 2000 David Nesting <david@fastolfe.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
# Listens for 1-byte UDP messages and sends the appropriate RCX messages
# to the TeleCam mount.  Keeps track of movement extents and will refuse
# to move the camera beyond them.  Will reset the camera's orientation
# after a certain amount of time has elapsed with no activity.  Also sends
# periodic null messages in an effort to keep the RCX alive.  You probably
# want an external power source.
#
# Thu Dec 30 14:14:16 CST 1999
#
# Tab stops at 4, please.

use strict;
use POSIX 'setsid';
use IO::Socket;


# ---
# Configuration Options

my $PORT 		= 1502;
my $RESET_INT 	= 10 * 60;		# Move to neutral position after 10 minutes
my $USER 		= "nobody";		# run as nobody if we're root
my @NQC			= qw{ /usr/local/bin/nqc };

# Extents and "normal" settings -- Start the camera at one extent and
# move it to the other, noting where you want the "neutral" position to be
# and where the maximum extent should be.  These numbers should reflect
# the number of "twitches" required to get there.

my $MIN_X	= 0;	
my $MAX_X	= 35;		

my $MIN_Y	= 0;	
my $MAX_Y	= 26;		

my $NORM_X	= 13;
my $NORM_Y	= 11;


# ---
# Constants

# Messages to send to the RCX

use constant (NULL		=> 0);
use constant (UP		=> 1);
use constant (DOWN		=> 2);
use constant (RIGHT		=> 3);
use constant (LEFT		=> 4);

# These are just sound effects
use constant (ERROR		=> 7);	# camera attempted to move past extent
use constant (MARKING	=> 8);
use constant (RESETTING	=> 8);
use constant (OFF		=> 7);


my $server;
my ($x, $y);

&init;
&daemonize;
&run;

# That's it.
# ---


# Initialize
#
sub init {
	$0 = "telecamd";

	$server = IO::Socket::INET->new(	Proto	=> 'udp',
										LocalPort	=> $PORT,
										Reuse	=> 1);
	die "Can't setup server: $!" unless $server;

	&mark_position;

	$SIG{TERM} = sub { 
		&reset_position; 
		&send_msg(OFF);
		exit 0; 
	};
}


# Change our UID if we need to and fork into the background
#
sub daemonize {
	if ($< == 0) {
		my $uid = getpwnam($USER);
		if ($uid) {
			($<, $>) = ($uid, $uid);
		} else {
			print STDERR "Warning: User '$USER' unknown\n";
		}
	}
	chdir '/'				or die "Can't chdir to /: $!";
	open STDIN, '/dev/null'	or die "Can't read /dev/null: $!";
	open STDOUT, '>/dev/null'
							or die "Can't write to /dev/null: $!";
	defined(my $pid = fork)	or die "Can't fork: $!";
	exit if $pid;
	setsid					or die "Can't start a new session: $!";
	open STDERR, '>&STDOUT'	or die "Can't dup stdout: $!";
}


# Main program loop
#
sub run {
	my $rin;
	vec($rin, $server->fileno, 1) = 1;
	
	while (1) {
		my $rout;

		# Select for up to $RESET_INT seconds, after which time we need to
		# reset the cam's orientation or at least send it a keepalive message.

		if (select($rout = $rin, undef, undef, $RESET_INT)) {
			my $message;
			my $paddr = $server->recv($message, 1, 0);

			&reset_position if $message eq "R";
			&mark_position if $message eq "M";

			&send_msg($x < $MAX_X ? RIGHT : ERROR) && $x++ if $message eq "r";
			&send_msg($x > $MIN_X ? LEFT : ERROR) && $x-- if $message eq "l";
			&send_msg($y < $MAX_Y ? UP : ERROR) && $y++ if $message eq "u";
			&send_msg($y > $MIN_Y ? DOWN : ERROR) && $y-- if $message eq "d";
		} else {
			&reset_position;
		}
	}
}


# Take us back to standard orientation
#
sub reset_position {
	if (($x != $NORM_X) || ($y != $NORM_Y)) {
		&send_msg(RESETTING);	# Give us a sound.
	} else {
		&send_msg(NULL);		# If we're not actually updating, send an
								# empty message to the RCX as a "keepalive"
								# measure so it won't turn itself off.
	}
	while ($x < $NORM_X) {
		&send_msg(RIGHT) && $x++;
	}
	while ($x > $NORM_X) {
		&send_msg(LEFT) && $x--;
	}

	while ($y < $NORM_Y) {
		&send_msg(UP) && $y++;
	}
	while ($y > $NORM_Y) {
		&send_msg(DOWN) && $y--;
	}
}


# Mark the current position as normal/standard.
#
sub mark_position {
	if (($x != $NORM_X) || ($y != $NORM_Y)) {
		&send_msg(MARKING);		# Let us know audibly that we're 
								# marking this spot
		$x = $NORM_X;
		$y = $NORM_Y;
	}
}


# Sends a message to the RCX via NQC's -msg facility.  Returns 1 if NQC
# reported a successful delivery, undef if NQC got no response (or we
# were sending an ERROR message).
#
sub send_msg {
	my $message = shift;

	my $ret = system(@NQC, "-msg", $message);

	return 1 unless $ret || ($message == ERROR);
	return();
}