#!/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 can edit to suit your installation # # ========================================================================== # None # ========================================================================== use ZoneMinder; #use Data::Dumper; 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 "); 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; #print( Dumper( @$cmd ) ); my $checksum = 0x00; for ( my $i = 0; $i < int(@$cmd)-1; $i++ ) { $checksum ^= $cmd->[$i]; $checksum &= 0xff; #printf( "%02x - %02x\n", $cmd->[$i], $checksum ); } 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();