package RFC::AnalogOut;
#$Id: AnalogOut.pm,v 1.69 2023/12/06 11:26:27 sqko Exp $
##########################################################################################
#
#
#   RFC::AnalogOut
#
#
# This class defines simple analog output devices (D-A converters, not power supplies)
# To obtain a analog output instance call onw of the constructors:
#
# $id = RFC::AnalogOut->new($name,$rig);
#
# $id = RFC::AnalogICP87024->new($name,$rig);
#
# $id = RFC::AnalogICP87028->new($name,$rig);
#
# $id = RFC::ManualAnalogOut->new($name,$rig); (A virtual, software only, device)
#
# The rig argument must be a RFC::Rig instance or a similar object honoring
# the get_conf() member function.
# The constructiors can also be called with additional arguments like shown below:
#  
# $id = RFC::AnalogICP87024->new($name,$rig,$tty,$address,$channel);
#
# where the last 3 argmeutns specify the serial device, the module address 
# and the channel number of the output module (as most modules contains more 
# than one output channel).
#
#  All analog output objects have the following member functions (excluding those 
#  derived from RFC::BaseDevce and Debug.pm):
#
#  $id->set($)        Sets the output voltage/current of the device to the specified argument.
#                     the format for sending numbers to the devices supported (i87022/24/26)
#                     is the engineering unit DD.DDD according to the manual. The driver
#                     uses sprintf to make sure that the supplied number is in this format.
#  $id->current($)    Sets the output (for current control modules) in A.
#                     this functio is usually just a wrapper for set().
#  $id->mode()        Returns the control mode of the deivce (mA,A,mV or Volt).
#                     This overloads the normal mode() function.
#  $id->min()         Returns the minimum possible value.
#  $id->max()         Returns the maximum possible value.
#
###########################################################################################

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

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 $self = $class->SUPER::new(@_);
    $self->{'_type'} = 'AnalogOut';
    $self->{'_mode'} = 'Volt';
    $self->{'_values_mode'} = ['Volt','Amp'];
    $self->{'_setup_tags'} = ['mode','tty','address','channel','title','show_plot','use_cache','persistent_settings','CRC'];
    $self->{'_reload_tags'} = ['mode','tty','address'];
    $self->{'_desc'} = {
        'mode' => 'Device control mode',
        'tty' => 'Serial device for communication (ex ttyS0)',
        'address' => 'Device address',
        'channel' => 'Device channel',
	'title' => 'Optional title',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
        'persistent_settings' => 'Determines wether or not settings should be cached on file (speeding up normal use) or queried each time',
	'CRC' => 'Determines if checksum is to be used for serial communication',
    };
    $self->{'_default'} = {
        'mode' => 'Volt',
        'tty' => 'ttyS0',
        'address' => 0,
        'channel' => 0,
        'use_cache'=>'No',
        'persistent_settings' => 'No',
	'CRC'=>'No',
    };
    $self->{'_read_names'} = ['read','setpoint'];
    $self->{'_set_fn_names'} = ['set']; # List of function names which can trigger a notify event
    $self->{'_values_mode'} = ['Automatic'];
    $self->{'_values_CRC'} = ['No','Yes'];
    $self->{'_max'} = 0;
    $self->{'_min'} = 0;
    bless $self,$class;
    foreach my $key ('tty','address','channel','title','show_plot','use_cache','title','persistent_settings','CRC')
    {
        $self->{'_'.$key} = $self->get_conf($key);
        $self->{'_'.$key} = $self->get_default($key) unless ($self->{'_'.$key});
    }
    $self->{'_tty'} = 'ttyS0' unless ($self->{'_tty'});
    $self->{'_address'} = '0' unless ($self->{'_address'});
    $self->{'_channel'} = '0' unless ($self->{'_channel'});
    $self->{'_section'} = 'analog_out_'.$self->name;
    return $self;
}

