package RFC::Kepco;
#$Id: Kepco.pm,v 1.24 2016/06/13 12:21:16 sqko Exp $

#################################################################
#
#
#      RFC::Kepco
#
# This module implements RFC::PSU for Kepco biploar power supplies.
#
# To obtain an instance call one of the constructors as shown below:
#
# $id = RFC::Kepco_BOP_50_200MG->new($name,$rig);
#
#
#
# Where $name is the name of the device and $rig is a RFC::Rig instance.
#
# The Kepco class defines the following extra member functions besides 
# those derived from the RFC::PSU class:
#
# $id->send_raw($)         Sends a raw command string to the device and
#                          returns any output returned by the device.
# $id->writecmd($)         Sends a raw command string to the device, does
#                          not expect any return value from the device.
# $id->idn()               Returns the identifier strign from teh device.
# $id->get_error()         Returns any error. An empty return value 
#                          indicates no error. Note that the error register 
#                          in the device is automatically cleared after 
#                          this command.
# $id->device_mode([$])    Gets or sets the device mode (0 is constant 
#                          voltage, 1 is constant current).
# $id->sine($$$[$])        Setup a sine wave output. argumentws are:
#                          device_mode, frequency (Hz), amplitude (V/A) and
#                          optional offset (V/A), 
#                          where device mode is 0 for voltage control 
#                          and 1 for current control.
# $id->square($$$[$])      Setup a square wave output. argumentws are:
#                          device_mode, frequency (Hz), amplitude (V/A) and
#                          optional offset (V/A), 
#                          where device mode is 0 for voltage control 
#                          and 1 for current control.
# $id->reset()             Resets the device. Remember to use this after
#                          a sine or square command has been processed
#                          before any normal current and/or voltage commands
#
######################################################################



use strict;
use warnings;
use RFC::PSU;
use RFC::Cache;
use Time::HiRes qw(time);
our @ISA = qw(RFC::PSU);

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}


sub new
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'Default_Kepco';
    $self->{'_setup_tags'} = ['mode','communication','address','serial','parallel','external_RSD','RSD_name','RSD_type','RSD_tty','RSD_address','RSD_channel','control_mode','master_device','slave_current','slave_voltage','title','show_plot'];
    $self->{'_desc'} = {
        'mode' =>'Device control mode',
        'communication' =>'Device communication',
        'address' => 'Device address',
        'serial' => 'Number of devices in serial (master + slaves)',
        'parallel' => 'Number of devices in parallel (master + slaves)',
        'external_RSD' => 'Existence of external remote shut down device (usually an external relay)',
        'RSD_name' => 'Device name for remote shut down relay',
        'RSD_type' => 'Device type for remote shutdown relay, only used if no RSD name',
        'RSD_tty' => 'Communication device for remote shutdown relay, only used if no RSD name',
        'RSD_address' => 'Remote shutdown relay address, only used if no RSD name',
        'RSD_channel' => 'Remote shutdown relay channel, only used if no RSD name',
        'title' => 'Optional device title',
        'control_mode' => 'determines if the set() function should control voltage or current',
        'master_device' => 'Device name for the master device in case current device is a slave device (locked to have X percent of master device current)',
        'slave_current' => 'Percentage of master device current that this device is supposed to have',
        'slave_voltage' => 'Percentage of master device voltage that this device is supposed to have',
    };
    $self->{'_default'} = {
        'mode' =>'Manual',
        'communicaiton' =>'GPIB',
        'address' => 6,
        'serial' => 1,
        'parallel' => 1,
        'external_RSD' => 'No',
        'RSD_type' => 'ICP',
        'RSD_tty' => 'ttyS0',
        'RSD_address' => 0,
        'RSD_channel' => 0,
        'control_mode'=>'Voltage',
        'slave_current' => 100,
        'slave_voltage' => 100,
    };
    $self->{'_values_external_RSD'} = ['Yes','No'];
    $self->{'_values_control_mode'} = ['Voltage','Current'];
    $self->{'_values_communication'} = ['GPIB'];
    $self->{'_values_RSD_name'} = ['',($self->rig->avaliable_devices('relay'))];
    $self->{'_values_RSD_type'} = [(RFC::Device::list_RELAY())];
    $self->{'_U'} = undef;
    $self->{'_I'} = undef;
    $self->{'_RSD_device'} = undef;;
    $self->{'_mode'} = 'Automatic';
    $self->{'_default'}{'mode'} ='Automatic';
    $self->{'_maxI'} = 100;
    $self->{'_maxU'} = 100;
    $self->{'_minI'} = -100;
    $self->{'_minU'} = -100;
    $self->{'_maxP'} = 100;
    bless $self,$class;
    $self->{'_section'} = 'PSU_'.$self->name;
    my @list = ();
    foreach my $n ($self->rig->avaliable_devices('PSU'))
    {
	next unless ($n);
        push @list,$n unless ($n eq $self->name);
    }
    $self->{'_values_master_device'} = ['',@list];
    return $self->init();
}

