package RFC::Keithley2400;
##################################################################################
#
#      RFC::Keithley2400
#
# RFC::Keithley2400 mpelments the RFC::PSU class for Keithley400 source meters.
#
# To obtain an instance of RFC::Keithley2400 use the constructor:
#
# $id = RFC::Keithley2400->new($name,$rig);
#
# The class defines the following new member functions:
#
# $id->PSU_mode([$])   Sets or gets wether the PSU is a constant current source (default) or
#                      a constant voltage source.
#                      Argument: 'CC' for constant current and 'CV' vor constant voltage.
#                      Note that it may be nescesarry to run reset() on the device after changing
#                      the PSU_mode
# $id->reset()         Resets the keithley2400 to a known state.
#
# As a Keithley2400 source meter is a true bipolar power supply, it is
# usually convenient to use a RFC::PSU_B2N device on top of the RFC::Keintley2400 device
#
# Additionally in order to confirm with the basic operation of RFCcontrol, the positive
# current direction is when the device under test is acting as a fuel cell (that is a positive
# current acts as a current sink), therefore the current direction is reversed so specifying a
# positive current actually sets a negative output!
#
##################################################################################

use strict;
use warnings;
use RFC::Header;
use RFC::BaseDevice;
use RFC::Cache;
use RFC::Typecast;
use RFC::PSU;
our @ISA = qw(RFC::PSU);


sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_setup_tags'} = ['mode','communication','address','PSU_mode','external_RSD','RSD_name','control_mode','master_device','slave_current','slave_voltage','show_plot'];
    $self->{'_setup_tags_readonly'} = [];
    $self->{'_type'} = 'keithley2400';
    $self->{'_mode'} = 'Automatic';
    $self->{'_default'}{'mode'} = 'Normal';
    $self->{'_default'}{'communication'} = 'GPIB 488.1';
    $self->{'_default'}{'PSU_mode'} = 'CC';
    $self->{'_desc'}{'PSU_mode'} = 'Mode of operation (determines if the device should act as a constant current source or a constant voltage source)';
    $self->{'_desc'}{'communication'} = 'Device connunication';
    $self->{'_desc'}{'mode'} = "Device control mode. If set to 'hidden' it will not show up as a controlable device in the GUI.\nHowever it will still be avaliable through other devices such as PSU_B2N";
    $self->{'_idn'} = undef;
    $self->{'_PSU_mode'} = 'CC';
    $self->{'_parallel'} = 1;
    $self->{'_serial'} = 1;
    $self->{'_default'}{'address'} = 1;
    $self->{'_maxI'} = 1.05;
    $self->{'_maxU'} = 210;
    $self->{'_minI'} = -1.05;
    $self->{'_minU'} = -210;
    $self->{'_values_communication'} = ['GPIB 488.1'];
    $self->{'_values_PSU_mode'} = ['CC','CV'];
    $self->{'_values_mode'} = ['Normal','hidden'];
    $self->{'_read_names'} = ['read','measure_I','measure_I_mA','measure_U','measure_U_mV','get_I','get_U'];
    $self->load_conf();
    bless $self,$class;
    #### explicitly initialise 2 typecast devices to simplechannel for integeration     ###
    #### to normal RFCcontrol if control                                                ###
    my $voltdev = RFC::TypecastDefault->new($name.'_voltage_mv',$rig,$self,'simplechannel','measure_U_mV');
    my $currdev = RFC::TypecastDefault->new($name.'_current',$rig,$self,'simplechannel','measure_I');
    $self->{'_ui_fn_names'} = ['reset'];
    $self->{'_ui_fn_desc'} = {
        'reset' => 'Resets the device to default state depending on PSU_mode.',
    };
    $self->{'_readonly'} = 1 if ($self->{'_mode'} eq 'hidden');
    $self->{'_info_string'} = 'Keithley-2400 is a true bipolar PSU and thus wil only work corectly with RFCcontrol automatic i-V curve system if encapsulated by a PSU_B2N device';
    return $self;
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    return $self->{'_communication'} if ($tag eq 'communication');
    return undef;
}

sub measure_U_mV
{
    my $self = shift;
    return $self->measure_U(@_) * 1000;
}

sub measure_I_mA
{
    my $self = shift;
    return $self->measure_I(@_) * 1000;
}

sub PSU_mode
{
    my $self = shift;
    if (@_)
    {
	my $mode = shift;
	if ($mode eq 'CV')
	{
	    $self->{'_PSU_mode'} = 'CV';
	}
	else
	{
	    $self->{'_PSU_mode'} = 'CC';
	}
    }
    return $self->{'_PSU_mode'};
}