sub test_string()
{
    my $self = shift;
    $self->init unless ($self->mode !~ /specified/);
    my $value = $self->read(@_);
    return 'Analog out '.$self->name.": $value ".$self->mode."\n";
}


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

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

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

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


sub set($)
{
    my $self = shift;
    my $value = shift;
    $self->init unless ($self->mode);
    $self->writedebug("Setting analog output for $self to $value") if ($self->debug > 2);
    $self->die($self->{'_type'}." is a base class and does not impelemnt id->set(), only the derived classes does so!");
    return undef;
}

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

sub min($)
{
    my $self = shift;
    my $value = shift;
    $self->init unless ($self->mode);
    $self->writedebug("Getting analog output min value for $self") if ($self->debug > 2);
    $self->die($self->{'_type'}." is a base class and does not impelemnt id->min(), only the derived classes does so!");
    return undef;
}

sub max($)
{
    my $self = shift;
    my $value = shift;
    $self->init unless ($self->mode);
    $self->writedebug("Getting analog output max value for $self") if ($self->debug > 2);
    $self->die($self->{'_type'}." is a base class and does not impelemnt id->max(), only the derived classes does so!");
    return undef;
}

sub setup_mode()
{
    my $self = shift;
    $self->init unless ($self->mode !~ /specified/);
    return 'Output: '.$self->{'_min'}.' to '.$self->{'_max'}.' '.$self->mode();
}

sub print_config()
{
    my $self = shift;
    my @arr = ('Analog output type: '.$self->type);
    push @arr,'Name: '.$self->name;
    push @arr,'TTY: '.$self->{'_tty'};
    push @arr,'Address: '.$self->{'_address'};
    push @arr,'channel: '.$self->{'_channel'};
    push @arr, $self->setup_mode;
    return join (', ',@arr);
}

sub init()
{
    my $self = shift;
}

package RFC::ManualAnalogOut;
use RFC::Header;
our @ISA = qw(RFC::AnalogOut);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_type'} = 'ManualAnalogOut';
    $self->{'_mode'} = 'Volt/mA';
    $self->{'_setup_tags'} = ['mode','title','show_plot','use_cache','min','max'];
    $self->{'_desc'} = {
        'mode' => 'Device control mode',
	'title' => 'Optional title',
        'show_plot'=>'Determines if the current device data is to be shown in the daily data plots',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
    };
    $self->{'_default'} = {
        'mode' => 'Volt/mA',
        'show_plot'=>'Yes',
        'use_cache'=>'No',
	'min' => -1e100,
	'max' => 1e100,
    };
    $self->{'_values_mode'} = ['Volt/mA'];
    foreach my $key ('mode','title','show_plot','use_cache','min','max')
    {
        $self->{'_'.$key} = $self->get_conf($key);
        $self->{'_'.$key} = $self->get_default($key) unless ($self->{'_'.$key});
    }
    $self->{'_type'} = 'ManualAnalogOut';
    $self->{'_file'} = SemaforeFile->new($userdir.'rig'.$self->rig->name.'/analog_'.$self->name,'/home/celltest/Gas_rig'.$self->rig->name.'.lock');
    unless ($self->{'_file'}->exist)
    {
        ### Create file with rw for all           ###
        ### Yes I know 666 is the number of evil! ###
        $self->{'_file'}->lock_ex;
        $self->{'_file'}->writeline('0');
        chmod 0666, $self->{'_file'}->filename;
        $self->{'_file'}->unlock;
    }
    return $self;
}

sub DESTROY
{
    my $self = shift;
    $self->{'_file'}->DESTROY() if ($self->{'_file'});
    return undef;
}


sub test()
{
    return 1;
}

sub min()
{
    my $self = shift;
    return $self->{'_min'};
}

sub max()
{
    my $self = shift;
    return $self->{'_max'};
}


sub set($)
{
    my $self = shift;
    my $status = shift;
    $status = $self->set_noinfo($status);
    $self->proglog("Setting $self to $status manually",@_);
    $self->notify('set',$status,@_);
    return $status;
}

