mirror of
https://github.com/ZoneMinder/zoneminder.git
synced 2026-03-11 10:26:43 -04:00
Bug 71 - Add Pelco-P PTZ protocol support.
git-svn-id: http://svn.zoneminder.com/svn/zm/trunk@1430 e3e1d417-86f3-4887-817a-d78f3d33393f
This commit is contained in:
stan
@@ -16,6 +16,10 @@ alter table Stats modify column MaxBlobSize int(10) unsigned NOT NULL default '0
|
||||
alter table Zones modify column MinBlobPixels int(10) unsigned default NULL;
|
||||
alter table Zones modify column MaxBlobPixels int(10) unsigned default NULL;
|
||||
--
|
||||
-- Add in extra PTZ protocol
|
||||
--
|
||||
insert into Controls values (0,'pelco-p','Local','/usr/local/bin/zmcontrol-pelco-p.pl',1,1,0,1,1,0,0,1,NULL,NULL,NULL,NULL,1,0,3,1,1,0,0,1,NULL,NULL,NULL,NULL,0,NULL,NULL,1,1,0,1,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,1,0,1,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,20,1,1,1,1,0,0,0,1,1,NULL,NULL,NULL,NULL,1,0,63,1,254,1,NULL,NULL,NULL,NULL,1,0,63,1,254,0,0);
|
||||
--
|
||||
-- These are optional, but we might as well do it now
|
||||
--
|
||||
optimize table Frames;
|
||||
|
||||
@@ -389,4 +389,4 @@ insert into Controls values (1,'pelco-d','Local','/usr/local/bin/zmcontrol-pelco
|
||||
insert into Controls values (2,'visca','Local','/usr/local/bin/zmcontrol-visca.pl',1,1,0,1,0,0,0,1,0,16384,10,4000,1,1,6,1,1,1,0,1,0,1536,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,3,1,1,1,1,0,1,1,0,1,-15578,15578,100,10000,1,1,50,1,254,1,-7789,7789,100,5000,1,1,50,1,254,0,0);
|
||||
insert into Controls values (3,'KX-HCM10','Remote','/usr/local/bin/zmcontrol-kx-hcm10.pl',0,0,0,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,8,1,1,1,0,1,0,0,1,1,NULL,NULL,NULL,NULL,0,NULL,NULL,0,NULL,1,NULL,NULL,NULL,NULL,0,NULL,NULL,0,NULL,0,0);
|
||||
insert into Controls values (4,'pelco-d-full','Local','/usr/local/bin/zmcontrol-pelco-d.pl',1,1,0,1,1,0,0,1,NULL,NULL,NULL,NULL,1,0,3,1,1,0,0,1,NULL,NULL,NULL,NULL,0,NULL,NULL,1,1,0,1,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,1,0,1,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,20,1,1,1,1,0,0,0,1,1,NULL,NULL,NULL,NULL,1,0,63,1,254,1,NULL,NULL,NULL,NULL,1,0,63,1,254,0,0);
|
||||
|
||||
insert into Controls values (5,'pelco-p','Local','/usr/local/bin/zmcontrol-pelco-p.pl',1,1,0,1,1,0,0,1,NULL,NULL,NULL,NULL,1,0,3,1,1,0,0,1,NULL,NULL,NULL,NULL,0,NULL,NULL,1,1,0,1,0,NULL,NULL,NULL,NULL,0,NULL,NULL,0,0,0,0,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,1,0,1,0,NULL,NULL,NULL,NULL,0,NULL,NULL,1,20,1,1,1,1,0,0,0,1,1,NULL,NULL,NULL,NULL,1,0,63,1,254,1,NULL,NULL,NULL,NULL,1,0,63,1,254,0,0);
|
||||
|
||||
@@ -11,6 +11,7 @@ bin_SCRIPTS = \
|
||||
zmupdate.pl \
|
||||
zmvideo.pl \
|
||||
zmcontrol-pelco-d.pl \
|
||||
zmcontrol-pelco-p.pl \
|
||||
zmcontrol-visca.pl \
|
||||
zmcontrol-kx-hcm10.pl \
|
||||
zmtrack.pl
|
||||
@@ -26,6 +27,7 @@ EXTRA_DIST = \
|
||||
zmupdate.pl.z \
|
||||
zmvideo.pl.z \
|
||||
zmcontrol-pelco-d.pl.z \
|
||||
zmcontrol-pelco-p.pl.z \
|
||||
zmcontrol-visca.pl.z \
|
||||
zmcontrol-kx-hcm10.pl.z \
|
||||
zmtrack.pl.z \
|
||||
|
||||
637
scripts/zmcontrol-pelco-p.pl.z
Normal file
637
scripts/zmcontrol-pelco-p.pl.z
Normal file
@@ -0,0 +1,637 @@
|
||||
#, $etx!/usr/bin/perl -wT
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder Pelco-P Control Script, $Date$, $Revision$
|
||||
# Copyright (C) 2003, 2004, 2005 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 need to edit to suit your installation
|
||||
#
|
||||
# ==========================================================================
|
||||
use constant ZM_CONFIG => "<from zmconfig>";
|
||||
use constant ZM_PATH_BIN => "<from zmconfig>";
|
||||
|
||||
# Load the config from the database into the symbol table
|
||||
BEGIN
|
||||
{
|
||||
no strict 'refs';
|
||||
|
||||
open( CONFIG, "<".ZM_CONFIG ) or die( "Can't open config file: $!" );
|
||||
foreach my $str ( <CONFIG> )
|
||||
{
|
||||
next if ( $str =~ /^\s*$/ );
|
||||
next if ( $str =~ /^\s*#/ );
|
||||
my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*([^=\s]+)\s*$/;
|
||||
$name =~ tr/a-z/A-Z/;
|
||||
if (( $name eq 'ZM_DB_SERVER' ) ||
|
||||
( $name eq 'ZM_DB_NAME' ) ||
|
||||
( $name eq 'ZM_DB_USER' ) ||
|
||||
( $name eq 'ZM_DB_PASS' ))
|
||||
{
|
||||
*{$name} = sub { $value };
|
||||
}
|
||||
}
|
||||
close( CONFIG );
|
||||
|
||||
use DBI;
|
||||
my $dbh = DBI->connect( "DBI:mysql:database=".&ZM_DB_NAME.";host=".&ZM_DB_SERVER, &ZM_DB_USER, &ZM_DB_PASS );
|
||||
my $sql = "select * from Config";
|
||||
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
||||
my $res = $sth->execute() or die( "Can't execute '$sql': ".$sth->errstr() );
|
||||
while( my $config = $sth->fetchrow_hashref() )
|
||||
{
|
||||
*{$config->{Name}} = sub { $config->{Value} };
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->disconnect();
|
||||
}
|
||||
|
||||
use Getopt::Long;
|
||||
use Device::SerialPort;
|
||||
use Time::HiRes qw( usleep );
|
||||
|
||||
use constant LOG_FILE => ZM_PATH_LOGS.'/zmcontrol-pelco-p.log';
|
||||
|
||||
$| = 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 );
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
my $log_file = LOG_FILE;
|
||||
open( LOG, ">>$log_file" ) or die( "Can't open log file: $!" );
|
||||
open( STDOUT, ">&LOG" ) || die( "Can't dup stdout: $!" );
|
||||
select( STDOUT ); $| = 1;
|
||||
open( STDERR, ">&LOG" ) || die( "Can't dup stderr: $!" );
|
||||
select( STDERR ); $| = 1;
|
||||
select( LOG ); $| = 1;
|
||||
|
||||
print( $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);
|
||||
|
||||
print( $prefix );
|
||||
for ( my $i = 0; $i < $msg_len; $i++ )
|
||||
{
|
||||
if ( ($i > 0) && ($i%$line_length == 0) && ($i != ($msg_len-1)) )
|
||||
{
|
||||
printf( "\n%*s", length($prefix), "" );
|
||||
}
|
||||
printf( "%02x ", $msg->[$i] );
|
||||
}
|
||||
print( "[".$msg_len."]\n" );
|
||||
}
|
||||
|
||||
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 )
|
||||
{
|
||||
print( "Error, write failed: $!" );
|
||||
}
|
||||
if ( $n_bytes != length($tx_msg) )
|
||||
{
|
||||
print( "Error, incomplete write, only ".$n_bytes." of ".length($tx_msg)." written: $!" );
|
||||
}
|
||||
|
||||
if ( $ack )
|
||||
{
|
||||
print( "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;
|
||||
print( "Got ack for socket $socket\n" );
|
||||
$result = !undef;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got bogus response\n" );
|
||||
}
|
||||
last;
|
||||
}
|
||||
else
|
||||
{
|
||||
print( "Error, got message for camera ".(($resp[0]-0x80)>>4)."\n" );
|
||||
}
|
||||
}
|
||||
if ( (time() - $now) > $max_wait )
|
||||
{
|
||||
print( "Warning, response timeout\n" );
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $stx = 0xa0;
|
||||
my $etx = 0xaf;
|
||||
|
||||
sub cameraOff
|
||||
{
|
||||
print( "Camera Off\n" );
|
||||
my @msg = ( $stx, $address, 0x10, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub cameraOn
|
||||
{
|
||||
print( "Camera On\n" );
|
||||
my @msg = ( $stx, $address, 0x40, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub autoScan
|
||||
{
|
||||
print( "Auto Scan\n" );
|
||||
my @msg = ( $stx, $address, 0x90, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub manScan
|
||||
{
|
||||
print( "Manual Scan\n" );
|
||||
my @msg = ( $stx, $address, 0x10, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub stop
|
||||
{
|
||||
print( "Stop\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub moveUp
|
||||
{
|
||||
print( "Move Up\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x08, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDown
|
||||
{
|
||||
print( "Move Down\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x10, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveLeft
|
||||
{
|
||||
print( "Move Left\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x04, $speed, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveRight
|
||||
{
|
||||
print( "Move Right\n" );
|
||||
my $speed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x02, $speed, 0x00 , $etx);
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpLeft
|
||||
{
|
||||
print( "Move Up/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x0c, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveUpRight
|
||||
{
|
||||
print( "Move Up/Right\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x0a, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownLeft
|
||||
{
|
||||
print( "Move Down/Left\n" );
|
||||
my $panspeed = shift || 0x3f;
|
||||
my $tiltspeed = shift || 0x3f;
|
||||
my @msg = ( $stx, $address, 0x00, 0x14, $panspeed, $tiltspeed, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
stop();
|
||||
}
|
||||
}
|
||||
|
||||
sub moveDownRight
|
||||
{
|
||||
print( "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
|
||||
{
|
||||
print( "Flip 180\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x21, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub zeroPan
|
||||
{
|
||||
print( "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 zoomTele
|
||||
{
|
||||
print( "Zoom Tele\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x00, 0x20, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub zoomWide
|
||||
{
|
||||
print( "Zoom Wide\n" );
|
||||
my $speed = shift || 0x01;
|
||||
setZoomSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x00, 0x40, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub setFocusSpeed
|
||||
{
|
||||
my $speed = shift;
|
||||
my @msg = ( $stx, $address, 0x00, 0x27, 0x00, $speed, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusNear
|
||||
{
|
||||
print( "Focus Near\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x02, 0x00, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusFar
|
||||
{
|
||||
print( "Focus Far\n" );
|
||||
my $speed = shift || 0x03;
|
||||
setFocusSpeed( $speed );
|
||||
my @msg = ( $stx, $address, 0x01, 0x80, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
if ( $autostop )
|
||||
{
|
||||
usleep( $autostop );
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
}
|
||||
|
||||
sub focusAuto
|
||||
{
|
||||
print( "Focus Auto\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x2b, 0x00, 0x01, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub focusMan
|
||||
{
|
||||
print( "Focus Man\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x2b, 0x00, 0x02, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub writeScreen
|
||||
{
|
||||
my $string = shift;
|
||||
print( "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
|
||||
{
|
||||
print( "Clear Screen\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x17, 0x00, 0x00, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub clearPreset
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Clear Preset $preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x05, 0x00, $preset, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetSet
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Set Preset $preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x03, 0x00, $preset, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetGoto
|
||||
{
|
||||
my $preset = shift || 1;
|
||||
print( "Goto Preset $preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, $preset, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
sub presetHome
|
||||
{
|
||||
print( "Home Preset\n" );
|
||||
my @msg = ( $stx, $address, 0x00, 0x07, 0x00, 0x22, $etx );
|
||||
sendCmd( \@msg );
|
||||
}
|
||||
|
||||
if ( $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" )
|
||||
{
|
||||
setZoomSpeed( 0 );
|
||||
}
|
||||
elsif ( $command eq "focus_con_near" )
|
||||
{
|
||||
focusNear();
|
||||
}
|
||||
elsif ( $command eq "focus_con_far" )
|
||||
{
|
||||
focusFar();
|
||||
}
|
||||
elsif ( $command eq "focus_stop" )
|
||||
{
|
||||
setFocusSpeed( 0 );
|
||||
}
|
||||
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
|
||||
{
|
||||
print( "Error, can't handle command $command\n" );
|
||||
}
|
||||
|
||||
$serial_port->close();
|
||||
@@ -1769,7 +1769,7 @@ if ( $reprocess )
|
||||
printf( CFG_HDR_FILE $assign_list."\n\n" );
|
||||
close( CFG_HDR_FILE );
|
||||
|
||||
my @config_files = qw( zm.conf src/zm_config.h web/zm_config.php scripts/zmdc.pl scripts/zmwatch.pl scripts/zmaudit.pl scripts/zmfilter.pl scripts/zmtrigger.pl scripts/zmx10.pl scripts/zmpkg.pl scripts/zmupdate.pl scripts/zmvideo.pl scripts/zmcontrol-pelco-d.pl scripts/zmcontrol-visca.pl scripts/zmcontrol-kx-hcm10.pl scripts/zmtrack.pl scripts/zm db/zmschema.sql );
|
||||
my @config_files = qw( zm.conf src/zm_config.h web/zm_config.php scripts/zmdc.pl scripts/zmwatch.pl scripts/zmaudit.pl scripts/zmfilter.pl scripts/zmtrigger.pl scripts/zmx10.pl scripts/zmpkg.pl scripts/zmupdate.pl scripts/zmvideo.pl scripts/zmcontrol-pelco-d.pl scripts/zmcontrol-pelco-p.pl scripts/zmcontrol-visca.pl scripts/zmcontrol-kx-hcm10.pl scripts/zmtrack.pl scripts/zm db/zmschema.sql );
|
||||
|
||||
foreach my $config_file ( @config_files )
|
||||
{
|
||||
|
||||
Reference in New Issue
Block a user