ZaneYork
/
zoneminder
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Further work on control protocol modules, removed scripts. 

git-svn-id: http://svn.zoneminder.com/svn/zm/trunk@2181 e3e1d417-86f3-4887-817a-d78f3d33393f
This commit is contained in:
stan 2007-08-30 12:07:42 +00:00
parent bd558af08f
commit e6392ba2ce
11 changed files with 1003 additions and 3098 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
scripts/Makefile.am
View File

@ -53,6 +53,7 @@ EXTRA_DIST = \
ZoneMinder/lib/ZoneMinder/Control/AxisV2.pm \
ZoneMinder/lib/ZoneMinder/Control/PanasonicIP.pm \
ZoneMinder/lib/ZoneMinder/Control/Visca.pm \
ZoneMinder/lib/ZoneMinder/Control/Ncs370.pm \
ZoneMinder/lib/ZoneMinder/Trigger/Channel.pm \
ZoneMinder/lib/ZoneMinder/Trigger/Channel/Handle.pm \
ZoneMinder/lib/ZoneMinder/Trigger/Channel/Spawning.pm \

1
scripts/ZoneMinder/Makefile.PL
View File

@ -19,6 +19,7 @@ WriteMakefile(
'lib/ZoneMinder/Control/AxisV2.pm' => '$(INST_LIBDIR)/ZoneMinder/Control/AxisV2.pm',
'lib/ZoneMinder/Control/PanasonicIP.pm' => '$(INST_LIBDIR)/ZoneMinder/Control/PanasonicIP.pm',
'lib/ZoneMinder/Control/Visca.pm' => '$(INST_LIBDIR)/ZoneMinder/Control/Visca.pm',
'lib/ZoneMinder/Control/Ncs370.pm' => '$(INST_LIBDIR)/ZoneMinder/Control/Ncs370.pm',
'lib/ZoneMinder/Trigger/Channel.pm' => '$(INST_LIBDIR)/ZoneMinder/Trigger/Channel.pm',
'lib/ZoneMinder/Trigger/Channel/Handle.pm' => '$(INST_LIBDIR)/ZoneMinder/Trigger/Channel/Handle.pm',
'lib/ZoneMinder/Trigger/Channel/Spawning.pm' => '$(INST_LIBDIR)/ZoneMinder/Trigger/Channel/Spawning.pm',

240
scripts/ZoneMinder/lib/ZoneMinder/Control/Ncs370.pm Normal file
View File

@ -0,0 +1,240 @@
# ==========================================================================
#
# ZoneMinder Neu-Fusion Control Protocol Module, $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 module contains the implementation of the Neu-Fusion NCS370 IP camera
# control protocol
#
package ZoneMinder::Control::Ncs370;
use 5.006;
use strict;
use warnings;
require ZoneMinder::Base;
require ZoneMinder::Control;
our @ISA = qw(ZoneMinder::Control);
our $VERSION = $ZoneMinder::Base::VERSION;
# ==========================================================================
#
# Ncs370 IP Control Protocol
#
# ==========================================================================
use ZoneMinder::Debug qw(:all);
use Time::HiRes qw( usleep );
sub new
{
my $class = shift;
my $id = shift;
my $self = ZoneMinder::Control->new( $id );
bless( $self, $class );
srand( time() );
return $self;
}
our $AUTOLOAD;
sub AUTOLOAD
{
my $self = shift;
my $class = ref($self) || croak( "$self not object" );
my $name = $AUTOLOAD;
$name =~ s/.*://;
if ( exists($self->{$name}) )
{
return( $self->{$name} );
}
Fatal( "Can't access $name member of object of class $class" );
}
sub open
{
my $self = shift;
$self->loadMonitor();
use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new;
$self->{ua}->agent( "ZoneMinder Control Agent/".ZM_VERSION );
$self->{state} = 'open';
}
sub close
{
my $self = shift;
$self->{state} = 'closed';
}
sub printMsg
{
my $self = shift;
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" );
}
sub sendCmd
{
my $self = shift;
my $cmd = shift;
my $result = undef;
printMsg( $cmd, "Tx" );
my $req = HTTP::Request->new( POST=>"http://$address/PANTILTCONTROL.CGI" );
my $res = $ua->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "Error check failed: '".$res->status_line()."'" );
}
return( $result );
}
sub moveConUp
{
my $self = shift;
Debug( "Move Up" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=1";
$self->sendCmd( $cmd );
}
sub moveConDown
{
my $self = shift;
Debug( "Move Down" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=7";
$self->sendCmd( $cmd );
}
sub moveConLeft
{
my $self = shift;
Debug( "Move Left" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=3";
$self->sendCmd( $cmd );
}
sub moveConRight
{
my $self = shift;
Debug( "Move Right" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=5";
$self->sendCmd( $cmd );
}
sub moveConUpRight
{
moveConUp();
moveConRight();
}
sub moveConUpLeft
{
moveConUp();
moveConLeft();
}
sub moveConDownRight
{
moveConDown();
moveConRight();
}
sub moveConDownLeft
{
moveConDown();
moveConLeft();
}
sub presetHome
{
my $self = shift;
Debug( "Home Preset" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=4";
$self->sendCmd( $cmd );
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
ZoneMinder::Database - Perl extension for blah blah blah
=head1 SYNOPSIS
use ZoneMinder::Database;
blah blah blah
=head1 DESCRIPTION
Stub documentation for ZoneMinder, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005 by Philip Coombes
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=cut

736
scripts/ZoneMinder/lib/ZoneMinder/Control/PelcoP.pm Normal file
View File

@ -0,0 +1,736 @@
# ==========================================================================
#
# ZoneMinder Pelco-P Control Protocol Module, $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 module contains the implementation of the Pelco-P camera control
# protocol
#
package ZoneMinder::Control::PelcoD;
use 5.006;
use strict;
use warnings;
require ZoneMinder::Base;
require ZoneMinder::Control;
our @ISA = qw(ZoneMinder::Control);
our $VERSION = $ZoneMinder::Base::VERSION;
# ==========================================================================
#
# Pelco-P Control Protocol
#
# ==========================================================================
use ZoneMinder::Debug qw(:all);
use Time::HiRes qw( usleep );
use constant STX => 0xa0;
use constant ETX => 0xaf;
use constant COMMAND_GAP => 100000; # In ms
sub new
{
my $class = shift;
my $id = shift;
my $self = ZoneMinder::Control->new( $id );
bless( $self, $class );
srand( time() );
return $self;
}
our $AUTOLOAD;
sub AUTOLOAD
{
my $self = shift;
my $class = ref($self) || croak( "$self not object" );
my $name = $AUTOLOAD;
$name =~ s/.*://;
if ( exists($self->{$name}) )
{
return( $self->{$name} );
}
Fatal( "Can't access $name member of object of class $class" );
}
sub open
{
my $self = shift;
$self->loadMonitor();
use Device::SerialPort;
$self->{port} = new Device::SerialPort( $self->{Monitor}->{ControlDevice} );
$self->{port}->baudrate(4800);
$self->{port}->databits(8);
$self->{port}->parity('none');
$self->{port}->stopbits(1);
$self->{port}->handshake('none');
$self->{port}->read_const_time(50);
$self->{port}->read_char_time(10);
$self->{state} = 'open';
}
sub close
{
my $self = shift;
$self->{state} = 'closed';
$self->{port}->close();
}
sub printMsg
{
if ( zmDbgLevel() > 0 )
{
my $self = shift;
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."]";
Debug( $msg_str );
}
}
sub sendCmd
{
my $self = shift;
my $cmd = shift;
my $ack = shift || 0;
my $result = undef;
my $checksum = 0x00;
for ( my $i = 1; $i < int(@$cmd); $i++ )
{
$checksum ^= $cmd->[$i];
}
$checksum &= 0xff;
push( @$cmd, $checksum );
$self->printMsg( $cmd, "Tx" );
my $id = $cmd->[0] & 0xf;
my $tx_msg = pack( "C*", @$cmd );
#print( "Tx: ".length( $tx_msg )." bytes\n" );
my $n_bytes = $self->{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" );
my $max_wait = 3;
my $now = time();
while( 1 )
{
my ( $count, $rx_msg ) = $self->{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" );
$result = !undef;
}
else
{
Error( "Got bogus response" );
}
last;
}
else
{
Error( "Got message for camera ".(($resp[0]-0x80)>>4) );
}
}
if ( (time() - $now) > $max_wait )
{
Warning( "Response timeout" );
last;
}
}
}
}
sub remoteReset
{
my $self = shift;
Debug( "Remote Reset" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x0f, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub resetDefaults
{
my $self = shift;
Debug( "Reset Defaults" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x29, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub cameraOff
{
my $self = shift;
Debug( "Camera Off" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x08, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub cameraOn
{
my $self = shift;
Debug( "Camera On" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x88, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub autoScan
{
my $self = shift;
Debug( "Auto Scan" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x90, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub manScan
{
my $self = shift;
Debug( "Manual Scan" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x10, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub stop
{
my $self = shift;
Debug( "Stop" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub moveConUp
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'tiltspeed' );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Up" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x08, 0x00, $speed, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop( $params );
}
}
sub moveConDown
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'tiltspeed' );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Down" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x10, 0x00, $speed, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveConLeft
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'panspeed' );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Left" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x04, $speed, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveConRight
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'panspeed' );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Right" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x02, $speed, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveConUpLeft
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Up/Left" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x0c, $panspeed, $tiltspeed, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveConUpRight
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Up/Right" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x0a, $panspeed, $tiltspeed, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveConDownLeft
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Down/Left" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x14, $panspeed, $tiltspeed, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveConDownRight
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed', 0x3f );
my $tiltspeed = $self->getParam( $params, 'tiltspeed', 0x3f );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Move Down/Right" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x12, $panspeed, $tiltspeed, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->stop();
}
}
sub moveStop
{
my $self = shift;
Debug( "Move Stop" );
$self->stop();
}
sub flip180
{
my $self = shift;
Debug( "Flip 180" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x21, ETX );
$self->sendCmd( \@msg );
}
sub zeroPan
{
my $self = shift;
Debug( "Zero Pan" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x22, ETX );
$self->sendCmd( \@msg );
}
sub _setZoomSpeed
{
my $self = shift;
my $speed = shift;
Debug( "Set Zoom Speed $speed" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x25, 0x00, $speed, ETX );
$self->sendCmd( \@msg );
}
sub zoomStop
{
my $self = shift;
Debug( "Zoom Stop" );
$self->stop();
$self->_setZoomSpeed( 0 );
}
sub zoomConTele
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'speed', 0x01 );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Zoom Tele" );
$self->_setZoomSpeed( $speed );
usleep( COMMAND_GAP );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x20, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->zoomStop();
}
}
sub zoomConWide
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'speed', 0x01 );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Zoom Wide" );
$self->_setZoomSpeed( $speed );
usleep( COMMAND_GAP );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x40, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->zoomStop();
}
}
sub _setFocusSpeed
{
my $self = shift;
my $speed = shift;
Debug( "Set Focus Speed $speed" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x27, 0x00, $speed, ETX );
$self->sendCmd( \@msg );
}
sub focusConNear
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'speed', 0x03 );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Focus Near" );
$self->_setFocusSpeed( $speed );
usleep( COMMAND_GAP );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x01, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->_setFocusSpeed( 0 );
}
}
sub focusConFar
{
my $self = shift;
my $params = shift;
my $speed = $self->getParam( $params, 'speed', 0x03 );
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Focus Far" );
$self->_setFocusSpeed( $speed );
usleep( COMMAND_GAP );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x80, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->_setFocusSpeed( 0 );
}
}
sub focusStop
{
my $self = shift;
Debug( "Focus Stop" );
$self->stop();
$self->_setFocusSpeed( 0 );
}
sub focusAuto
{
my $self = shift;
Debug( "Focus Auto" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2b, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub focusMan
{
my $self = shift;
Debug( "Focus Man" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2b, 0x00, 0x02, ETX );
$self->sendCmd( \@msg );
}
sub _setIrisSpeed
{
my $self = shift;
my $speed = shift;
Debug( "Set Iris Speed $speed" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x27, 0x00, $speed, ETX );
$self->sendCmd( \@msg );
}
sub irisConClose
{
my $self = shift;
my $params = shift;
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Iris Close" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x04, 0x00, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->_setIrisSpeed( 0 );
}
}
sub irisConOpen
{
my $self = shift;
my $params = shift;
my $autostop = $self->getParam( $params, 'autostop', 0 );
Debug( "Iris Open" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x02, 0x80, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
if( $autostop && $self->{Monitor}->{AutoStopTimeout} )
{
usleep( $self->{Monitor}->{AutoStopTimeout} );
$self->_setIrisSpeed( 0 );
}
}
sub irisStop
{
my $self = shift;
Debug( "Iris Stop" );
$self->stop();
$self->_setIrisSpeed( 0 );
}
sub irisAuto
{
my $self = shift;
Debug( "Iris Auto" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2d, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub irisMan
{
my $self = shift;
Debug( "Iris Man" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x2d, 0x00, 0x02, ETX );
$self->sendCmd( \@msg );
}
sub writeScreen
{
my $self = shift;
my $params = shift;
my $string = $self->getParam( $params, 'string' );
Debug( "Writing '$string' to screen" );
my @chars = unpack( "C*", $string );
for ( my $i = 0; $i < length($string); $i++ )
{
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x15, $i, $chars[$i], ETX );
$self->sendCmd( \@msg );
usleep( COMMAND_GAP );
}
}
sub clearScreen
{
my $self = shift;
Debug( "Clear Screen" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x17, 0x00, 0x00, ETX );
$self->sendCmd( \@msg );
}
sub clearPreset
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset', 1 );
Debug( "Clear Preset $preset" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x05, 0x00, $preset, ETX );
$self->sendCmd( \@msg );
}
sub presetSet
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset', 1 );
Debug( "Set Preset $preset" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x03, 0x00, $preset, ETX );
$self->sendCmd( \@msg );
}
sub presetGoto
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset', 1 );
Debug( "Goto Preset $preset" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, $preset, ETX );
$self->sendCmd( \@msg );
}
sub presetHome
{
my $self = shift;
Debug( "Home Preset" );
my @msg = ( STX, $self->{Monitor}->{ControlAddress}, 0x00, 0x07, 0x00, 0x22, ETX );
$self->sendCmd( \@msg );
}
sub reset
{
my $self = shift;
Debug( "Reset" );
$self->remoteReset();
$self->resetDefaults();
}
sub wake
{
my $self = shift;
Debug( "Wake" );
$self->cameraOn();
}
sub sleep
{
my $self = shift;
Debug( "Sleep" );
$self->cameraOff();
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
ZoneMinder::Database - Perl extension for blah blah blah
=head1 SYNOPSIS
use ZoneMinder::Database;
blah blah blah
=head1 DESCRIPTION
Stub documentation for ZoneMinder, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Mention other useful documentation such as the documentation of
related modules or operating system documentation (such as man pages
in UNIX), or any relevant external documentation such as RFCs or
standards.
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
Philip Coombes, E<lt>philip.coombes@zoneminder.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005 by Philip Coombes
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=cut

26
scripts/ZoneMinder/lib/ZoneMinder/Control/Visca.pm
View File

@ -236,6 +236,30 @@ sub sendCmd
return( $result );
}
sub cameraOff
{
my $self = shift;
Debug( "Camera Off\n" );
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x00, 0x0, SYNC );
$self->sendCmd( \@msg );
}
sub cameraOn
{
my $self = shift;
Debug( "Camera On\n" );
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x04, 0x00, 0x2, SYNC );
$self->sendCmd( \@msg );
}
sub stop
{
my $self = shift;
Debug( "Stop\n" );
my @msg = ( 0x80|$self->{Monitor}->{ControlAddress}, 0x01, 0x06, 0x01, 0x00, 0x00, 0x03, 0x03, SYNC );
$self->sendCmd( \@msg );
}
sub moveConUp
{
my $self = shift;
@ -252,7 +276,7 @@ sub moveConUp
}
}
sub moveDown
sub moveConDown
{
my $self = shift;
my $params = shift;

505
scripts/zmcontrol-axis-v2.pl
View File

@ -1,505 +0,0 @@
#!/usr/bin/perl -wT
#
# ==========================================================================
#
# ZoneMinder Axis HTTP API v2 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-axis"; # 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;
$| = 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-axis-v2.pl <various options>
");
exit( -1 );
}
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
my $arg_string = join( " ", @ARGV );
my $address;
my $command;
my ( $speed, $step );
my ( $xcoord, $ycoord );
my ( $width, $height );
my ( $panspeed, $tiltspeed );
my ( $panstep, $tiltstep );
my $preset;
if ( !GetOptions(
'address=s'=>\$address,
'command=s'=>\$command,
'speed=i'=>\$speed,
'step=i'=>\$step,
'xcoord=i'=>\$xcoord,
'ycoord=i'=>\$ycoord,
'width=i'=>\$width,
'height=i'=>\$height,
'panspeed=i'=>\$panspeed,
'tiltspeed=i'=>\$tiltspeed,
'panstep=i'=>\$panstep,
'tiltstep=i'=>\$tiltstep,
'preset=i'=>\$preset
)
)
{
Usage();
}
if ( !$address )
{
Usage();
}
Debug( $arg_string."\n" );
srand( time() );
sub printMsg
{
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]\n" );
}
sub sendCmd
{
my $cmd = shift;
my $result = undef;
printMsg( $cmd, "Tx" );
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent( "ZoneMinder Control Agent/".ZM_VERSION );
#print( "http://$address/$cmd\n" );
my $req = HTTP::Request->new( GET=>"http://$address/$cmd" );
my $res = $ua->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "Error check failed: '".$res->status_line()."'\n" );
}
return( $result );
}
sub cameraReset
{
Debug( "Camera Reset\n" );
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
sendCmd( $cmd );
}
sub moveUp
{
Debug( "Move Up\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=up";
sendCmd( $cmd );
}
sub moveDown
{
Debug( "Move Down\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=down";
sendCmd( $cmd );
}
sub moveLeft
{
Debug( "Move Left\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=left";
sendCmd( $cmd );
}
sub moveRight
{
Debug( "Move Right\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=right";
sendCmd( $cmd );
}
sub moveUpRight
{
Debug( "Move Up/Right\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=upright";
sendCmd( $cmd );
}
sub moveUpLeft
{
Debug( "Move Up/Left\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=upleft";
sendCmd( $cmd );
}
sub moveDownRight
{
Debug( "Move Down/Right\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=downright";
sendCmd( $cmd );
}
sub moveDownLeft
{
Debug( "Move Down/Left\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=downleft";
sendCmd( $cmd );
}
sub moveMap
{
my ( $xcoord, $ycoord, $width, $height ) = @_;
Debug( "Move Map to $xcoord,$ycoord\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth=$width&imageheight=$height";
sendCmd( $cmd );
}
sub stepUp
{
my $step = shift;
Debug( "Step Up $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=$step";
sendCmd( $cmd );
}
sub stepDown
{
my $step = shift;
Debug( "Step Down $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rtilt=-$step";
sendCmd( $cmd );
}
sub stepLeft
{
my $step = shift;
Debug( "Step Left $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$step";
sendCmd( $cmd );
}
sub stepRight
{
my $step = shift;
Debug( "Step Right $step\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$step";
sendCmd( $cmd );
}
sub stepUpRight
{
my $panstep = shift;
my $tiltstep = shift;
Debug( "Step Up/Right $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=$tiltstep";
sendCmd( $cmd );
}
sub stepUpLeft
{
my $panstep = shift;
my $tiltstep = shift;
Debug( "Step Up/Left $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=$tiltstep";
sendCmd( $cmd );
}
sub stepDownRight
{
my $panstep = shift;
my $tiltstep = shift;
Debug( "Step Down/Right $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=$panstep&rtilt=-$tiltstep";
sendCmd( $cmd );
}
sub stepDownLeft
{
my $panstep = shift;
my $tiltstep = shift;
Debug( "Step Down/Left $tiltstep/$panstep\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rpan=-$panstep&rtilt=-$tiltstep";
sendCmd( $cmd );
}
sub zoomTele
{
my $step = shift;
Debug( "Zoom Tele\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=$step";
sendCmd( $cmd );
}
sub zoomWide
{
my $step = shift;
Debug( "Zoom Wide\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rzoom=-$step";
sendCmd( $cmd );
}
sub focusNear
{
my $step = shift;
Debug( "Focus Near\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=-$step";
sendCmd( $cmd );
}
sub focusFar
{
my $step = shift;
Debug( "Focus Far\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?rfocus=$step";
sendCmd( $cmd );
}
sub focusAuto
{
Debug( "Focus Auto\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=on";
sendCmd( $cmd );
}
sub focusMan
{
Debug( "Focus Manual\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autofocus=off";
sendCmd( $cmd );
}
sub irisOpen
{
my $step = shift;
Debug( "Iris Open\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?riris=$step";
sendCmd( $cmd );
}
sub irisClose
{
my $step = shift;
Debug( "Iris Close\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?riris=-$step";
sendCmd( $cmd );
}
sub irisAuto
{
Debug( "Iris Auto\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=on";
sendCmd( $cmd );
}
sub irisMan
{
Debug( "Iris Manual\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?autoiris=off";
sendCmd( $cmd );
}
sub presetClear
{
my $preset = shift || 1;
Debug( "Clear Preset $preset\n" );
my $cmd = "nphPresetNameCheck?Data=$preset";
sendCmd( $cmd );
}
sub presetSet
{
my $preset = shift || 1;
Debug( "Set Preset $preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
sendCmd( $cmd );
}
sub presetGoto
{
my $preset = shift || 1;
Debug( "Goto Preset $preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?gotoserverpresetno=$preset";
sendCmd( $cmd );
}
sub presetHome
{
Debug( "Home Preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?move=home";
sendCmd( $cmd );
}
if ( $command eq "move_con_up" )
{
moveUp();
}
elsif ( $command eq "move_con_down" )
{
moveDown();
}
elsif ( $command eq "move_con_left" )
{
moveLeft();
}
elsif ( $command eq "move_con_right" )
{
moveRight();
}
elsif ( $command eq "move_con_upleft" )
{
moveUpLeft();
}
elsif ( $command eq "move_con_upright" )
{
moveUpRight();
}
elsif ( $command eq "move_con_downleft" )
{
moveDownLeft();
}
elsif ( $command eq "move_con_downright" )
{
moveDownLeft();
}
elsif ( $command eq "move_map" )
{
moveMap( $xcoord, $ycoord, $width, $height );
}
elsif ( $command eq "move_rel_up" )
{
stepUp( $tiltstep );
}
elsif ( $command eq "move_rel_down" )
{
stepDown( $tiltstep );
}
elsif ( $command eq "move_rel_left" )
{
stepLeft( $panstep );
}
elsif ( $command eq "move_rel_right" )
{
stepRight( $panstep );
}
elsif ( $command eq "move_rel_upleft" )
{
stepUpLeft( $panstep, $tiltstep );
}
elsif ( $command eq "move_rel_upright" )
{
stepUpRight( $panstep, $tiltstep );
}
elsif ( $command eq "move_rel_downleft" )
{
stepDownLeft( $panstep, $tiltstep );
}
elsif ( $command eq "move_rel_downright" )
{
stepDownRight( $panstep, $tiltstep );
}
elsif ( $command eq "zoom_rel_tele" )
{
zoomTele( $step );
}
elsif ( $command eq "zoom_rel_wide" )
{
zoomWide( $step );
}
elsif ( $command eq "focus_rel_near" )
{
focusNear( $step );
}
elsif ( $command eq "focus_rel_far" )
{
focusFar( $step );
}
elsif ( $command eq "focus_auto" )
{
focusAuto();
}
elsif ( $command eq "focus_man" )
{
focusMan();
}
elsif ( $command eq "iris_rel_open" )
{
irisOpen( $step );
}
elsif ( $command eq "iris_rel_close" )
{
irisClose( $step );
}
elsif ( $command eq "iris_auto" )
{
irisAuto();
}
elsif ( $command eq "iris_man" )
{
irisMan();
}
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" );
}

292
scripts/zmcontrol-ncs370.pl
View File

@ -1,292 +0,0 @@
#!/usr/bin/perl -wT
#
# ==========================================================================
#
# ZoneMinder Neu-Fusion Control Script, $Date$, $Revision$
# Copyright (C) 2005 Richard Yeardley
# Portions 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-ncs370"; # 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;
$| = 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-ncs370.pl <various options>
");
exit( -1 );
}
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
my $arg_string = join( " ", @ARGV );
my $address;
my $command;
my ( $speed, $step );
my ( $xcoord, $ycoord );
my ( $width, $height );
my ( $panspeed, $tiltspeed );
my ( $panstep, $tiltstep );
my $preset;
if ( !GetOptions(
'address=s'=>\$address,
'command=s'=>\$command,
'speed=i'=>\$speed,
'step=i'=>\$step,
'xcoord=i'=>\$xcoord,
'ycoord=i'=>\$ycoord,
'width=i'=>\$width,
'height=i'=>\$height,
'panspeed=i'=>\$panspeed,
'tiltspeed=i'=>\$tiltspeed,
'panstep=i'=>\$panstep,
'tiltstep=i'=>\$tiltstep,
'preset=i'=>\$preset
)
)
{
Usage();
}
if ( !$address )
{
Usage();
}
Debug( $arg_string."\n" );
srand( time() );
sub printMsg
{
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]\n" );
}
sub sendCmd
{
my $cmd = shift;
my $result = undef;
printMsg( $cmd, "Tx" );
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent( "ZoneMinder Control Agent/".ZM_VERSION );
my $req = HTTP::Request->new( POST=>"http://$address/PANTILTCONTROL.CGI" );
$req->content($cmd);
my $res = $ua->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "Error check failed: '".$res->status_line()."'\n" );
}
return( $result );
}
sub cameraReset
{
Debug( "Camera Reset\n" );
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
sendCmd( $cmd );
}
sub moveUp
{
Debug( "Move Up\n" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=1";
sendCmd( $cmd );
}
sub moveDown
{
Debug( "Move Down\n" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=7";
sendCmd( $cmd );
}
sub moveLeft
{
Debug( "Move Left\n" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=3";
sendCmd( $cmd );
}
sub moveRight
{
Debug( "Move Right\n" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=5";
sendCmd( $cmd );
}
sub moveUpRight
{
moveUp();
moveRight();
}
sub moveUpLeft
{
moveUp();
moveLeft();
}
sub moveDownRight
{
moveDown();
moveRight();
}
sub moveDownLeft
{
moveDown();
moveLeft();
}
sub moveMap
{
my ( $xcoord, $ycoord, $width, $height ) = @_;
Debug( "Move Map to $xcoord,$ycoord\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?center=$xcoord,$ycoord&imagewidth=$width&imageheight=$height";
sendCmd( $cmd );
}
sub stepUp
{
my $step = shift;
Debug( "Step Up $step\n" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=$step\nPanTiltSingleMove=1";
sendCmd( $cmd );
}
sub presetClear
{
my $preset = shift || 1;
Debug( "Clear Preset $preset\n" );
my $cmd = "nphPresetNameCheck?Data=$preset";
sendCmd( $cmd );
}
sub presetSet
{
my $preset = shift || 1;
Debug( "Set Preset $preset\n" );
my $cmd = "/axis-cgi/com/ptz.cgi?setserverpresetno=$preset";
sendCmd( $cmd );
}
sub presetGoto
{
my $preset = shift || 1;
Debug( "Goto Preset $preset\n" );
my $cmd = "PanTiltPresetPositionMove=$preset";
sendCmd( $cmd );
}
sub presetHome
{
Debug( "Home Preset\n" );
my $cmd = "PanSingleMoveDegree=1\nTiltSingleMoveDegree=1\nPanTiltSingleMove=4";
sendCmd( $cmd );
}
if ( $command eq "move_con_up" )
{
moveUp();
}
elsif ( $command eq "move_con_down" )
{
moveDown();
}
elsif ( $command eq "move_con_left" )
{
moveLeft();
}
elsif ( $command eq "move_con_right" )
{
moveRight();
}
elsif ( $command eq "move_con_upleft" )
{
moveUpLeft();
}
elsif ( $command eq "move_con_upright" )
{
moveUpRight();
}
elsif ( $command eq "move_con_downleft" )
{
moveDownLeft();
}
elsif ( $command eq "move_con_downright" )
{
moveDownRight();
}
elsif ( $command eq "move_map" )
{
# moveMap( $xcoord, $ycoord, $width, $height );
}
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" );
}

304
scripts/zmcontrol-panasonic-ip.pl
View File

@ -1,304 +0,0 @@
#!/usr/bin/perl -wT
#
# ==========================================================================
#
# ZoneMinder Panasonic IP Camera 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-pana"; # 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;
$| = 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-pansonic-ip.pl <various options>
");
exit( -1 );
}
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
my $arg_string = join( " ", @ARGV );
my $address;
my $command;
my ( $speed, $step );
my ( $xcoord, $ycoord );
my ( $width, $height );
my ( $panspeed, $tiltspeed );
my ( $panstep, $tiltstep );
my $preset;
if ( !GetOptions(
'address=s'=>\$address,
'command=s'=>\$command,
'speed=i'=>\$speed,
'step=i'=>\$step,
'xcoord=i'=>\$xcoord,
'ycoord=i'=>\$ycoord,
'width=i'=>\$width,
'height=i'=>\$height,
'panspeed=i'=>\$panspeed,
'tiltspeed=i'=>\$tiltspeed,
'panstep=i'=>\$panstep,
'tiltstep=i'=>\$tiltstep,
'preset=i'=>\$preset
)
)
{
Usage();
}
if ( !$address )
{
Usage();
}
Debug( $arg_string."\n" );
srand( time() );
sub printMsg
{
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]\n" );
}
sub sendCmd
{
my $cmd = shift;
my $result = undef;
printMsg( $cmd, "Tx" );
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent( "ZoneMinder Control Agent/".ZM_VERSION );
#print( "http://$address/$cmd\n" );
my $req = HTTP::Request->new( GET=>"http://$address/$cmd" );
my $res = $ua->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "Error check failed: '".$res->status_line()."'\n" );
}
return( $result );
}
sub cameraReset
{
Debug( "Camera Reset\n" );
my $cmd = "nphRestart?PAGE=Restart&Restart=OK";
sendCmd( $cmd );
}
sub moveUp
{
Debug( "Move Up\n" );
my $cmd = "nphControlCamera?Direction=TiltUp";
sendCmd( $cmd );
}
sub moveDown
{
Debug( "Move Down\n" );
my $cmd = "nphControlCamera?Direction=TiltDown";
sendCmd( $cmd );
}
sub moveLeft
{
Debug( "Move Left\n" );
my $cmd = "nphControlCamera?Direction=PanLeft";
sendCmd( $cmd );
}
sub moveRight
{
Debug( "Move Right\n" );
my $cmd = "nphControlCamera?Direction=PanRight";
sendCmd( $cmd );
}
sub moveMap
{
my ( $xcoord, $ycoord, $width, $height ) = @_;
Debug( "Move Map to $xcoord,$ycoord\n" );
my $cmd = "nphControlCamera?Direction=Direct&NewPosition.x=$xcoord&NewPosition.y=$ycoord&Width=$width&Height=$height";
sendCmd( $cmd );
}
sub zoomTele
{
Debug( "Zoom Tele\n" );
my $cmd = "nphControlCamera?Direction=ZoomTele";
sendCmd( $cmd );
}
sub zoomWide
{
Debug( "Zoom Wide\n" );
my $cmd = "nphControlCamera?Direction=ZoomWide";
sendCmd( $cmd );
}
sub focusNear
{
Debug( "Focus Near\n" );
my $cmd = "nphControlCamera?Direction=FocusNear";
sendCmd( $cmd );
}
sub focusFar
{
Debug( "Focus Far\n" );
my $cmd = "nphControlCamera?Direction=FocusFar";
sendCmd( $cmd );
}
sub focusAuto
{
Debug( "Focus Auto\n" );
my $cmd = "nphControlCamera?Direction=FocusAuto";
sendCmd( $cmd );
}
sub presetClear
{
my $preset = shift || 1;
Debug( "Clear Preset $preset\n" );
my $cmd = "nphPresetNameCheck?Data=$preset";
sendCmd( $cmd );
}
sub presetSet
{
my $preset = shift || 1;
Debug( "Set Preset $preset\n" );
my $cmd = "nphPresetNameCheck?PresetName=$preset&Data=$preset";
sendCmd( $cmd );
}
sub presetGoto
{
my $preset = shift || 1;
Debug( "Goto Preset $preset\n" );
my $cmd = "nphControlCamera?Direction=Preset&PresetOperation=Move&Data=$preset";
sendCmd( $cmd );
}
sub presetHome
{
Debug( "Home Preset\n" );
my $cmd = "nphControlCamera?Direction=HomePosition";
sendCmd( $cmd );
}
if ( $command eq "move_con_up" )
{
moveUp();
}
elsif ( $command eq "move_con_down" )
{
moveDown();
}
elsif ( $command eq "move_con_left" )
{
moveLeft();
}
elsif ( $command eq "move_con_right" )
{
moveRight();
}
elsif ( $command eq "move_map" )
{
moveMap( $xcoord, $ycoord, $width, $height );
}
elsif ( $command eq "zoom_con_tele" )
{
zoomTele();
}
elsif ( $command eq "zoom_con_wide" )
{
zoomWide();
}
elsif ( $command eq "focus_con_near" )
{
focusNear();
}
elsif ( $command eq "focus_con_far" )
{
focusFar();
}
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" );
}

687
scripts/zmcontrol-pelco-d.pl
View File

@ -1,687 +0,0 @@
#!/usr/bin/perl -wT
#
# ==========================================================================
#
# ZoneMinder Pelco-D 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-peld"; # 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;
use Time::HiRes qw( usleep );
$| = 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-pelco-d.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 $autostop;
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,
'autostop=f'=>\$autostop,
'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();
}
if ( defined($autostop) )
{
# Convert to microseconds.
$autostop = int(1000000*$autostop);
}
Debug( $arg_string."\n" );
srand( time() );
my $serial_port = new Device::SerialPort( $device );
$serial_port->baudrate(2400);
$serial_port->databits(8);
$serial_port->parity('none');
$serial_port->stopbits(1);
$serial_port->handshake('none');
$serial_port->read_const_time(50);
$serial_port->read_char_time(10);
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";
Debug( $msg_str );
}
sub sendCmd
{
my $cmd = shift;
my $ack = shift || 0;
my $result = undef;
my $checksum = 0x00;
for ( my $i = 1; $i < int(@$cmd); $i++ )
{
$checksum += $cmd->[$i];
$checksum &= 0xff;
}
push( @$cmd, $checksum );
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: $!" );
}
$serial_port->write_drain();
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 )
{
Warning( "Response timeout\n" );
last;
}
}
}
}
my $sync = 0xff;
sub remoteReset
{
Debug( "Remote Reset\n" );
my @msg = ( $sync, $address, 0x00, 0x0f, 0x00, 0x00 );
sendCmd( \@msg );
}
sub resetDefaults
{
Debug( "Reset Defaults\n" );
my @msg = ( $sync, $address, 0x00, 0x29, 0x00, 0x00 );
sendCmd( \@msg );
}
sub cameraOff
{
Debug( "Camera Off\n" );
my @msg = ( $sync, $address, 0x08, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
}
sub cameraOn
{
Debug( "Camera On\n" );
my @msg = ( $sync, $address, 0x88, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
}
sub autoScan
{
Debug( "Auto Scan\n" );
my @msg = ( $sync, $address, 0x90, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
}
sub manScan
{
Debug( "Manual Scan\n" );
my @msg = ( $sync, $address, 0x10, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
}
sub stop
{
Debug( "Stop\n" );
my @msg = ( $sync, $address, 0x00, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
}
sub moveUp
{
Debug( "Move Up\n" );
my $speed = shift;
my @msg = ( $sync, $address, 0x00, 0x08, 0x00, $speed );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveDown
{
Debug( "Move Down\n" );
my $speed = shift;
my @msg = ( $sync, $address, 0x00, 0x10, 0x00, $speed );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveLeft
{
Debug( "Move Left\n" );
my $speed = shift;
my @msg = ( $sync, $address, 0x00, 0x04, $speed, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveRight
{
Debug( "Move Right\n" );
my $speed = shift;
my @msg = ( $sync, $address, 0x00, 0x02, $speed, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveUpLeft
{
Debug( "Move Up/Left\n" );
my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x0c, $panspeed, $tiltspeed );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveUpRight
{
Debug( "Move Up/Right\n" );
my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x0a, $panspeed, $tiltspeed );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveDownLeft
{
Debug( "Move Down/Left\n" );
my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x14, $panspeed, $tiltspeed );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveDownRight
{
Debug( "Move Down/Right\n" );
my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f;
my @msg = ( $sync, $address, 0x00, 0x12, $panspeed, $tiltspeed );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub flip180
{
Debug( "Flip 180\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x21 );
sendCmd( \@msg );
}
sub zeroPan
{
Debug( "Zero Pan\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
sendCmd( \@msg );
}
sub setZoomSpeed
{
my $speed = shift;
my @msg = ( $sync, $address, 0x00, 0x25, 0x00, $speed );
sendCmd( \@msg );
}
sub zoomStop
{
stop();
setZoomSpeed( 0 );
}
sub zoomTele
{
Debug( "Zoom Tele\n" );
my $speed = shift || 0x01;
setZoomSpeed( $speed );
usleep( 250000 );
my @msg = ( $sync, $address, 0x00, 0x20, 0x00, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
zoomStop();
}
}
sub zoomWide
{
Debug( "Zoom Wide\n" );
my $speed = shift || 0x01;
setZoomSpeed( $speed );
usleep( 250000 );
my @msg = ( $sync, $address, 0x00, 0x40, 0x00, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
zoomStop();
}
}
sub setFocusSpeed
{
my $speed = shift;
my @msg = ( $sync, $address, 0x00, 0x27, 0x00, $speed );
sendCmd( \@msg );
}
sub focusNear
{
Debug( "Focus Near\n" );
my $speed = shift || 0x03;
setFocusSpeed( $speed );
usleep( 250000 );
my @msg = ( $sync, $address, 0x01, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setFocusSpeed( 0 );
}
}
sub focusFar
{
Debug( "Focus Far\n" );
my $speed = shift || 0x03;
setFocusSpeed( $speed );
usleep( 250000 );
my @msg = ( $sync, $address, 0x00, 0x80, 0x00, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setFocusSpeed( 0 );
}
}
sub focusAuto
{
Debug( "Focus Auto\n" );
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x00 );
sendCmd( \@msg );
}
sub focusMan
{
Debug( "Focus Man\n" );
my @msg = ( $sync, $address, 0x00, 0x2b, 0x00, 0x02 );
sendCmd( \@msg );
}
sub irisClose
{
Debug( "Iris Close\n" );
my @msg = ( $sync, $address, 0x04, 0x00, 0x00, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setIrisSpeed( 0 );
}
}
sub irisOpen
{
Debug( "Iris Open\n" );
my @msg = ( $sync, $address, 0x02, 0x80, 0x00, 0x00 );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setIrisSpeed( 0 );
}
}
sub irisAuto
{
Debug( "Iris Auto\n" );
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x00 );
sendCmd( \@msg );
}
sub irisMan
{
Debug( "Iris Man\n" );
my @msg = ( $sync, $address, 0x00, 0x2d, 0x00, 0x02 );
sendCmd( \@msg );
}
sub writeScreen
{
my $string = shift;
Debug( "Writing '$string' to screen\n" );
my @chars = unpack( "C*", $string );
for ( my $i = 0; $i < length($string); $i++ )
{
#printf( "0x%02x\n", $chars[$i] );
my @msg = ( $sync, $address, 0x00, 0x15, $i, $chars[$i] );
sendCmd( \@msg );
}
}
sub clearScreen
{
Debug( "Clear Screen\n" );
my @msg = ( $sync, $address, 0x00, 0x17, 0x00, 0x00 );
sendCmd( \@msg );
}
sub clearPreset
{
my $preset = shift || 1;
Debug( "Clear Preset $preset\n" );
my @msg = ( $sync, $address, 0x00, 0x05, 0x00, $preset );
sendCmd( \@msg );
}
sub presetSet
{
my $preset = shift || 1;
Debug( "Set Preset $preset\n" );
my @msg = ( $sync, $address, 0x00, 0x03, 0x00, $preset );
sendCmd( \@msg );
}
sub presetGoto
{
my $preset = shift || 1;
Debug( "Goto Preset $preset\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, $preset );
sendCmd( \@msg );
}
sub presetHome
{
Debug( "Home Preset\n" );
my @msg = ( $sync, $address, 0x00, 0x07, 0x00, 0x22 );
sendCmd( \@msg );
}
if ( $command eq "reset" )
{
remoteReset();
resetDefaults();
}
elsif ( $command eq "wake" )
{
cameraOn();
}
elsif ( $command eq "sleep" )
{
cameraOff();
}
elsif ( $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" )
{
moveDownRight( $panspeed, $tiltspeed );
}
elsif ( $command eq "move_stop" )
{
stop();
}
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" )
{
stop();
#setFocusSpeed( 0 );
}
elsif ( $command eq "focus_auto" )
{
focusAuto();
}
elsif ( $command eq "focus_man" )
{
focusMan();
}
elsif ( $command eq "iris_con_close" )
{
irisClose();
}
elsif ( $command eq "iris_con_open" )
{
irisOpen();
}
elsif ( $command eq "iris_stop" )
{
stop();
}
elsif ( $command eq "iris_auto" )
{
irisAuto();
}
elsif ( $command eq "iris_man" )
{
irisMan();
}
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();

689
scripts/zmcontrol-pelco-p.pl
View File

@ -1,689 +0,0 @@
#!/usr/bin/perl -wT
#
# ==========================================================================
#
# ZoneMinder Pelco-D 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-pelp"; # Tag that appears in debug to identify source
use constant DBG_LEVEL => 1; # 0 is errors, warnings and info only, > 0 for debug
# ==========================================================================
use ZoneMinder;
use Getopt::Long;
use Device::SerialPort;
use Time::HiRes qw( usleep );
$| = 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-pelco-d.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 $autostop;
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,
'autostop=f'=>\$autostop,
'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();
}
$address -= 1;
if ( defined($autostop) )
{
# Convert to microseconds.
$autostop = int(1000000*$autostop);
}
Debug( $arg_string."\n" );
srand( time() );
my $serial_port = new Device::SerialPort( $device );
$serial_port->baudrate(4800);
$serial_port->databits(8);
$serial_port->parity('none');
$serial_port->stopbits(1);
$serial_port->handshake('none');
$serial_port->read_const_time(50);
$serial_port->read_char_time(10);
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";
Debug( $msg_str );
}
sub sendCmd
{
my $cmd = shift;
my $ack = shift || 0;
my $result = undef;
my $checksum = 0x00;
for ( my $i = 0; $i < int(@$cmd); $i++ )
{
$checksum ^= $cmd->[$i];
}
$checksum &= 0xff;
push( @$cmd, $checksum );
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 )
{
Warning( "Response timeout\n" );
last;
}
}
}
}
my $stx = 0xa0;
my $etx = 0xaf;
sub remoteReset
{
Debug( "Remote Reset\n" );
my @msg = ( $stx, $address, 0x00, 0x0f, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub resetDefaults
{
Debug( "Reset Defaults\n" );
my @msg = ( $stx, $address, 0x00, 0x29, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub cameraOff
{
Debug( "Camera Off\n" );
my @msg = ( $stx, $address, 0x10, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub cameraOn
{
Debug( "Camera On\n" );
my @msg = ( $stx, $address, 0x40, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub autoScan
{
Debug( "Auto Scan\n" );
my @msg = ( $stx, $address, 0x90, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub manScan
{
Debug( "Manual Scan\n" );
my @msg = ( $stx, $address, 0x0b, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub stop
{
Debug( "Stop\n" );
my @msg = ( $stx, $address, 0x00, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub moveUp
{
Debug( "Move Up\n" );
my $speed = shift;
my @msg = ( $stx, $address, 0x00, 0x08, 0x00, $speed, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveDown
{
Debug( "Move Down\n" );
my $speed = shift;
my @msg = ( $stx, $address, 0x00, 0x10, 0x00, $speed, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveLeft
{
Debug( "Move Left\n" );
my $speed = shift;
my @msg = ( $stx, $address, 0x00, 0x04, $speed, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveRight
{
Debug( "Move Right\n" );
my $speed = shift;
my @msg = ( $stx, $address, 0x00, 0x02, $speed, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveUpLeft
{
Debug( "Move Up/Left\n" );
my $panspeed = shift;
my $tiltspeed = shift;
my @msg = ( $stx, $address, 0x00, 0x0c, $panspeed, $tiltspeed, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveUpRight
{
Debug( "Move Up/Right\n" );
my $panspeed = shift;
my $tiltspeed = shift;
my @msg = ( $stx, $address, 0x00, 0x0a, $panspeed, $tiltspeed, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveDownLeft
{
Debug( "Move Down/Left\n" );
my $panspeed = shift;
my $tiltspeed = shift;
my @msg = ( $stx, $address, 0x00, 0x14, $panspeed, $tiltspeed, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub moveDownRight
{
Debug( "Move Down/Right\n" );
my $panspeed = shift || 0x3f;
my $tiltspeed = shift || 0x3f;
my @msg = ( $stx, $address, 0x00, 0x12, $panspeed, $tiltspeed, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
stop();
}
}
sub flip180
{
Debug( "Flip 180\n" );
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x21, $etx );
sendCmd( \@msg );
}
sub zeroPan
{
Debug( "Zero Pan\n" );
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x22, $etx );
sendCmd( \@msg );
}
sub setZoomSpeed
{
my $speed = shift;
my @msg = ( $stx, $address, 0x00, 0x25, 0x00, $speed, $etx );
sendCmd( \@msg );
}
sub zoomStop
{
stop();
setZoomSpeed( 0 );
}
sub zoomTele
{
Debug( "Zoom Tele\n" );
my $speed = shift || 0x01;
setZoomSpeed( $speed );
usleep( 250000 );
my @msg = ( $stx, $address, 0x00, 0x20, 0x00, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
zoomStop();
}
}
sub zoomWide
{
Debug( "Zoom Wide\n" );
my $speed = shift || 0x01;
setZoomSpeed( $speed );
usleep( 250000 );
my @msg = ( $stx, $address, 0x00, 0x40, 0x00, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
zoomStop();
}
}
sub setFocusSpeed
{
my $speed = shift;
my @msg = ( $stx, $address, 0x00, 0x27, 0x00, $speed, $etx );
sendCmd( \@msg );
}
sub focusNear
{
Debug( "Focus Near\n" );
my $speed = shift || 0x03;
setFocusSpeed( $speed );
usleep( 250000 );
my @msg = ( $stx, $address, 0x01, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setFocusSpeed( 0 );
}
}
sub focusFar
{
Debug( "Focus Far\n" );
my $speed = shift || 0x03;
setFocusSpeed( $speed );
usleep( 250000 );
my @msg = ( $stx, $address, 0x00, 0x80, 0x00, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setFocusSpeed( 0 );
}
}
sub focusAuto
{
Debug( "Focus Auto\n" );
my @msg = ( $stx, $address, 0x00, 0x2b, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub focusMan
{
Debug( "Focus Man\n" );
my @msg = ( $stx, $address, 0x00, 0x2b, 0x00, 0x02, $etx );
sendCmd( \@msg );
}
sub irisClose
{
Debug( "Iris Close\n" );
my @msg = ( $stx, $address, 0x04, 0x00, 0x00, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setIrisSpeed( 0 );
}
}
sub irisOpen
{
Debug( "Iris Open\n" );
my @msg = ( $stx, $address, 0x02, 0x80, 0x00, 0x00, $etx );
sendCmd( \@msg );
if ( $autostop )
{
usleep( $autostop );
setIrisSpeed( 0 );
}
}
sub irisAuto
{
Debug( "Iris Auto\n" );
my @msg = ( $stx, $address, 0x00, 0x2d, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub irisMan
{
Debug( "Iris Man\n" );
my @msg = ( $stx, $address, 0x00, 0x2d, 0x00, 0x02, $etx );
sendCmd( \@msg );
}
sub writeScreen
{
my $string = shift;
Debug( "Writing '$string' to screen\n" );
my @chars = unpack( "C*", $string );
for ( my $i = 0; $i < length($string); $i++ )
{
#printf( "0x%02x\n", $chars[$i] );
my @msg = ( $stx, $address, 0x00, 0x15, $i, $chars[$i], $etx );
sendCmd( \@msg );
}
}
sub clearScreen
{
Debug( "Clear Screen\n" );
my @msg = ( $stx, $address, 0x00, 0x17, 0x00, 0x00, $etx );
sendCmd( \@msg );
}
sub clearPreset
{
my $preset = shift || 1;
Debug( "Clear Preset $preset\n" );
my @msg = ( $stx, $address, 0x00, 0x05, 0x00, $preset, $etx );
sendCmd( \@msg );
}
sub presetSet
{
my $preset = shift || 1;
Debug( "Set Preset $preset\n" );
my @msg = ( $stx, $address, 0x00, 0x03, 0x00, $preset, $etx );
sendCmd( \@msg );
}
sub presetGoto
{
my $preset = shift || 1;
Debug( "Goto Preset $preset\n" );
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, $preset, $etx );
sendCmd( \@msg );
}
sub presetHome
{
Debug( "Home Preset\n" );
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x22, $etx );
sendCmd( \@msg );
}
if ( $command eq "reset" )
{
remoteReset();
resetDefaults();
}
elsif ( $command eq "wake" )
{
cameraOn();
}
elsif ( $command eq "sleep" )
{
cameraOff();
}
elsif ( $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" )
{
moveDownRight( $panspeed, $tiltspeed );
}
elsif ( $command eq "move_stop" )
{
stop();
}
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" )
{
stop();
#setFocusSpeed( 0 );
}
elsif ( $command eq "focus_auto" )
{
focusAuto();
}
elsif ( $command eq "focus_man" )
{
focusMan();
}
elsif ( $command eq "iris_con_close" )
{
irisClose();
}
elsif ( $command eq "iris_con_open" )
{
irisOpen();
}
elsif ( $command eq "iris_stop" )
{
stop();
}
elsif ( $command eq "iris_auto" )
{
irisAuto();
}
elsif ( $command eq "iris_man" )
{
irisMan();
}
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();

620
scripts/zmcontrol-visca.pl
View File

@ -1,620 +0,0 @@
#!/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();