sub monitor()
{
    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 $u = $self->measure_U($data);
    $u = -32768 unless defined($u);
    my $i = $self->measure_I($data);
    $i = -32768 unless defined($i);
    return join(' ','Cuurrent',$i,'Voltage',$u);
}

sub device_mode()
{
    my $self = shift;
    if (@_)
    {
	my $mode = shift;
	if ($mode)
	{
	    $self->send_raw('FUNC:MODE CURR');
	}
	else
	{
	    $self->send_raw('FUNC:MODE VOLT');
	}
    }
    my $res = $self->send_raw('FUNC:MODE?');
}

sub sine
{
    my $self = shift;
    my $mode = shift;
    my $frequency = shift;
    my $amplitude = shift;
    my $offset = shift;
    $offset = 0 unless ($offset);
    $self->writecmd('LIST:CLEAR');
    return $self->get_error() if ($self->check_error());
    if ($mode)
    {
	$self->writecmd('FUNC:MODE CURR');
	  return $self->get_error() if ($self->check_error());
	my $cmd = "LIST:CURR:APPLY SINE,$frequency,$amplitude,$offset";
	$self->writecmd($cmd);
	  return $self->get_error() if ($self->check_error());
	$self->writecmd('CURR:MODE LIST');
	  return $self->get_error() if ($self->check_error());
    }
    else
    {
	$self->writecmd('FUNC:MODE VOLT');
	  return $self->get_error() if ($self->check_error());
	my $cmd = "LIST:VOLT:APPLY SINE,$frequency,$amplitude,$offset";
	$self->writecmd($cmd);
	  return $self->get_error() if ($self->check_error());
	$self->writecmd('VOLT:MODE LIST');
	  return $self->get_error() if ($self->check_error());
    }
    $self->remote_on();
    return $self->get_error() if ($self->check_error());
    return undef;
}

sub square
{
    my $self = shift;
    my $mode = shift;
    my $frequency = shift;
    my $amplitude = shift;
    my $offset = shift;
    $offset = 0 unless ($offset);
    $self->writecmd('LIST:CLEAR');
    return $self->get_error() if ($self->check_error());
    if ($mode)
    {
	$self->writecmd('FUNC:MODE CURR');
	  return $self->get_error() if ($self->check_error());
	  my $cmd = "LIST:CURR:APPLY SQUARE,$frequency,$amplitude,$offset";
	  $self->writecmd($cmd);
	  return $self->get_error() if ($self->check_error());
	$self->writecmd('CURR:MODE LIST');
    }
    else
    {
	$self->writecmd('FUNC:MODE VOLT');
	  return $self->get_error() if ($self->check_error());
	my $cmd = "LIST:VOLT:APPLY SQUARE,$frequency,$amplitude,$offset";
	$self->writecmd($cmd);
	  return $self->get_error() if ($self->check_error());
	$self->writecmd('VOLT:MODE LIST');
	  return $self->get_error() if ($self->check_error());
    }
    $self->remote_on();
    return $self->get_error() if ($self->check_error());
    return undef;
}

