#============================================================
# GPIBDeviceObject
#============================================================
package GPIBDeviceObject;
use Exporter;
use GPIB;
@ISA = qw(Exporter GPIB);

#公開したいサブルーチン
@EXPORT = qw();

use strict;
use Deps;

#============================================================
#　コンストラクタ、デストラクタ
#============================================================
BEGIN { }

sub new
{
	my ($module, $interface, $devname, $timeout, $EOT, $EOS) = @_;
	$interface = 'ni' if($interface eq '');
	$timeout = ::GPIB->T1s if(!defined $timeout);
	$EOT = 1 if(!defined $EOT);
	$EOS = 1 if(!defined $EOS);

	my $this = {};
	bless $this;
	my ($name, $addr) = ($devname =~ /(\w+):(\d+)/);
	if(defined $addr) {
		$this->Open($interface, 0, $name, $addr, 0, $timeout, $EOT, $EOS);
	}
	return $this;
}

sub DESTROY
{
	my $this = shift;
}

#============================================================
#　変数取得関数
#============================================================
sub SetGPIB        { my ($this,$g)=@_; return $this->{GPIB} = $g; };
sub g              { return shift->{GPIB}; };
sub SetDeviceName  { my ($this,$name)=@_; return $this->{DeviceName} = $name; };
sub DeviceName     { return shift->{DeviceName}; };
sub SetGPIBAddress { my ($this,$addr)=@_; return $this->{GPIBAddress} = $addr; };
sub GPIBAddress    { return shift->{GPIBAddress}; };

#============================================================
#　一般関数
#============================================================
sub Open {
	my ($this, $interface, $board, $name, $addr, $subaddr, $timeout, $EOT, $EOS) = @_;
	my $g = GPIB->new("GPIB::$interface", $board, $addr, $subaddr, $timeout, $EOT, $EOS);
	return 0 if(!defined $g);
	$this->SetGPIB($g);
	$this->SetDeviceName($name);
	$this->SetGPIBAddress($addr);
	return $g;
}

sub print {
	my ($this, @a) = @_;
	my $line = '';
	for(my $i = 0 ; $i < @a ; $i++) {
		$line .= $a[$i];
	}
	return $this->g()->ibwrt($line);
}

sub read {
	my ($this, $bufferlength) = @_;
	$bufferlength = 1024 if(!defined $bufferlength);
	my $response = $this->g()->ibrd($bufferlength);
	chomp $response;
	return $response;
}

sub GetSCPIData {
	my ($this, $command) = @_;
	$this->print($command);
	return $this->read();
}

sub Clear { shift->print("*CLS"); }
sub Reset { shift->print("*RST"); }
sub GetIdentification { return shift->GetSCPIData("*IDN?"); }
sub FetchData         { return shift->print(":FETCH?"); }
sub ReadData          { return shift->print(":READ?"); }

sub InitDVM {
	my ($this) = @_;
	$this->print("*RST");
	$this->print("*CLS");
	$this->print(":conf:volt:dc");
	$this->print(":sens:volt:dc:dig 7");
	$this->print(":sens:volt:dc:aper 0.1");
	$this->print(":voltage:dc:average:count 100");
	$this->print(":SYSTEM:ZCHECK 0");
}
sub SetZeroCheckDVM
{
	my ($this, $mode) = @_;
	if($mode or uc $mode eq 'ON') {
		$mode = 1;
	}
	else {
		$mode = 0;
	}
	$this->print(":SYSTEM:ZCHECK $mode");
}

sub SetZeroCheckDCM
{
	my ($this) = @_;
	$this->SetZeroCheckDVM()
}

sub InitSource { }
sub ApplySource {
	my ($this, $mode) = @_;
	if($mode or uc $mode eq 'ON') {
		$mode = "ON";
	}
	else {
		$mode = "OFF";
	}
	return $this->print(":OUTP:STAT $mode");
}
sub StopSource { return shift->ApplySource(0); }
sub SetSource {
	my ($this, $val) = @_;
	return $this->print(":SOUR:VOLT $val");
}
1;