package RFC::SPDEV;
#$Id: SPDEV.pm,v 1.51 2017/11/06 08:55:46 sqko Exp $
#################################################################
#
#
#       RFC::SPDEV
#
# This module defines a number of filter device classes. All the device 
# classes operates with spline filters on either input and/or output.
# Notice that for all splines, if only two lines are detected, the 
# relation is a linear relation and are handled accordingly (that is 
# without calls to the external splineinterpol program).
#
# -- \subsection{SPDEV: Input spline filter}
#
# This SPDEV class defines a filter device which can be used on top of 
# a normal device. The SPDEV device type operates on an other device
# and converts all read operations on the underlying device according
# to the specified spline interpolation table. 
#
# The SPDEV device class defines no new member functions.
#
# To obtain an instance of this class call the constructor:
#
# $id = RFC::SPDEV->new($name,$rig)
#
# -- \subsection{SPOutDEV: Output spline filter}
#
# The SPOutDEV device type operates on an other device
# and converts all set/setflow operations on the underlying device according
# to the specified spline interpolation table. 
#
# To obtain an instance of this class call the constructor:
#
# $id = RFC::SPOutDEV->new($name,$rig)
#
# -- \subsection{SPIODEV: Input-output spline filter}
#
# The SPOutDEV device type operates on an other device
# and converts all set/setflow and read operations on the underlying device according
# to the specified spline interpolation tables. 
#
# To obtain an instance of this class call the constructor:
#
# $id = RFC::SPIODEV->new($name,$rig)
#
#
#################################################################

use strict;
use warnings;
use RFC::Filter;
use SemaforeFile;
use RFC::Header;
use RFC::Cache;
use RFC::Spline;
our @ISA = qw(RFC::Filter);

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'} = 'Input_spline_device';
    $self->{'_setup_tags'} = ['class','mode','spline','device_type','device','title','show_plot','read_function'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_desc'} = {
	'class' => 'Device class',
        'mode' => 'Device control mode',
	'device_type' => 'Type of raw device',
        'device' => 'Raw device',
        'title' => 'Optional title',
        'spline' => 'Spline table',
        'read_function' => 'Device function to use for read operations',
    };
    $self->{'_default'} = {
	'class' => 'input_spline',
        'device_type' => 'simplechannel',
        'device' => '',
        'spline' => '',
        'read_function' => 'read',
        'show_plot'=>'Yes',
    };
    bless $self,$class;
    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/);
    }
    if ($self->{'_spline'})
    {
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	$self->die("Spline interpolation tables must have at least 2 lines, only one detected!") unless (@list > 1);
    }
    $self->rig->register_device($self->{'_device_type'},$self);
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub test_string
{
    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 @arr = ();
    $self->init();
    my $string = 'Spline input device '.$self->name.': ';
    my $raw = $self->device->read_named($self->{'_read_function'},$data);
    my $val = $self->read($data);
    push @arr,'Raw read: '.$raw;
    push @arr,'Calculated value: '.$val;
    $string .= join(', ',@arr)."\n";
    return $string;
}

sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,$self->{'_dev'}->print_config();
    push @arr,'Spline_table: '.$self->{'_spline'};
    return join(', ',@arr);
}

sub read
{
    my $self = shift;
    $self->init();
    my $val = $self->device->read_named($self->{'_read_function'},@_);
    return $val unless ($self->{'_spline'});
    if (defined($val) && $val =~ /([\d\.\-\+eE]+)/)
    {
	$val = $1+0;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with walue $val") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	return $spline->value($val)
    }
    $self->writedebug("Undefined result recieved from device") if ($self->debug);
    return undef;
}

package RFC::SPOutDEV;
use RFC::Header;
our @ISA = qw(RFC::Filter);


sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'Output_spline_device';
    $self->{'_setup_tags'} = ['class','mode','spline','device_type','device','device_set_function','title','show_plot','master_device_type','master_device','master_set_function','slave_flow'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_desc'} = {
	'class' => 'Device class',
        'mode' => 'Device control mode',
	'device_type' => 'Type of raw device',
        'device' => 'Raw device',
        'title' => 'Optional title', 
	'master_set_function' => 'Function which triggers a forward response. If no functin name is specified all calls will be forwarded.',
	'device_set_function' => 'Function to call on the encapsulated device. If no functin name is specified all calls will be forwarded to the set or setflow command.',
	'spline' => 'Spline table',
	'master_device_type' => 'Device type for the master device in case current device is a slave device (locked to have X percent of master device setpoint)',
        'master_device' => 'Device name for the master device in case current device is a slave device (locked to have X percent of master device setpoint)',
        'slave_flow' => 'Percentage of master device setpoint that current device is supposed to have',
    };
    $self->{'_default'} = {
	'class' => 'output_spline',
        'device_type' => 'analog',
        'device' => '',
        'spline' => '',
	'master_set_function' => '',
	'device_set_function' => '',
        'slave_flow' => 100,
        'show_plot'=>'Yes',
    };
    bless $self,$class;
    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/);
    }
    if ($self->{'_spline'})
    {
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	$self->die("Spline interpolation tables must have at least 2 lines, only one detected!") unless (@list > 1);
    }
    $self->{'_values_master_device_type'} = ['',$self->rig->list_types_nofilter()];
    my @list = ();
    foreach my $n ($self->rig->avaliable_devices($self->{'_master_device_type'}))
    {
	push @list,$n unless ($n && $n eq $self->name);
    }
    $self->{'_values_master_device'} = ['',@list];
    $self->{'_mdev'} = undef;
    $self->rig->register_device($self->{'_device_type'},$self);
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub readonly()
{
    my $self = shift;
    return $self->{'_readonly'};
}

sub mode()
{
    my $self = shift;
    return $self->device->mode();
}

sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    $self->{'_mdev'}->Accept($visitor) if ($self->{'_mdev'});
    $visitor->VisitComplex($self);
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}

sub local_init()
{
    my $self = shift;
    if ($self->{'_master_device'})
    {
	my $dev = $self->rig->init_device($self->{'_master_device_type'},$self->{'_master_device'});
	$self->die("Could not get a device instance for master device '".$self->{'_master_device'}."' of type '".$self->{'_master_device_type'}."'!") 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 ###
	my @arr = $self->{'_mdev'}->set_names();
        $self->{'_values_master_set_function'} = ['',@arr];
    }
    if ($self-> {'_dev'})
    {
	$self->{'_dev'}->set_readonly();
	my @arr = $self->{'_dev'}->set_names();
        $self->{'_values_device_set_function'} = ['',@arr];
    }
    return $self;
}