sub set_noinfo($)
{
    my $self = shift;
    my $status = shift;
    $self->writedebug("Setting $self to $status manually!") if ($self->debug > 2);
    $self->{'_file'}->writeline($status);
    $self->notify('set',$status,@_);
    return $status;
}

sub read_nocache
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
	$data = RFC::Cache->new();
	$data->debug($self->debug()) if ($self->debug);
    }
    my $flow = 0;
    $self->check_cache($data);
    my $cached = $data->get('manual_Analogout',$self->name);
    return $cached if (defined($cached));
    my @lines = $self->{'_file'}->readlines;
    $flow = $lines[0] if (@lines);
    $data->set('manual_Analogout',$self->name,$flow);
    $self->set_cache($flow);
    $self->{'_last_read'} = Time::HiRes::time;
    return $flow;
}

sub print_config()
{
    my $self = shift;
    my @arr = ('Analog output type: '.$self->type);
    push @arr,'Name: '.$self->name;
    push @arr,'Mode: '.$self->mode;
    return join (', ',@arr);
}


package RFC::ICPAnalogOut;
our @ISA = qw(RFC::AnalogOut);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_setup_tags_readonly'} = ['mode'];
    foreach my $key ('tty','address','channel','mode','title','show_plot','use_cache','persistent_settings','CRC')
    {
        $self->{'_'.$key} = $self->get_conf($key);
        $self->{'_'.$key} = $self->get_default($key) unless ($self->{'_'.$key});
    }
    $self->{'_ui_fn_names'} = ['query_settings'];
    $self->{'_ui_fn_desc'} = {
        'query_settings' => 'Get and store the settings which can be queried from the module',
    };
    $self->{'_type'} = 'ICPAnalogOut';
    $self->{'_tty'} = shift if (@_);
    $self->{'_address'} = shift if (@_);
    $self->{'_channel'} = shift if (@_);
    return $self;
}

sub mode
{
    my $self = shift;
    $self->init unless ($self->{'_mode'} !~ /specified/);
    return $self->{'_mode'};
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    $self->init unless ($self->mode !~ /specified/);
    return $self->mode() if ($tag eq 'mode');
    return undef;
}

sub test_string()
{
    my $self = shift;
    $self->init unless ($self->mode !~ /specified/);
    my $value = $self->read_nocache(@_);
    if (defined($value))
    {
	return "$self: $value ".$self->mode."\n";
    }
    else
    {
	return "$self not responding!\n";
    }
}


sub query_settings
{
    my $self = shift;
    my $u = '';
    my @list = ();
    $self->rig->begin();
    eval {
	my $str = $self->config;
	CORE::die "Could not get configuration from module $self\n" unless ($str);
        $self->change_cv('config',$str);
        push @list,"Config: $str";
	if ($str && $str =~ /\!\w{6}(\w)\w/)
	{
	    my $d = $1;
	    if ($d & 4)
	    {
		$self->change_cv('CRC','Yes');
	    }
	    else
	    {
		$self->change_cv('CRC','No');
	    }
	}
        $self->rig->commit();
    };
    if ($@)
    {
        $self->rig->rollback();
        push @list,'Error: '.$@;
    }
    return join("\n",@list);
}

sub min()
{
    my $self = shift;
    $self->init unless ($self->mode !~ /specified/);
    return $self->{'_min'};
}

sub max()
{
    my $self = shift;
    $self->init unless ($self->mode !~ /specified/);
    return $self->{'_max'};
}

sub test()
{
    my $self = shift;
    $self->init unless ($self->mode !~ /specified/);
    return 0 unless ($self->{'_min'} != 0 || $self->{'_max'} != 0);
    return 1;
}

sub setpoint
{
    my $self = shift;
    if ($self->{'_mode'} eq 'mA')
    {
	return $self->read(@_) / 1000;
    }
    else
    {
	return $self->read(@_);
    }
}