sub reset()
{
    my $self = shift;
    sleep(1);
    $self->writecmd('*RST');
    sleep(1);
    $self->writecmd('LIST:CLEAR');
    my $error = $self->get_error() if ($self->check_error());
    if ($error)
    {
	$self->writedebug("Error: '$error'");
	return $error;
    }   
    return undef;
}

sub check_error()
{
    my $self = shift;
    my $stb = $self->send_raw('*STB?');
    chomp $stb if (defined($stb));
    return 0 if ($stb && $stb == 1);
    return $stb;
}

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

sub send_raw
{
    my $self = shift;
    my $cmd = shift;
    $self->writedebug("Sending '$cmd'\n");
    my $res = SocketClient::GPIB_client('c',$self->{'_address'},$cmd);
    $res = '' unless (defined($res));
    $self->writedebug("Recieved '$res'\n");
    sleep(1) if ($self->debug() > 3);
    return $res;
}

sub writecmd($)
{
    my $self = shift;
    my $cmd = shift;
    $self->writedebug("Writing '$cmd'\n");
    sleep(1) if ($self->debug() > 3);
    return SocketClient::GPIB_client('w',$self->{'_address'},$cmd);
}

sub get_error
{
    my $self = shift;
    my $res = $self->send_raw('system:error?');
    return $res;
}

sub maxcurrent()
{
    my $self = shift;
    return $self->{'_maxI'} * $self->{'_parallel'};
}

sub init()
{
    my $self = shift;
    foreach my $tag ($self->setup_tags)
    {
        $self->{'_'.$tag} = $self->get_default($tag);
        my $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    }
    foreach my $tag ('_serial','_parallel')
    {
        $self->{$tag} = 1 unless ($self->{$tag} && $self->{$tag} =~ /^\d+$/ && $self->{$tag} > 1);
    }
    if ($self->{'_external_RSD'} && $self->{'_external_RSD'} =~ /yes/i)
    {
        my $dev = $self->rig->get_device('relay',$self->{'_RSD_name'});
        unless ($dev)
        {
            $dev = $self->rig->init_device('relay',$self->{'_RSD_name'});
            $dev->readstring_ignore(1) if ($dev);
        } 
        my $devname = $self->name.'_RSD';
        $dev = $self->rig->get_device('relay',$devname) unless ($dev);
        unless ($dev)
        {
            $dev = RFC::Device::new_RELAY($self->rig,$devname,$self->{'_RSD_type'},$self->{'_RSD_tty'},$self->{'_RSD_address'},$self->{'_RSD_channel'});
            $dev->readstring_ignore(1);
            $self->rig->register_device('relay',$dev);
        }
        $self->{'_RSD_device'} = $dev;
    }
    ### Handle slave devices ##
    if ($self->{'_master_device'})
    {
        my $dev = $self->rig->init_device('PSU',$self->{'_master_device'});
        $self->die("Could not get a device instance for master device '".$self->{'_master_device'}."'!") unless ($dev);
        $self->die("A device can not be slave to an other slave device!") if ($dev->master);
        $self->{'_mdev'} = $dev;
        $dev->attatch_observer(\$self);
        $self->{'_readonly'} = 1; ### A slave device can not  be directly controlled, only indirectly ###
    }
    return $self;
}

sub test()
{
    my $self = shift;
    return 0 if ($self->{'_RSD_device'} && !$self->{'_RSD_device'}->test);
    my $res = $self->idn();
    return 1 if ($res && $res =~ /KEPCO/i);
    return 0;
}

sub test_string()
{
    my $self = shift;
    my $string = $self->idn();
    $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'};
    push @arr,'Parallel: '.$self->{'_parallel'};
    push @arr,'Serial: '.$self->{'_serial'};
    if ($self->{'_RSD_device'})
    {
        push @arr,$self->{'_RSD_device'}->print_config;
    }
    return join (', ',@arr);
}

