There are still so me improvements needed, however it works for relative movement, zoom and presets.
Credits and thanks to Normando Hall, as this script is derived from his work on the PT7135.
if you have any comments, improvements or questions, please let me know!
STefan
Code: Select all
# ==========================================================================
#
# This module contains the implementation of the Vivotek PZ7131 protocol
# Adapted from PT7135 module from Normando Hall nhall[AT]unixlan[DOT]com[DOT]ar !
# Thanks to him for his work. This module is published/changed with his agreement.
# Still work in progress not everything is working as it should (eg. Map).
# If you have any improvments, please let me know!
# STefan Mayer, stefan(at)clumsy(dot)ch
package ZoneMinder::Control::VivotekPZ7131;
use 5.006;
use strict;
use warnings;
require ZoneMinder::Base;
require ZoneMinder::Control;
our @ISA = qw(ZoneMinder::Control);
our $VERSION = $ZoneMinder::Base::VERSION;
# ==========================================================================
#
# Vivotek PZ7131 Control Protocol
#
# ==========================================================================
use ZoneMinder::Debug qw(:all);
use ZoneMinder::Config 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" );
Debug( "http://".$self->{Monitor}->{ControlAddress}."$cmd" );
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."$cmd" );
my $res = $self->{ua}->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "Error check failed: '".$res->status_line()."'" );
}
return( $result );
}
sub receiveCmd
{
my $self = shift;
my $cmd = shift;
my $result = undef;
#printMsg( $cmd, "Rx" );
DEBUG( "http://".$self->{Monitor}->{ControlAddress}."$cmd" );
my $req = HTTP::Request->new( GET=>"http://".$self->{Monitor}->{ControlAddress}."$cmd" );
my $res = $self->{ua}->request($req);
my $content = $res->content();
if ( $res->is_success )
{
$result = $content;
}
else
{
Error( "Error check failed: '".$res->status_line()."'" );
}
return( $result );
}
sub reset
{
my $self = shift;
Debug( "Camera Reset" );
my $cmd = "/cgi-bin/admin/setparam.cgi?reset=3";
$self->sendCmd( $cmd );
}
# moveMap does not yet work!! Mapping from x/y coordinates to absolute coordinates of cam is not yet done
# also it's not clear on how to get the actual position of the cam.
sub moveMap
{
my $self = shift;
my $params = shift;
my $xcoord = $self->getParam( $params, 'xcoord' );
my $ycoord = $self->getParam( $params, 'ycoord' );
my $imagewidth = $self->{Monitor}->{Width};
my $imageheight = $self->{Monitor}->{Height};
Debug( "Move Map to $xcoord,$ycoord at $imagewidth/$imageheight" );
# if ( $imagewidth == "640" )
# {
# $xcoord = $xcoord/2;t
# $ycoord = $ycoord/2;
# }
# my $cmd = "/cgi-bin/admin/setparam.cgi?whitebalance=auto";
#Debug( "Delete temp position" );
#my $cmd = "/cgi-bin/operator/preset.cgi?delpos='goto_tmp'";
#$self->sendCmd( $cmd );
my $cmd = "/cgi-bin/admin/setparam.cgi?camctrl_c0_preset_i19_name=goto_tmp&camctrl_c0_preset_i19_pan=$xcoord&camctrl_c0_preset_i19_tilt=$ycoord";
$self->sendCmd( $cmd );
Debug( "Recall stored temp position" );
$cmd = "/cgi-bin/camctrl/recall.cgi?recall=goto_tmp";
$self->sendCmd( $cmd );
# Debug( "Delete Preset temp position" );
# $cmd = "/cgi-bin/operator/preset.cgi?delpos='goto_tmp'";
# $self->sendCmd( $cmd );
}
sub moveRelUp
{
my $self = shift;
my $params = shift;
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
Debug( "Move Up - Speed $tiltspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedtilt=$tiltspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=up";
$self->sendCmd( $cmd );
}
sub moveRelDown
{
my $self = shift;
my $params = shift;
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
Debug( "Move Down - Speed $tiltspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedtilt=$tiltspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=down";
$self->sendCmd( $cmd );
}
sub moveRelLeft
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed' );
Debug( "Move Left - Speed $panspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedpan=$panspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=left";
$self->sendCmd( $cmd );
}
sub moveRelRight
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed' );
Debug( "Move Right - Speed $panspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedpan=$panspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=right";
$self->sendCmd( $cmd );
}
sub moveRelUpRight
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed' );
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
Debug( "Move Up/Right - Speed $tiltspeed/$panspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedtilt=$tiltspeed&speedpan=$panspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=up";
$self->sendCmd( $cmd );
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=right";
$self->sendCmd( $cmd );
}
sub moveRelUpLeft
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed' );
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
Debug( "Step Up/Left - Speed $tiltspeed/$panspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedtilt=$tiltspeed&speedpan=$panspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=up";
$self->sendCmd( $cmd );
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=left";
$self->sendCmd( $cmd );
}
sub moveRelDownRight
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed' );
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
Debug( "Step Down/Right - Speed $tiltspeed/$panspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedtilt=$tiltspeed&speedpan=$panspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=down";
$self->sendCmd( $cmd );
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=right";
$self->sendCmd( $cmd );
}
sub moveRelDownLeft
{
my $self = shift;
my $params = shift;
my $panspeed = $self->getParam( $params, 'panspeed' );
my $tiltspeed = $self->getParam( $params, 'tiltspeed' );
Debug( "Step Down/Left - Speed $tiltspeed/$panspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedtilt=$tiltspeed&speedpan=$panspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=down";
$self->sendCmd( $cmd );
$cmd = "/cgi-bin/viewer/camctrl.cgi?move=left";
$self->sendCmd( $cmd );
}
# sub whiteAuto
# {
# my $self = shift;
# Debug( "White Auto" );
# my $cmd = "/cgi-bin/admin/setparam.cgi?whitebalance=auto";
# $self->sendCmd( $cmd );
# }
# sub whiteMan
# {
# my $self = shift;
# Debug( "White Man" );
# my $cmd = "/cgi-bin/admin/setparam.cgi?whitebalance=2";
# $self->sendCmd( $cmd );
# }
# sub In
# {
# my $self = shift;
# Debug( "White In" );
# my $cmd = "/cgi-bin/admin/setparam.cgi?whitebalance=1";
# $self->sendCmd( $cmd );
# }
# sub Out
# {
# my $self = shift;
# Debug( "White Out" );
# my $cmd = "/cgi-bin/admin/setparam.cgi?whitebalance=3";
# $self->sendCmd( $cmd );
# }
sub zoomRelTele
{
my $self = shift;
my $params = shift;
my $zoomspeed = $self->getParam( $params, 'speed' );
Debug( "Zoom Tele $zoomspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedzoom=$zoomspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?zoom=tele";
$self->sendCmd( $cmd );
}
sub zoomRelWide
{
my $self = shift;
my $params = shift;
my $zoomspeed = $self->getParam( $params, 'speed' );
Debug( "Zoom Wide $zoomspeed" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?speedzoom=$zoomspeed";
$self->sendCmd( $cmd );
sleep(2);
$cmd = "/cgi-bin/viewer/camctrl.cgi?zoom=wide";
$self->sendCmd( $cmd );
}
sub presetClear
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
$preset = ( $preset - 1 );
Debug( "Clear Preset $preset" );
my $cmd = "/cgi-bin/operator/preset.cgi?delpos=$preset";
$self->sendCmd( $cmd );
}
sub presetSet
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
$preset = ( $preset - 1 );
#my $cmd = "/cgi-bin/admin/getparam.cgi?axisx";
#my $rx = $self->receiveCmd( $cmd );
#my ($axisx) = $rx =~ /([-0-9]+)/;
#$cmd = "/cgi-bin/admin/getparam.cgi?axisy";
#$rx = $self->receiveCmd( $cmd );
#my ($axisy) = $rx =~ /([-0-9]+)/;
Debug( "Delete Preset $preset at current position" );
my $cmd = "/cgi-bin/operator/preset.cgi?delpos=$preset";
$self->sendCmd( $cmd );
Debug( "Set Preset $preset at current position" );
$cmd = "/cgi-bin/operator/preset.cgi?addpos=$preset";
$self->sendCmd( $cmd );
}
sub presetGoto
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
$preset = ( $preset - 1 );
Debug( "Goto Preset $preset" );
my $cmd = "/cgi-bin/camctrl/recall.cgi?recall=$preset";
$self->sendCmd( $cmd );
}
sub presetHome
{
my $self = shift;
Debug( "Home Preset" );
my $cmd = "/cgi-bin/viewer/camctrl.cgi?move=home";
$self->sendCmd( $cmd );
}
1;
__END__