sub current
{
    my $self = shift;
    my $setpoint = shift;
    if ($self->{'_mode'} eq 'mA')
    {
	$setpoint = $setpoint * 1000;
    }
    return $self->set($setpoint,@_);
}

sub set($)
{
    my $self = shift;
    my $out = shift;
    $self->init unless ($self->mode !~ /specified/);
    if ($out < $self->{'_min'})
    {
	$self->writedebug("Output below minimum value ($self->{'_min'}), setting minimum");
	$out = $self->{'_min'};
    }
    if ($out > $self->{'_max'})
    {
	$self->writedebug("Output above maximum value ($self->{'_max'}), setting maximum");
	$out = $self->{'_max'};
    }
    $self->writedebug("Setting output for $self to $out") if ($self->debug > 2);
    my $cmd = 'volt_set';
    $cmd = 'volt_set_crc' if ($self->{'_CRC'} eq 'Yes');
    my $res = SocketClient::serial_client_raw($self->{'_tty'},$cmd,$self->{'_address'},$self->{'_channel'},sprintf("%06.3f",$out));
    $self->writedebug("Response for $self : $res") if ($self->debug > 3);
    $self->proglog("Setting $self to $out ".$self->mode(),@_);
    $self->rig->unset_warning($self);
    $self->notify('set',$out,@_);
    return $res;
}


sub read_nocache
{
    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 $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $ch = $self->{'_channel'};
    my $cached = $data->get($tty,'icp',$addr,$ch);
    if (defined($cached))
    {
        $self->writedebug("Using existing data from channel $ch output on tty $tty address $addr") if ($self->debug > 3);
        $res = $cached;
    }
    else
    {
        $self->writedebug("Reading data from relay on tty $tty address $addr") if ($self->debug > 3);
	my $cmd = sprintf("\$%02d6%d",$self->{'_address'},$self->{'_channel'});
	my $c = 'icp_raw';
	$c = 'icp_raw_crc' if ($self->{'_CRC'} eq 'Yes');
        $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	chomp $res if (defined($res));
	if (defined($res) && $res =~ /([\+\-][\d\.]+)/)
	{
	    $res = $1+0;
	}
        if (defined($data) && (defined($res))) 
        {
	    $data->set($tty,'ICP',$addr,$ch,$res);
        }
    }
    unless (defined($res))
    {
	my $str = "Warning: No data returned from device $self"; 
	$self->rig->warning_mail($self,$str);
	$self->writedebug($str,1);
	return undef;
    }
    $self->writedebug("Value for $self was $res") if ($self->debug > 2);
    my $str = time .' '. $self->name .' '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    $self->set_cache($res);
    $self->{'_last_read'} = Time::HiRes::time;
    return $res;
}

sub read_active()
{
    my $self = shift;
    my $cmd = sprintf("\$%02d6%d",$self->{'_address'},$self->{'_channel'});
    my $c = 'icp_raw';
    $c = 'icp_raw_crc' if ($self->{'_CRC'} eq 'Yes');
    my $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
    chomp $res;
    if ($res =~ /([\+\-][\d\.]+)/)
    {
	return $1+0;
    }
    unless (defined($res))
    {
	my $str = "Warning: No data returned from device $self"; 
	$self->rig->warning_mail($self,$str);
	$self->writedebug($str,1);
	return undef;
    }
    my $str = time .' '. $self->name .'_active '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    retrun $res;
}

sub config()
{
    my $self = shift;
    my $res;
    my $cmd = sprintf("\$%02d2",$self->{'_address'});
    if ($self->{'_CRC'} eq 'Yes')
    {
	my $c = 'icp_raw_crc';
	$res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	### Try 2 times to get configuration ###
	unless (defined($res) && $res =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd); 
	}
	$c = 'icp_raw';
	### Try 2 times more without checksum to get configuration ###
	unless (defined($res) && $res =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd); 
	}
	unless (defined($res) && $res =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd); 
	}
    }
    else
    {
	my $c = 'icp_raw';
	$res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	### Try 2 times to get configuration ###
	unless (defined($res) && $res =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd); 
	}
        ### Try 2 times more with checksum to get configuration ###
	$c = 'icp_raw_crc';
	unless (defined($res) && $res =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd); 
	}
	unless (defined($res) && $res =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd); 
	}
    }
    chomp $res if (defined($res));
    return $res;
}

