package RFC::Typecast;
#$Id: Typecast.pm,v 1.28 2022/09/15 08:43:14 sqko Exp $
#################################################################
#
#
#       RFC::Typecast
#
#
# The RFC::Typecast is a special filter device. 
# It can convert one underlying device to an other type.
# 
# Typcast devices should not normally be nescesarry, but in specific 
# cases it may be nescesarry to do a typecast.
#
# Typecast devices have a simplified interface as they only implement
# the BaseDevice classes.
#
# An exception to this is the notify function which allows the conversion
# of the originating command to the one specified by the 'notify_function'
# value. Default is the 'set' command.
#
# The possible values for this variable is determined by inspecting any
# devices attatched to the Typecast device. If (one or more) attatched 
# devices are found, the first device is asked for potential notify 
# functions by calling the list_set_functions() on it.
#
# As opposed to most other devices, the readstring function simply returns
# the empty string as the value of the typecast device will be equal to the
# unederlying device.
#
# -- A special Typecast device is the RFC::TypecastFaraday (accessed as \\
# Typecast_PSU_to_gas), which only accepts RFC::PSU devices as inputs and 
# always masquerade as a RFC::gas device. 
# This device class only forwards 'current' commands but not 'voltage' 
# commands as it only makes sense to convert a current to a gas flow 
# according to Faraday's law of elecrolysis.
#
#
# To obtain a RFC::Typecast instance, call one of the constructiors as
# shown below:
#
# $id = RFC::TypeCastDefault->new($name,$rig);
#
# $id = RFC::TypeCastDefault->new($name,$rig,$input_device,$output_type,[opt $read_function]);
#
# $id = RFC::TypecastFaraday->new($name,$rig);
#
# $id = RFC::Constant->new($name,$rig);
#
# In case the input device and output type is specified, a RFC::Typecast 
# device can be instantiated without it having a soresponding section in
# a RFC::Rig instances configuration. This enables other RFC::BaseDevice derived 
# classes to instantiate RFC::Typecast devices explicitly as part of their own 
# instantiation.
#
# The Constant device is a special typecast device which does not ahve an input or ouptut 
# device, but will register as a device of the output type.
# This device can then be used as an input to an other device (such as a filter, logic or math device)
# Where a constant value is needed (for instance, if a Math::Divide device is used and one needs
# to make sure that the divisor is alway positvie, the input could be passed through a Max device 
# where one input is a constant value device with the value 0.1 and the other is the real input.
# In this case, the value supplied to divicion will never be below 0.1.
#
#################################################################
use strict;
use warnings;
use RFC::Filter;
use RFC::Header;
use RFC::Cache;
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'} = 'Typecast_device';
    $self->{'_setup_tags'} = ['class','mode','device_type','device','output_type','output_device','notify_function'];
    $self->{'_desc'} = {
        'class' => 'Device class',
        'mode' => 'Device control mode',
        'device_type' => 'Type of raw device',
        'device' => 'Raw device',
        'output_type' => 'Type of device to convert to',
        'output_device' => 'Optional output device',
	'notify_function' => 'Function to call on the output device and any listening devices if a notify event is called on current device',
    };
    $self->{'_default'} = {
        'class' => 'Typecast',
        'device_type' => 'simplechannel',
        'output_type' => 'gas',
        'device' => '',
        'output_device' => '',
        'read_function' => 'read',
	'notify_function' => 'set',
	'disable_readstring' => 'Yes',
    };
    bless $self,$class;
    $self->readstring_ignore(0);
    $self->load_conf();
    if (@_)
    {
	$self->{'_dev'} = shift;
	$self->{'_output_type'} = shift;
	$self->{'_read_function'} = shift if (@_);
    }
    $self->{'_read_names'} = ['read'];
    $self->get_set_function_names();
    $self->{'_values_output_type'} = [$self->rig->list_types_nofilter()];
    my @list = ();
    foreach ($self->rig->avaliable_devices($self->{'_output_type'}))
    {
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_output_device'} = ['',@list];
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub setup_tags()
{
    ###############################################
    ### setup_tags()                            ###
    ### Returns a list of acceptable setup tags ###
    ### Can be used by a application to easialy ###
    ### get the setup tags and values           ###
    ###############################################
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_setup_tags'}} if ($self->{'_setup_tags'});
    return (@res,'comments','disable_readstring');
}

sub get_set_function_names()
{
    my $self = shift;
    if ($self->{'_odev'})
    {
	$self->{'_values_notify_function'} = [$self->{'_odev'}->list_set_functions()];
	return;
    }
    my @list = $self->list_observers();
    if (@list)
    {
	$self->{'_values_notify_function'} = [${$list[0]}->list_set_functions()];
    }
    return $self;
}

sub read
{
    my $self = shift;
    return $self->{'_dev'}->read_named($self->{'_read_function'},@_);
}

sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'Input device type: '.$self->{'_device_type'};
    push @arr,$self->{'_dev'}->print_config();
    push @arr,'Output device type: '.$self->{'_output_type'};
    push @arr,$self->{'_odev'}->print_config() if ($self->{'_odev'});
    return join(', ',@arr);
}

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


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 = 'Typecast '.$self->name.': ';
    my $val = $self->read($data);
    push @arr,'Value: '.$val;
    push @arr,'Converts from '.$self->{'_device_type'}.' to '.$self->{'_output_type'};
    push @arr,'Forwarding to '.$self->{'_notify_function'};
    $string .= join(', ',@arr)."\n";
    return $string;
}