sub reset()
{
    my $self = shift;
    $self->writecmd('*rst');
    if ($self->{'_PSU_mode'} eq 'CV')
    {
	$self->writecmd(':sour:func volt');
#	$self->writecmd(':sour:volt:mode fixed');
	$self->writecmd(':sour:volt:lev 0');
#	$self->writecmd(':sens:func "curr"');
#	$self->writecmd(':sens:curr:rang "auto"');	
	$self->writecmd(':sens:curr:prot 1');
	$self->writecmd(':sens:volt:prot 10');
    }
    else
    {
	$self->writecmd(':sour:func curr');
#	$self->writecmd(':sour:curr:mode fixed');
	$self->writecmd(':sour:curr:lev 0');
#	$self->writecmd(':sens:func "volt"');
#	$self->writecmd(':sens:volt:rang "auto"');
	$self->writecmd(':sens:volt:prot 10');
	$self->writecmd(':sens:curr:prot 1');
    }
    $self->writecmd(':outp on');
    return $self->idn();
}

sub read_named
{
    my $self = shift;
    my $name = shift;
    return $self->measure_U(@_) if ($name && $name eq 'measure_U');
    return $self->measure_U_mV(@_) if ($name && $name eq 'measure_U_mV');
    return $self->measure_I(@_) if ($name && $name eq 'measure_I');
    return $self->measure_I_mA(@_) if ($name && $name eq 'measure_I_mA');
    return $self->get_U(@_) if ($name && $name eq 'get_U');
    return $self->get_I(@_) if ($name && $name eq 'get_I');
    return $self->read();
}

sub writecmd
{
    my $self = shift;
    my $cmd = shift;
    $self->writedebug("Sending to Keithley2400 the command :'$cmd'");
    return SocketClient::GPIB_client('w',$self->{'_address'},$cmd);
}

sub readmcd
{
    my $self = shift;
    $self->writedebug("Reading from Keithley2400");
    my $res = SocketClient::GPIB_client('r',$self->{'_address'});
    $self->writedebug("Result: '$res'");
    return $res;
}

sub comm
{
    my $self = shift;
    my $cmd = shift;
    $self->writedebug("Quering Keithley2400 with command :'$cmd'");
    my $res = SocketClient::GPIB_client('c',$self->{'_address'},$cmd);
    $self->writedebug("Result: '$res'");
    return $res;
}

sub test
{
    my $self = shift;
    my $res = $self->comm('*idn?');
    return 1 if ($res =~ /KEITHLEY/i);
}

sub test_string()
{
    my $self = shift;
    my $string = $self->comm('*idn?');
    $string .= "\nCurrent: ".$self->measure_I();
    $string .= "\nVoltage: ".$self->measure_U();
    $string .= "\n".$self->{'_RSD_device'}->test_string(@_) if ($self->{'_RSD_device'});
    return $string;
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'PSU type: '.$self->type;
    push @arr,'Address: '.$self->{'_address'};
    if ($self->{'_RSD_device'})
    {
        push @arr,$self->{'_RSD_device'}->print_config;
    }
    return join (', ',@arr);
}

sub current()
{
    my $self = shift;
    if (@_)
    {
        $self->{'_I'} = 'ocv';
        my $c = shift;
        if ($c =~ /([\d\.\-\+\eE]+)/)
        {
            $self->{'_I'} = $1+0;
            $self->{'_I'} = $self->{'_minI'} if ($self->{'_I'} < $self->{'_minI'});
            $self->{'_I'} = $self->{'_maxI'} if ($self->{'_I'} > $self->{'_maxI'});
        }
        if ($self->{'_I'} =~ /ocv/i)
        {
            $self->writedebug('Setting current to OCV') if ($self->debug > 1);
            $self->RSD(0);
	    $self->{'_I'} = 0;
        }
        else
        {
            $self->writedebug('Setting current to '.$self->{'_I'}.' A') if ($self->debug > 1);
            $self->RSD(1);
        }
        my $res = $self->send_current;
        if ($self->{'_I'} =~ /ocv/i)
        {
	    $self->writecmd(':outp off');
	}
	else
	{
	    $self->writecmd(':outp on');
	}
        $self->proglog("Current for PSU ".$self->name." set to ".$self->{'_I'}." A",@_);
        $self->notify('current',$c,@_);
        return $res;
    }
    else
    {
        return $self->get_I();
    }
}


sub voltage()
{
    my $self = shift;
    if (@_)
    {
        $self->{'_U'} = 'ocv';
        my $c = shift;
        if ($c =~ /([\d\.\-\+eE]+)/)
        {
            $self->{'_U'} = $1+0;
            $self->{'_U'} = $self->{'_minU'} if ($self->{'_U'} < $self->{'_minU'});
            $self->{'_U'} = $self->{'_maxU'} if ($self->{'_U'} > $self->{'_maxU'});
        }
        if ($self->{'_U'} =~ /ocv/i)
        {
            $self->writedebug('Setting voltage to OCV') if ($self->debug > 1);
            $self->RSD(0);
	    $self->{'_U'} = 0;
        }
        else
        {
            $self->writedebug('Setting voltage to '.$self->{'_U'}.' V') if ($self->debug > 1);
            $self->RSD(1);
        }
        my $res = $self->send_voltage;
        if ($self->{'_U'} =~ /ocv/i)
        {
	    $self->writecmd(':outp off');
	}
	else
	{
	    $self->writecmd(':outp on');
	}
        $self->proglog("Voltage for PSU ".$self->name." set to ".$self->{'_U'}." V",@_);
        $self->notify('voltage',$c,@_);
        return $res;
    }
    else
    {
        return $self->get_U();
    }
}