sub mincurrent()
{
    my $self = shift;
    return $self->{'_minI'} * $self->{'_parallel'};
}

sub maxvoltage()
{
    my $self = shift;
    return $self->{'_maxU'} * $self->{'_serial'};
}

sub minvoltage()
{
    my $self = shift;
    return $self->{'_minU'} * $self->{'_serial'};
}


sub remote_on()
{
    my $self = shift;
    return $self->writecmd('OUTP ON');
}

sub remote_off()
{
    my $self = shift;
    return $self->writecmd('OUTP OFF');
}

sub set
{
    my $self = shift;
    if ($self->{'_control_mode'} && $self->{'_control_mode'} =~ /current/i)
    {
        return $self->current(@_);
    }
    else
    {
        return $self->voltage(@_);
    }
}

sub RSD($)
{
    my $self = shift;
    my $status = shift;
    return undef unless ($self->{'_RSD_device'});
    $self->writedebug('Setting RSD device to '.$status) if ($self->debug > 1);
    if ($self->debug > 0)
    {
        return $self->{'_RSD_device'}->set($status);
    }
    else
    {
        return $self->{'_RSD_device'}->set_noinfo($status);
    }
    $self->notify('rsd',$status,@_);
}

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


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 voltage()
{
    my $self = shift;
    if (@_)
    {
        $self->{'_U'} = 'ocv';
        my $c = shift;
        if ($c =~ /([\-\d\.]+)/)
        {
            $self->{'_U'} = $1 / $self->{'_serial'};;
            $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);

        }
        else
        {
            $self->writedebug('Setting voltage to '.$self->{'_U'}.' V') if ($self->debug > 1);
            $self->RSD(1);
        }
        my $res = $self->send_voltage;
	$self->proglog("Voltage for PSU ".$self->name." set to ".$self->{'_U'}." V",@_);
        $self->notify('voltage',$c,@_);
        return $res;
    }
    else
    {
        return $self->get_U();
    }
}

sub current()
{
    my $self = shift;
    if (@_)
    {
        $self->{'_I'} = 'ocv';
        my $c = shift;
        if ($c =~ /([\-\d\.]+)/)
        {
            $self->{'_I'} = $1 / $self->{'_parallel'};
            $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);

        }
        else
        {
            $self->writedebug('Setting current to '.$self->{'_I'}.' A') if ($self->debug > 1);
            $self->RSD(1);
        }
        my $res = $self->send_current;
	$self->proglog("Current for PSU ".$self->name." set to ".$self->{'_I'}." A",@_);
        $self->notify('current',$c,@_);
        return $res;
    }
    else
    {
        return $self->get_I();
    }
}


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($self->type,$self->{'_address'},'I');
    if (defined($cached))
    {
        $self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
        $self->{'_I'} = $cached;
    }
    else
    {
	my $res = $self->send_raw('MEAS:CURR?;volt?');
	if (defined($res) && $res =~ /([\-\+\.\d]+)\;([\-\+\.\d]+)/)
	{
	    $self->{'_I'} = $1 * $self->{'_parallel'}; 
	    $self->{'_U'} = $2 * $self->{'_parallel'}; 
	}
	else
	{
	    $self->{'_I'} = -32768; 
	    $self->{'_U'} = -32768; 
	}
	$data->set($self->type,$self->{'_address'},'I',$self->{'_I'});
	$data->set($self->type,$self->{'_address'},'U',$self->{'_U'});
	unless (defined($res))
	{
	    $self->writedebug("No current found for PSU ".$self->name);
	    return undef;
	}
    }
    my $str = time.' '.$self->name.' '.$self->{'_I'};
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    return $self->{'_I'};
}


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($self->type,$self->{'_address'},'U');
    if (defined($cached))
    {
        $self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
	$self->{'_U'} = $cached;
    }
    else
    {
	my $res = $self->send_raw('MEAS:CURR?;volt?');
	if (defined($res) && $res =~ /([\-\+\.\d]+)\;([\-\+\.\d]+)/)
	{
	    $self->{'_I'} = $1 * $self->{'_parallel'}; 
	    $self->{'_U'} = $2 * $self->{'_parallel'}; 
	}
	else
	{
	    $self->{'_I'} = -32768; 
	    $self->{'_U'} = -32768; 
	}
	$data->set($self->type,$self->{'_address'},'I',$self->{'_I'});
	$data->set($self->type,$self->{'_address'},'U',$self->{'_U'});
	unless (defined($res))
	{
	    $self->writedebug("No voltage found for PSU ".$self->name);
	    return undef;
	}
    }
    return $self->{'_U'};
}