sub local_init()
{
    my $self = shift;
    if (!$self->{'_odev'} && $self->{'_output_type'} && $self->{'_output_device'})
    {
        ### get device if it already exist                                          ###
        ### It may have been created after SPDEV constructor ran and call of init() ###
        my $dev = $self->rig->get_device($self->{'_output_type'},$self->{'_output_device'});
        ### Initialise it if it doesn't ###
        unless ($dev)
        {
            $dev = $self->rig->init_device($self->{'_output_type'},$self->{'_output_device'});
            $dev->readstring_ignore(1) if ($dev);
        }
        $self->{'_odev'} = $dev if ($dev);
        $dev->debug($self->debug);
	$dev->set_readonly();
        $self->die("Could not initialise device of type '".$self->{'_output_type'}."' with name: '".$self->{'_output_device'}."'") unless ($self->{'_odev'});
    }
    my @arr = ('');
    my @arr2 = ('');
    if ($self->{'_dev'})
    {
	@arr = $self->{'_dev'}->list_set_functions();
	$self->{'_dev'}->attatch_observer(\$self);
	@arr2 = $self->{'_dev'}->set_names();
    }
    $self->{'_set_fn_names'} = \@arr;
    $self->{'_values_device_set_function'} = ['',@arr2];
    $self->get_set_function_names();
    return $self;
}

sub attatch_observer($)
{
    my $self = shift;
    return &RFC::Observer::attatch_observer($self,@_);
}


sub detatch_observer($)
{
    my $self = shift;
    return &RFC::Observer::detatch_observer($self,@_);
}

sub notify($)
{
    my $self = shift;
    return &RFC::Observer::notify($self,@_);
}

sub observe
{
    my $self = shift;
    $self->init();
    my $cmd = shift;
    ## Exchange notify command with specified function name ##
    $cmd = $self->{'_notify_function'};
    my $res = $self->notify($cmd,@_);
    return $res unless ($self->{'_odev'});
    return $self->{'_odev'}->$cmd(@_);
}


package RFC::TypecastDefault;
our @ISA = qw(RFC::Typecast);

sub new
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    bless $self,$class;
    $self->rig->register_device($self->{'_output_type'},$self);
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}




package RFC::Constant;
our @ISA = qw(RFC::Typecast);

sub new
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    $self->{'_setup_tags'} = ['class','output_type','value'];
    bless $self,$class;
    $self->{'_type'} = 'Constant value';
    $self->{'_mode'} = 'Readonly';
    $self->load_conf();
    ### Constants are not logged ###
    $self->readstring_ignore(1);
    $self->rig->register_device($self->{'_output_type'},$self);
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub setup_tags()
{
    ###############################################
    ### setup_tags()                            ###
    ### Returns a list of acceptable setup tags ###
    ### Can be used by a application to easialy ###
    ### get the setup tags and values           ###
    ###############################################
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_setup_tags'}} if ($self->{'_setup_tags'});
    return (@res,'comments');
}

sub test()
{
    my $self = shift;
    return 1;
}

sub readonly()
{
    my $self = shift;
    return 1;
}

sub read
{
    my $self = shift;
    my $res = $self->{'_value'};
    $res = -32768 unless (defined($res));
    return $res;
}

sub local_init()
{
    my $self = shift;
    return $self;
}

sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'Value: '.$self->read();
    push @arr,'Output device type: '.$self->{'_output_type'};
    return join(', ',@arr);
}


sub test_string
{
    my $self = shift;
    my $data = undef;
    my @arr = ();
    $self->init();
    my $string = 'Constant '.$self->name.': ';
    my $val = $self->read($data);
    push @arr,'Value: '.$val;
    push @arr,'Ouptut type '.$self->{'_output_type'};
    $string .= join(', ',@arr)."\n";
    return $string;
}


package RFC::TypecastFaraday;
our @ISA = qw(RFC::Typecast);


sub new
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'Typecast_device_Faraday';
    $self->{'_device_type'} = 'PSU';
    $self->{'_output_type'} = 'gas';
    $self->{'_setup_tags'} = ['class','mode','device','output_device','title','show_plot'];
    my @list = ();
    foreach ($self->rig->avaliable_devices('gas'))
    {
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_output_device'} = ['',@list];
    @list = ();
    foreach ($self->rig->avaliable_devices('PSU'))
    {
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_device'} = ['',@list];
    $self->{'_info_string'} = 'Note that this device does NOT forward voltage commands!, also note that filter devices used in a control chain only works correctly if they are included (enabled)';
    $self->rig->register_device('gas',$self);
    return $self;
}

sub observe
{
    my $self = shift;
    $self->init();
    my $cmd = shift;
    ### Only pass on current commands as setflow commands (ignore voltage commands) ###
    return undef unless ($cmd eq 'current');
    my $res = $self->notify('setflow',@_);
    return $res unless ($self->{'_odev'});
    return $self->{'_odev'}->setflow(@_);
}

return 1;