sub read()
{
    my $self = shift;
    return $self->measure_I(@_);
}

sub readstring
{
    my $self = shift;
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name.'_current',$t,time,$self->measure_I($data),$self->name.'_voltage',$t,time,$self->measure_U($data));
    $self->writedebug($res) if ($self->debug > 1);
    return $res;
}


sub measure_U()
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my $cached = $data->get('gpib',$self->{'_address'},'U');
    return $cached if (defined($cached));
    my $mode = $self->comm(':OUTP?');
    chomp $mode if (defined($mode));
    if ($mode)
    {
	my $mrep = $self->comm(':MEAS:VOLT?');
	if ($mrep)
	{
	    my  @list = split(',',$mrep);
	    $data->set('gpib',$self->{'_address'},'U',$list[0]+0);
	    return $list[0]+0;
	}
    }
    else
    {
	$data->set('gpib',$self->{'_address'},'U',-32768);
        return -32768;  
    }
}


sub measure_I()
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my $cached = $data->get('gpib',$self->{'_address'},'I');
    return $cached if (defined($cached));
    my $mode = $self->comm(':OUTP?');
    chomp $mode if (defined($mode));
    if ($mode)
    {
	my $mrep = $self->comm(':MEAS:CURR?');
	if ($mrep)
	{
	    my @list = split(',',$mrep);
	    $data->set('gpib',$self->{'_address'},'I',$list[1]+0);
	    return $list[1]+0;
	}
    }
    else
    {
	$data->set('gpib',$self->{'_address'},'I',-32768);
        return -32768;  
    }
}

sub idn()
{
    my $self = shift;
    return $self->{'_idn'} if (defined($self->{'_idn'}) && length($self->{'_idn'}) > 5);
    $self->{'_idn'} = $self->comm('*idn?');
    $self->{'_idn'} = '' unless (defined($self->{'_idn'}));
    chomp  $self->{'_idn'};
    return $self->{'_idn'}."\n";
}

sub get_I()
{
    my $self = shift;
    my $res = undef;
    if ($self->{'_PSU_mode'} eq 'CV')
    {
	$res = $self->comm(':sens:curr:prot?');
    }
    else
    {
	$res = $self->comm(':sour:curr:lev?');
    }
    if (defined($res) && $res =~ /([\-\+\.\deE]+)/)
    {
        $self->{'_I'} = $1+0;
    }
    else
    {
        $self->{'_I'} = undef;; 
    }
    return $self->{'_I'};
}

sub get_U()
{
    my $self = shift;
    my $res = undef;
    if ($self->{'_PSU_mode'} eq 'CV')
    {
	$res = $self->comm(':sour:volt:lev?');
    }
    else
    {
	$res = $self->comm(':sens:volt:prot?');	
    }
    if (defined($res) && $res =~ /([\-\+\.\deE]+)/)
    {
        $self->{'_U'} = $1+0;
    }
    else
    {
        $self->{'_U'} = undef;; 
    }
    return $self->{'_U'};
}

sub send_current()
{
    my $self = shift;
    my $current = undef;
    $current = $self->{'_I'};
    if (defined($current))
    {
        $self->writedebug("Setting current '$current' on ".$self->type) if ($self->debug > 3);
    }
    else
    {
        $self->writedebug("Setting OCV (0 A) on ".$self->type) if ($self->debug > 3);
	$current = 0;
    }
    my $res ='';
    $current = sprintf("%.5E",$current);
    $self->writecmd(':sens:curr:prot '.$current);
    $self->writecmd(':sour:curr:lev '.$current);
    $res = $self->comm(':sens:curr:prot?');
    $res += 0;
    $self->writedebug("Result of send current '$res'") if ($self->debug > 3);
    return $res;
}

sub send_voltage()
{
    my $self = shift;
    my $volt = undef;
    $volt = $self->{'_U'};
    if (defined($volt))
    {
        $self->writedebug("Setting voltage '$volt' on ".$self->type) if ($self->debug > 3);
    }
    else
    {
        $self->writedebug("Setting OCV (0 A) on ".$self->type) if ($self->debug > 3);
	$volt = 0;
    }
    my $res = '';
    $volt = sprintf("%.5E",$volt);
    $self->writecmd(':sour:volt:lev '.$volt);
    $self->writecmd(':sens:volt:prot '.$volt);	
    $res = $self->comm(':sens:volt:prot?');
    $res += 0;
    $self->writedebug("Result of send volt '$res'") if ($self->debug > 3);
    return $res;
}

return 1;