sub get_I()
{
    my $self = shift;
    my $res = $self->send_raw('CURR?');
    if (defined($res) && $res =~ /([\-\+\.\d]+)/)
    {
        $self->{'_I'} = $1 * $self->{'_parallel'}; 
    }
    else
    {
        $self->{'_I'} = undef;; 
    }
    return $self->{'_I'};
}


sub get_U()
{
    my $self = shift;
    my $res = $self->send_raw('VOLT?');
    if (defined($res) && $res =~ /([\-\+\.\d]+)/)
    {
        $self->{'_U'} = $1 * $self->{'_serial'}; 
    }
    else
    {
        $self->{'_U'} = undef;; 
    }
    return $self->{'_U'};
}

sub send_voltage()
{
    my $self = shift;
    my $volt = undef;
    $volt = $self->{'_U'} if (defined($self->{'_U'}) && $self->{'_U'} =~ /\d+/);
    if (defined($volt))
    {
        $self->writedebug("Setting voltage '$volt' on ".$self->type) if ($self->debug > 3);
    }
    else
    {
        $self->writedebug("Setting OCV on ".$self->type) if ($self->debug > 3);
    }
    my $on = $self->send_raw('OUTP?');
    if ($on)
    {
	if (!defined($volt) || $volt !~ /\d+/i)
	{
	    $self->remote_off();
	    $self->writecmd("VOLT 0.00");
	}
	else
	{
	    $self->writecmd("VOLT $volt");    
	}
    }
    else
    {
	if (!defined($volt) || $volt !~ /\d+/i)
	{
	    $self->remote_off();
	    $self->writecmd("VOLT 0.00");
	}
	else
	{
	    $self->writecmd("VOLT $volt");    
	    $self->device_mode(1) unless ($self->device_mode());
	    $self->remote_on();
	}
    }
}

sub send_current()
{
    my $self = shift;
    my $current = undef;
    $current = $self->{'_I'} if (defined($self->{'_I'}) && $self->{'_I'} =~ /\d+/);
    if (defined($current))
    {
        $self->writedebug("Setting current '$current' on ".$self->type) if ($self->debug > 3);
    }
    else
    {
        $self->writedebug("Setting OCV on ".$self->type) if ($self->debug > 3);
    }
    my $on = $self->send_raw('OUTP?');
    if ($on)
    {
	if (!defined($current) || $current !~ /\d+/)
	{
	    $self->remote_off();
	    $self->writecmd("CURR 0.00");
	}
	else
	{
	    $self->writecmd("CURR $current");    
	}	
    }
    else
    {
	if (!defined($current) || $current !~ /\d+/)
	{
	    $self->remote_off();
	    $self->writecmd("CURR 0.00");
	}
	else
	{
	    $self->writecmd("CURR $current");    
	    $self->device_mode(1) unless ($self->device_mode());
	    $self->remote_on();
	}
    }
}


package RFC::Kepco_BOP_50_20MG;
our @ISA = qw(RFC::Kepco);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'BOP-50-200MG';
    $self->{'_maxI'} = 20;
    $self->{'_maxU'} = 50;
    $self->{'_minI'} = -20;
    $self->{'_minU'} = -50;
    bless $self,$class;
    return $self;
}




return 1;