sub observe()
{
    my $self = shift;
    my $action = shift;
    if ($self->{'_mdev'} && $self->{'_master_set_function'} && $action ne $self->{'_master_set_function'})
    {
	$self->writedebug("Do nothing as master_set_function is not '$action'") if ($self->debug > 1);
	return undef;
    }
    if ($self->{'_dev'} && $self->{'_device_set_function'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with value $flow") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	my $res = $spline->value($flow);
	$self->writedebug("Result of spline conversion: $res") if ($self->debug > 1);
	## Set value
	no strict "refs";
	my $fnref = $self->{'_device_set_function'};
	return $self->$fnref($res,@_);
    }
    if ($action && $action eq 'set' && $self->{'_mdev'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
        return $self->set($flow,@_);
    }
    if ($action && $action eq 'set_noinfo' && $self->{'_mdev'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
        return $self->set_noinfo($flow,@_);
    }
    ### Handle setflow from gasses ####
    if ($action && $action eq 'setflow' && $self->{'_mdev'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
        return $self->set($flow,@_);
    }
}


sub test_string
{
    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);
    $self->init();
    my @arr = ();
    my $string = 'Spline output device '.$self->name.': ';
    my $val = $self->device->read($data);
    push @arr,'Value: '.$val;
    $string .= join(', ',@arr)."\n";
    return $string;
}

sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,$self->{'_dev'}->print_config();
    push @arr,'Spline_table: '.$self->{'_spline'};
    return join(', ',@arr);
}

sub read
{
    my $self = shift;
    if (@_)
    {
	return $self->device->read(@_);
    }
    else
    {
	my $data = RFC::Cache->new();
	return $self->device->read($data);
    }
}

sub set($)
{
    my $self = shift;
    my $val = shift;
    $self->init();
    return $self->{'_dev'}->set($val) unless ($self->{'_spline'});
    if (defined($val) && $val =~ /([\d\.\-\+eE]+)/)
    {
	$val = $1+0;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with walue $val") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	my $res = $spline->value($val);
	$self->writedebug("Result of spline conversion: $res") if ($self->debug > 1);
	return $self->{'_dev'}->set($res,@_);
    }
    $self->writedebug("Undefined value recieved for setting device") if ($self->debug);
    return undef;
}

sub setflow($)
{
    my $self = shift;
    my $val = shift;
    $self->init();
    return $self->{'_dev'}->set($val) unless ($self->{'_spline'});
    if (defined($val) && $val =~ /([\d\.\-\+eE]+)/)
    {
	$val = $1+0;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with walue $val") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	my $res = $spline->value($val);
	$self->writedebug("Result of spline conversion: $res") if ($self->debug > 1);
	return $self->{'_dev'}->setflow($res,@_);
    }
    $self->writedebug("Undefined value recieved for setting device") if ($self->debug);
    return undef;
}

package RFC::SPIODEV;
use RFC::Header;
our @ISA = qw(RFC::Filter);


sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'IO_spline_device';
    $self->{'_setup_tags'} = ['class','mode','input_spline','output_spline','device_type','device','device_set_function','title','read_function','master_device_type','master_device','master_set_function','slave_flow','show_plot'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_desc'} = {
	'class' => 'Device class',
        'mode' => 'Device control mode',
	'device_type' => 'Type of raw device',
        'device' => 'Raw device',
        'title' => 'Optional title',
	'master_set_function' => 'Function which triggers a forward response. If no functin name is specified all calls will be forwarded.',
	'device_set_function' => 'Function to call on the encapsulated device. If no functin name is specified all calls will be forwarded to the set or setflow command.',
        'input_spline' => 'Spline table used for read operation',
        'output_spline' => 'Spline table used for set operation',
        'read_function' => 'Device function to use for read operations',
	'master_device_type' => 'Device type for the master device in case current device is a slave device (locked to have X percent of master device setpoint)',
        'master_device' => 'Device name for the master device in case current device is a slave device (locked to have X percent of master device setpoint)',
        'slave_flow' => 'Percentage of master device setpoint that current device is supposed to have',
    };
    $self->{'_default'} = {
	'class' => 'IO_spline',
        'device_type' => 'analog',
        'device' => '',
	'master_set_function' => '',
	'device_set_function' => '',
        'input_spline' => '',
        'output_spline' => '',
        'read_function' => 'read',
        'slave_flow' => 100,
        'show_plot'=>'Yes',
    };
    bless $self,$class;
    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/);
    }
    if ($self->{'_input_spline'})
    {
	my @list = split(/\s*\,\s*/,$self->{'_input_spline'});
	$self->die("Spline interpolation tables (input) must have at least 2 lines, only one detected!") unless (@list > 1);
    }
    if ($self->{'_output_spline'})
    {
	my @list = split(/\s*\,\s*/,$self->{'_output_spline'});
	$self->die("Spline interpolation tables (output) must have at least 2 lines, only one detected!") unless (@list > 1);
    }
    $self->{'_values_master_device_type'} = ['',$self->rig->list_types_nofilter()];
    my @list = ();
    foreach my $n ($self->rig->avaliable_devices($self->{'_master_device_type'}))
    {
	push @list,$n unless ($n eq $self->name);
    }
    $self->{'_values_master_device'} = ['',@list];
    $self->{'_mdev'} = undef;
    $self->rig->register_device($self->{'_device_type'},$self);
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub readonly()
{
    my $self = shift;
    return $self->{'_readonly'};
}


sub mode()
{
    my $self = shift;
    return $self->device->mode();
}

sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    $self->{'_mdev'}->Accept($visitor);
    $visitor->VisitComplex($self);
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}

sub local_init()
{
    my $self = shift;
    if ($self->{'_master_device'})
    {
	my $dev = $self->rig->init_device($self->{'_master_device_type'},$self->{'_master_device'});
	$self->die("Could not get a device instance for master device '".$self->{'_master_device'}."' of type '".$self->{'_master_device_type'}."'!") 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 ###
	my @arr = $self->{'_mdev'}->set_names();
        $self->{'_values_master_set_function'} = ['',@arr];
    }
    if ($self-> {'_dev'})
    {
	$self->{'_dev'}->set_readonly();
	my @arr = $self->{'_dev'}->set_names();
        $self->{'_values_device_set_function'} = ['',@arr];
    }
    return $self;
}