package RFC::AnalogICP87024;
our @ISA = qw(RFC::ICPAnalogOut);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_tty'} = shift if (@_);
    $self->{'_address'} = shift if (@_);
    $self->{'_channel'} = shift if (@_);
    $self->{'_type'} = 'AnalogICP87024';
    bless $self,$class;
    if (@_)
    {
	$self->{'_min'} = shift;	
	$self->{'_max'} = shift;
	$self->{'_mode'} = shift;
    }
    else
    {
	$self->{'_mode'} = 'Not specified';
    }
    return $self->init();
}

sub init()
{
    my $self = shift;
    my $str = '';
    if ($self->persistent && $self->get_conf('config'))
    {
	$str = $self->get_conf('config');
    }
    else
    {
	$str = $self->config;	
    } 
    if (defined($str) && $str =~ /\!\d{2}3(\d)/)
    {
	my $c = $1;
	if ($c == 0)
	{
	    $self->{'_min'} = 0;
	    $self->{'_max'} = 20;
	    $self->{'_mode'} = 'mA';
	    $self->{'_set_fn_names'} = ['set','current'];
	}
	if ($c == 1)
	{
	    $self->{'_min'} = 4;
	    $self->{'_max'} = 20;
	    $self->{'_mode'} = 'mA';
	    $self->{'_set_fn_names'} = ['set','current'];
	}
	if ($c == 2)
	{
	    $self->{'_min'} = 0;
	    $self->{'_max'} = 10;
	    $self->{'_mode'} = 'Volt';
	}
	if ($c == 3)
	{
	    $self->{'_min'} = -10;
	    $self->{'_max'} = 10;
	    $self->{'_mode'} = 'Volt';
	}
	if ($c == 4)
	{
	    $self->{'_min'} = 0;
	    $self->{'_max'} = 5;
	    $self->{'_mode'} = 'Volt';
	}
	if ($c == 5)
	{
	    $self->{'_min'} = -5;
	    $self->{'_max'} = 5;
	    $self->{'_mode'} = 'Volt';
	}
    }
    else
    {
	$str = 'UNDEF' unless defined($str);
	$self->writedebug("Init failed for device $self: returned '$str'");
    }
    return $self;
}

package RFC::AnalogICP87028;
our @ISA = qw(RFC::ICPAnalogOut);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_tty'} = shift if (@_);
    $self->{'_address'} = shift if (@_);
    $self->{'_channel'} = shift if (@_);
    $self->{'_type'} = 'AnalogICP87028';
    bless $self,$class;
    if (@_)
    {
	$self->{'_min'} = shift;	
	$self->{'_max'} = shift;
	$self->{'_mode'} = shift;
    }
    else
    {
	$self->{'_mode'} = 'Not specified';
    }
    return $self->init();
}

sub init()
{
    my $self = shift;
    my $str = '';
    if ($self->persistent && $self->get_conf('config'))
    {
	$str = $self->get_conf('config');
    }
    else
    {
	$str = $self->config;	
    } 
    if (defined($str) && $str =~ /\!\d{2}3(\w)/)
    {
	my $c = $1;
	if ($c eq "F")
	{
	    $self->{'_min'} = 0;
	    $self->{'_max'} = 20;
	    $self->{'_mode'} = 'mA';
	    $self->{'_set_fn_names'} = ['set','current'];
	}
    }
    else
    {
	$str = 'UNDEF' unless defined($str);
	$self->writedebug("Init failed for device $self: returned '$str'");
    }
    return $self;
}

return 1;


