621 lines
14 KiB
Perl
621 lines
14 KiB
Perl
#!/usr/bin/perl -wT
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# ZoneMinder VISCA Control Script, $Date$, $Revision$
|
|
# Copyright (C) 2003, 2004, 2005, 2006 Philip Coombes
|
|
#
|
|
# 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.
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# This script continuously monitors the recorded events for the given
|
|
# monitor and applies any filters which would delete and/or upload
|
|
# matching events
|
|
#
|
|
use strict;
|
|
|
|
# ==========================================================================
|
|
#
|
|
# These are the elements you can edit to suit your installation
|
|
#
|
|
# ==========================================================================
|
|
|
|
use constant DBG_ID => "zmctrl-visc"; # Tag that appears in debug to identify source
|
|
use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
|
|
|
|
# ==========================================================================
|
|
|
|
use ZoneMinder;
|
|
use Getopt::Long;
|
|
use Device::SerialPort;
|
|
|
|
$| = 1;
|
|
|
|
$ENV{PATH} = '/bin:/usr/bin';
|
|
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
|
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
|
|
|
sub Usage
|
|
{
|
|
print( "
|
|
Usage: zmcontrol-visca.pl <various options>
|
|
");
|
|
exit( -1 );
|
|
}
|
|
|
|
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
|
|
|
|
my $arg_string = join( " ", @ARGV );
|
|
|
|
my $device = "/dev/ttyS0";
|
|
my $address = 1;
|
|
my $command;
|
|
my ( $speed, $step );
|
|
my ( $xcoord, $ycoord );
|
|
my ( $panspeed, $tiltspeed );
|
|
my ( $panstep, $tiltstep );
|
|
my $preset;
|
|
|
|
if ( !GetOptions(
|
|
'device=s'=>\$device,
|
|
'address=i'=>\$address,
|
|
'command=s'=>\$command,
|
|
'speed=i'=>\$speed,
|
|
'step=i'=>\$step,
|
|
'xcoord=i'=>\$xcoord,
|
|
'ycoord=i'=>\$ycoord,
|
|
'panspeed=i'=>\$panspeed,
|
|
'tiltspeed=i'=>\$tiltspeed,
|
|
'panstep=i'=>\$panstep,
|
|
'tiltstep=i'=>\$tiltstep,
|
|
'preset=i'=>\$preset
|
|
)
|
|
)
|
|
{
|
|
Usage();
|
|
}
|
|
|
|
Debug( $arg_string."\n" );
|
|
|
|
srand( time() );
|
|
|
|
my $serial_port = new Device::SerialPort( $device );
|
|
$serial_port->baudrate(9600);
|
|
$serial_port->databits(8);
|
|
$serial_port->parity('none');
|
|
$serial_port->stopbits(1);
|
|
$serial_port->handshake('rts');
|
|
$serial_port->stty_echo(0);
|
|
|
|
#$serial_port->read_const_time(250);
|
|
$serial_port->read_char_time(2);
|
|
|
|
sub printMsg
|
|
{
|
|
my $msg = shift;
|
|
my $prefix = shift || "";
|
|
$prefix = $prefix.": " if ( $prefix );
|
|
|
|
my $line_length = 16;
|
|
my $msg_len = int(@$msg);
|
|
|
|
my $msg_str = $prefix;
|
|
for ( my $i = 0; $i < $msg_len; $i++ )
|
|
{
|
|
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
|
{
|
|
$msg_str .= sprintf( "\n%*s", length($prefix), "" );
|
|
}
|
|
$msg_str .= sprintf( "%02x ", $msg->[$i] );
|
|
}
|
|
$msg_str .= "[".$msg_len."]\n";
|
|
}
|
|
|
|
sub sendCmd
|
|
{
|
|
my $cmd = shift;
|
|
my $ack = shift || 0;
|
|
my $cmp = shift || 0;
|
|
|
|
my $result = undef;
|
|
|
|
printMsg( $cmd, "Tx" );
|
|
my $id = $cmd->[0] & 0xf;
|
|
|
|
my $tx_msg = pack( "C*", @$cmd );
|
|
|
|
#print( "Tx: ".length( $tx_msg )." bytes\n" );
|
|
my $n_bytes = $serial_port->write( $tx_msg );
|
|
if ( !$n_bytes )
|
|
{
|
|
Error( "Write failed: $!" );
|
|
}
|
|
if ( $n_bytes != length($tx_msg) )
|
|
{
|
|
Error( "Incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
|
}
|
|
|
|
if ( $ack )
|
|
{
|
|
Debug( "Waiting for ack\n" );
|
|
my $max_wait = 3;
|
|
my $now = time();
|
|
while( 1 )
|
|
{
|
|
my ( $count, $rx_msg ) = $serial_port->read(4);
|
|
|
|
if ( $count )
|
|
{
|
|
#print( "Rx1: ".$count." bytes\n" );
|
|
my @resp = unpack( "C*", $rx_msg );
|
|
printMsg( \@resp, "Rx" );
|
|
|
|
if ( $resp[0] = 0x80 + ($id<<4) )
|
|
{
|
|
if ( ($resp[1] & 0xf0) == 0x40 )
|
|
{
|
|
my $socket = $resp[1] & 0x0f;
|
|
Debug( "Got ack for socket $socket\n" );
|
|
$result = !undef;
|
|
}
|
|
else
|
|
{
|
|
Error( "Got bogus response\n" );
|
|
}
|
|
last;
|
|
}
|
|
else
|
|
{
|
|
Error( "Got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
|
}
|
|
}
|
|
if ( (time() - $now) > $max_wait )
|
|
{
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $cmp )
|
|
{
|
|
Debug( "Waiting for command complete\n" );
|
|
my $max_wait = 10;
|
|
my $now = time();
|
|
while( 1 )
|
|
{
|
|
#print( "Waiting\n" );
|
|
my ( $count, $rx_msg ) = $serial_port->read(16);
|
|
|
|
if ( $count )
|
|
{
|
|
#print( "Rx1: ".$count." bytes\n" );
|
|
my @resp = unpack( "C*", $rx_msg );
|
|
printMsg( \@resp, "Rx" );
|
|
|
|
if ( $resp[0] = 0x80 + ($id<<4) )
|
|
{
|
|
if ( ($resp[1] & 0xf0) == 0x50 )
|
|
{
|
|
Debug( "Got command complete\n" );
|
|
$result = !undef;
|
|
}
|
|
else
|
|
{
|
|
Error( "Got bogus response\n" );
|
|
}
|
|
last;
|
|
}
|
|
else
|
|
{
|
|
Error( "Got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
|
}
|
|
}
|
|
if ( (time() - $now) > $max_wait )
|
|
{
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
return( $result );
|
|
}
|
|
|
|
my $sync = 0xff;
|
|
|
|
sub cameraOff
|
|
{
|
|
Debug( "Camera Off\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x03, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub cameraOn
|
|
{
|
|
Debug( "Camera On\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x00, 0x02, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stop
|
|
{
|
|
Debug( "Stop\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveUp
|
|
{
|
|
Debug( "Move Up\n" );
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x01, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveDown
|
|
{
|
|
Debug( "Move Down\n" );
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, 0x00, $speed, 0x03, 0x02, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveLeft
|
|
{
|
|
Debug( "Move Left\n" );
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x01, 0x03, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveRight
|
|
{
|
|
Debug( "Move Right\n" );
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $speed, 0x00, 0x02, 0x03, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveUpLeft
|
|
{
|
|
Debug( "Move Up/Left\n" );
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x01, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveUpRight
|
|
{
|
|
Debug( "Move Up/Right\n" );
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x01, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveDownLeft
|
|
{
|
|
Debug( "Move Down/Left\n" );
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x01, 0x02, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub moveDownRight
|
|
{
|
|
Debug( "Move Down/Right\n" );
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x01, $panspeed, $tiltspeed, 0x02, 0x02, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepUp
|
|
{
|
|
Debug( "Step Up\n" );
|
|
my $step = shift;
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, $sync );
|
|
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepDown
|
|
{
|
|
Debug( "Step Down\n" );
|
|
my $step = shift;
|
|
$step = -$step;
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, 0x00, $speed, 0x00, 0x00, 0x00, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepLeft
|
|
{
|
|
Debug( "Step Left\n" );
|
|
my $step = shift;
|
|
$step = -$step;
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepRight
|
|
{
|
|
Debug( "Step Right\n" );
|
|
my $step = shift;
|
|
my $speed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $speed, 0x00, ($step&0xf000)>>12, ($step&0x0f00)>>8, ($step&0x00f0)>>4, ($step&0x000f)>>0, 0x00, 0x00, 0x00, 0x00, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepUpLeft
|
|
{
|
|
Debug( "Step Up/Left\n" );
|
|
my $panstep = shift;
|
|
$panstep = -$panstep;
|
|
my $tiltstep = shift;
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepUpRight
|
|
{
|
|
Debug( "Step Up/Right\n" );
|
|
my $panstep = shift;
|
|
my $tiltstep = shift;
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepDownLeft
|
|
{
|
|
Debug( "Step Down/Left\n" );
|
|
my $panstep = shift;
|
|
$panstep = -$panstep;
|
|
my $tiltstep = shift;
|
|
$tiltstep = -$tiltstep;
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub stepDownRight
|
|
{
|
|
Debug( "Step Down/Right\n" );
|
|
my $panstep = shift;
|
|
my $tiltstep = shift;
|
|
$tiltstep = -$tiltstep;
|
|
my $panspeed = shift || 0x40;
|
|
my $tiltspeed = shift || 0x40;
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x03, $panspeed, $tiltspeed, ($panstep&0xf000)>>12, ($panstep&0x0f00)>>8, ($panstep&0x00f0)>>4, ($panstep&0x000f)>>0, ($tiltstep&0xf000)>>12, ($tiltstep&0x0f00)>>8, ($tiltstep&0x00f0)>>4, ($tiltstep&0x000f)>>0, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub zoomTele
|
|
{
|
|
Debug( "Zoom Tele\n" );
|
|
my $speed = shift || 0x06;
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x20|$speed, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub zoomWide
|
|
{
|
|
Debug( "Zoom Wide\n" );
|
|
my $speed = shift || 0x06;
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x30|$speed, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub zoomStop
|
|
{
|
|
Debug( "Zoom Stop\n" );
|
|
my $speed = shift || 0x06;
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x07, 0x00, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub focusNear
|
|
{
|
|
Debug( "Focus Near\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x03, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub focusFar
|
|
{
|
|
Debug( "Focus Far\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x02, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub focusStop
|
|
{
|
|
Debug( "Focus Far\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x08, 0x00, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub focusAuto
|
|
{
|
|
Debug( "Focus Auto\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x02, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub focusMan
|
|
{
|
|
Debug( "Focus Man\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x38, 0x03, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub presetClear
|
|
{
|
|
my $preset = shift || 1;
|
|
Debug( "Clear Preset $preset\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x00, $preset, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub presetSet
|
|
{
|
|
my $preset = shift || 1;
|
|
Debug( "Set Preset $preset\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x01, $preset, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub presetGoto
|
|
{
|
|
my $preset = shift || 1;
|
|
Debug( "Goto Preset $preset\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x04, 0x3f, 0x02, $preset, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
sub presetHome
|
|
{
|
|
Debug( "Home Preset\n" );
|
|
my @msg = ( 0x80|$address, 0x01, 0x06, 0x04, $sync );
|
|
sendCmd( \@msg );
|
|
}
|
|
|
|
if ( $command eq "move_con_up" )
|
|
{
|
|
moveUp( $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_con_down" )
|
|
{
|
|
moveDown( $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_con_left" )
|
|
{
|
|
moveLeft( $panspeed );
|
|
}
|
|
elsif ( $command eq "move_con_right" )
|
|
{
|
|
moveRight( $panspeed );
|
|
}
|
|
elsif ( $command eq "move_con_upleft" )
|
|
{
|
|
moveUpLeft( $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_con_upright" )
|
|
{
|
|
moveUpRight( $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_con_downleft" )
|
|
{
|
|
moveDownLeft( $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_con_downright" )
|
|
{
|
|
moveDownLeft( $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_stop" )
|
|
{
|
|
stop();
|
|
}
|
|
elsif ( $command eq "move_rel_up" )
|
|
{
|
|
stepUp( $tiltstep, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_down" )
|
|
{
|
|
stepDown( $tiltstep, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_left" )
|
|
{
|
|
stepLeft( $panstep, $panspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_right" )
|
|
{
|
|
stepRight( $panstep, $panspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_upleft" )
|
|
{
|
|
stepUpLeft( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_upright" )
|
|
{
|
|
stepUpRight( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_downleft" )
|
|
{
|
|
stepDownLeft( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "move_rel_downright" )
|
|
{
|
|
stepDownRight( $panstep, $tiltstep, $panspeed, $tiltspeed );
|
|
}
|
|
elsif ( $command eq "zoom_con_tele" )
|
|
{
|
|
zoomTele( $speed );
|
|
}
|
|
elsif ( $command eq "zoom_con_wide" )
|
|
{
|
|
zoomWide( $speed );
|
|
}
|
|
elsif ( $command eq "zoom_stop" )
|
|
{
|
|
zoomStop();
|
|
}
|
|
elsif ( $command eq "focus_con_near" )
|
|
{
|
|
focusNear();
|
|
}
|
|
elsif ( $command eq "focus_con_far" )
|
|
{
|
|
focusFar();
|
|
}
|
|
elsif ( $command eq "focus_stop" )
|
|
{
|
|
focusStop();
|
|
}
|
|
elsif ( $command eq "focus_auto" )
|
|
{
|
|
focusAuto();
|
|
}
|
|
elsif ( $command eq "focus_man" )
|
|
{
|
|
focusMan();
|
|
}
|
|
elsif ( $command eq "preset_home" )
|
|
{
|
|
presetHome();
|
|
}
|
|
elsif ( $command eq "preset_set" )
|
|
{
|
|
presetSet( $preset );
|
|
}
|
|
elsif ( $command eq "preset_goto" )
|
|
{
|
|
presetGoto( $preset );
|
|
}
|
|
else
|
|
{
|
|
Error( "Can't handle command $command\n" );
|
|
}
|
|
|
|
$serial_port->close();
|