sub observe()
{
    my $self = shift;
    my $action = shift;
    if ($self->{'_mdev'} && $self->{'_master_set_function'} && $action ne $self->{'_master_set_function'})
    {
	$self->writedebug("Do nothing as master_set_function is not '$action'") if ($self->debug > 1);
	return undef;
    }
    if ($self->{'_dev'} && $self->{'_device_set_function'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with value $flow") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	my $res = $spline->value($flow);
	$self->writedebug("Result of spline conversion: $res") if ($self->debug > 1);
	## Set value
	no strict "refs";
	my $fnref = $self->{'_device_set_function'};
	return $self->$fnref($flow,@_);
    }
    if ($action && $action eq 'set' && $self->{'_mdev'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
        return $self->set($flow,@_);
    }
    if ($action && $action eq 'set_noinfo' && $self->{'_mdev'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
        return $self->set_noinfo($flow,@_);
    }
    ### Handle setflow from gasses ####
    if ($action && $action eq 'setflow' && $self->{'_mdev'})
    {
        my $flow = shift;
        $flow = $flow * $self->{'_slave_flow'} / 100;
        return $self->set($flow,@_);
    }
}


sub test_string
{
    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 @arr = ();
    $self->init();
    my $string = 'Spline input-output device '.$self->name.': ';
    my $raw = $self->{'_dev'}->read_named($self->{'_read_function'},$data);
    my $val = $self->read($data);
    push @arr,'Raw read: '.$raw;
    push @arr,'Calculated value: '.$val;
    $string .= join(', ',@arr)."\n";
    return $string;
}


sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,$self->{'_dev'}->print_config();
    push @arr,'Spline_input_table: '.$self->{'_input_spline'};
    push @arr,'Spline_output_table: '.$self->{'_output_spline'};
    return join(', ',@arr);
}

sub setflow()
{
    my $self = shift;
    my $val = shift;
    $self->init();
    return $self->{'_dev'}->set($val) unless ($self->{'_output_spline'});
    if (defined($val) && $val =~ /([\d\.\-\+eE]+)/)
    {
	$val = $1+0;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with walue $val") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_output_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	my $res = $spline->value($val);
	$self->writedebug("Result of spline conversion: $res") if ($self->debug > 1);
	$self->{'_dev'}->setflow($res,@_);
	### Return a fresh read to handle reverse spline information ###
	return $self->read();
    }
    $self->writedebug("Undefined value recieved for setting device") if ($self->debug);
    return undef;   
}

sub set($)
{
    my $self = shift;
    my $val = shift;
    $self->init();
    return $self->{'_dev'}->set($val) unless ($self->{'_output_spline'});
    if (defined($val) && $val =~ /([\d\.\-\+eE]+)/)
    {
	$val = $1+0;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with walue $val") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_output_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	my $res = $spline->value($val);
	$self->writedebug("Result of spline conversion: $res") if ($self->debug > 1);
	$self->{'_dev'}->set($res,@_);
	### Return a fresh read to handle reverse spline information ###
	return $self->read();
    }
    $self->writedebug("Undefined value recieved for setting device") if ($self->debug);
    return undef;
}

sub read
{
    my $self = shift;
    $self->init();
    my $val;
    if (@_)
    {
	$val = $self->device->read_named($self->{'_read_function'},@_);
    }
    else
    {
	my $data = RFC::Cache->new();
	$val = $self->device->read_named($self->{'_read_function'},$data);
    }
    return $val unless ($self->{'_input_spline'});
    if (defined($val) && $val =~ /([\d\.\-\+eE]+)/)
    {
	$val = $1+0;
	### Do spline conversion here ###
	$self->writedebug("Doing spline conversion for $self with walue $val") if ($self->debug > 1);
	my @list = split(/\s*\,\s*/,$self->{'_input_spline'});
	my $spline = RFC::Spline->new(join("\n",@list));
	$spline->debug($self->debug);
	return $spline->value($val);
    }
    $self->writedebug("Undefined result recieved from device") if ($self->debug);
    return undef;
}

return 1;
