package RFC::Logic;
#$Id: Logic.pm,v 1.48 2019/03/24 08:53:10 sqko Exp $
#################################################################
#
#
#       RFC::Logic
#
#
# The RFC::Logic module defines a list of virtual logical devices
# Each of the devices implements one of the logical operators
# AND, OR, XOR etc.
#
# A logic device operates on logical inputs from RFC::BaseDevice 
# derived devices where the boolean value can be sensibly derived
# (by using the bool() member function).
# The device classes where this is the case are: logical
# devices, relay devices, gas devices and the special filter device 
# 'Schmidt trigger' which converts a floating point value to a 
# logical value based on specific threshold values.
#
# A RFC::Logic derived device can have from 1 to 9 inputs and an 
# optional single output device. The output device must be a relay 
# device type and is intended to convey the result of one or more
# logical operations to the actual control system. 
#
# As RFC::Logic devices are virtual, they are not included in the 
# normal datalogging (and accordingly readstring_ignore(1) is set
# uppon device instantiation). However they must be enabled
# in the rig configuration to work properly.
#
# Interdevice control flow is implemented by the obsever pattern.
# This ensures that input devices does not need to know that they 
# are used as inputs to logic devices ad any set() or set_noinfo()
# command exeuted on a relay device automatically forces ay logic
# device using this as an input to get updated (and potentially
# forcing updates on logic devices further 'down the chain' to be
# updated).
#
# Notice however that great care must be taken when including logic 
# devices as it is easy to configure a situation where circular 
# references will occour (essentially causing Perl's version of
# a stack overflow).
#
# Thus it is recommended that if logic devices is to be included in 
# a rig's control system, make a detailed schematic of the control
# flow diagram with unique names of each individual logic gate
# thus ensuring that the correct inputs and gate names are chosen
# when configuring the rig.
#
#
# A special Logic device is the RFC::Modulus device which returns the
# result of the modulus operation:
#
# 0 mod 2 = 0
#
# 1 mod 2 = 1
#
# 2 mod 2 = 0
#
# This device can be used to turn a single integer value into logical
# values for controling several relays (each with a different modulus 
# device in the command chain)
# Thus a single manual gas or manual relay (which also can be set to values 
# other than 0 and 1) can be used to set logical internal or external
# states.
#
#################################################################


use strict;
use warnings;
use RFC::Header;
use RFC::BaseDevice;
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 $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'Generic logic device'; 
    $self->{'_setup_tags'} = ['class','mode','inputs','output_device'];
    $self->{'_reload_tags'} = ['class','mode','device_type'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_desc'} = {
        'mode' => 'Device control mode',
	'inputs' => 'number of inputs',
        'output_device' => 'Relay device for output (optional if current device is used in a logic chain)',
    };
    $self->{'_default'} = {
	'mode' => 'Logic',
	'inputs' => 2,
	'device_type' => 'relay',
    };
    bless $self,$class;
    $self->{'_values_class'} = [RFC::Device::list_Logic()];
    $self->{'_values_inputs'} = [2];
    $self->{'_values_mode'} = ['Logic'];
    $self->{'_section'} = 'Logic_'.$self->name;
    foreach my $tag ($self->setup_tags,'device_type')
    {
        $self->{'_'.$tag} = $self->get_default($tag);
        my $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    }
    my @list = ();
    ### Load list of relays for output list ###
    foreach ($self->rig->avaliable_devices('relay'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_output_device'} = ['',@list];
    @list = ();
    ### Load list of devices for inputs ###
    foreach ($self->rig->avaliable_devices($self->{'_device_type'}))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    if ($self->{'_device_type'} && $self->{'_output_device'})
    {
        ### get device if it already exist ###
        my $dev = $self->rig->get_device($self->{'_device_type'},$self->{'_output_device'});
	if ($dev)
	{
	    $self->{'_dev'} = $dev;
	    $dev->set_readonly();
	}
    }
    ### Include any Logic devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('logic'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any gas devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('gas'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Schmidt trigger filter devices as possible inputs ###
    foreach my $n ($self->rig->avaliable_devices('filter'))
    {
	my $class = $rig->get_cv('filter_'.$n,'class');
	next unless ($class && $class eq 'Schmidttrigger');
        push @list,$n unless ($n eq $self->name()); ## Do not include self ##
    }
    ### Remove any duplicates in list (may happen as logic devices register as relays) ###
    my %hash = ();
    foreach (@list)
    {
	$hash{$_} = 1;
    }
    @list = ();
    foreach my $key (sort keys %hash)
    {
	push @list,$key;
    }
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = 'input_device_'.$x;
	push @{$self->{'_setup_tags'}},$tag;
	$tag = 'reverse_input_'.$x;
	push @{$self->{'_setup_tags'}},$tag;
	$self->{'_desc'}->{$tag} = 'Indicates if value of input '.$x.' should be inverted before logic operation';
	$self->{'_default'}->{$tag} = 'No';
        $self->{'_'.$tag} = 0;
        my $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = 1 if (defined($conf) && $conf =~ /yes/i);
	$self->{'_values_'.$tag} = ['No','Yes'];
	$tag = 'input_device_'.$x;
        $self->{'_'.$tag} = $self->get_default($tag);
        $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
	$self->{'_desc'}->{$tag} = 'Input device '.$x;
	$self->{'_values_'.$tag} = ['',@list];
    }
    $self->rig->register_device('relay',$self);
    ## Note logic devices should never be logged ###
    $self->readstring_ignore(1);
    $self->{'_readonly'} = 1;
    $self->{'_info_string'} = 'Note that logic devices only works correctly if they are included (enabled)';
    ### Note, do NOT run init as part of constructor! ###
    return $self;
}

sub setup_tags()
{
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_setup_tags'}} if ($self->{'_setup_tags'});
    return (@res,'comments');
}



sub init()
{
    my $self = shift;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	next if ($self->{'_dev_'.$x}); 
	my $tag = '_input_device_'.$x;
	my $dev = $self->rig->get_device($self->{'_device_type'},$self->{$tag});
	$dev = $self->rig->get_device('logic',$self->{$tag}) unless ($dev);
	$dev = $self->rig->get_device('gas',$self->{$tag}) unless ($dev);
	$dev = $self->rig->get_device('filter',$self->{$tag}) unless ($dev);
	unless ($dev)
	{
	    $dev = $self->rig->init_device($self->{'_device_type'},$self->{$tag});
	    $dev = $self->rig->init_device('logic',$self->{$tag}) unless ($dev);
	    $dev = $self->rig->init_device('gas',$self->{$tag}) unless ($dev);
	    $dev = $self->rig->init_device('filter',$self->{$tag}) unless ($dev);
	    $dev->readstring_ignore(1) if ($dev);
	}
	if ($dev)
	{
	    $dev->debug($self->debug);
	    $self->{'_dev_'.$x} = $dev; 
	    $dev->attatch_observer(\$self);
	}
	$self->die("Could not initialise Logic device of type '".$self->{'_device_type'}."' with name: '".$self->{'_device'}."'") unless ($self->{'_dev_'.$x});
    }
    unless ($self->{'_dev'})
    {
	my $tag = '_output_device';
	my $dev = $self->rig->get_device('relay',$self->{$tag});
	unless ($dev)
	{
	    $dev = $self->rig->init_device('relay',$self->{$tag});
	    $dev->readstring_ignore(1) if ($dev);
	}
	if ($dev)
	{
	    $dev->debug($self->debug);
	    $self->{'_dev'} = $dev; 
	    $dev->set_readonly();
	}
    }
    return $self;
}


sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = '_dev_'.$x;
	$self->{$tag}->Accept($visitor) if ($self->{$tag});
    }
    $visitor->VisitComplex($self);
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}



sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = '_dev_'.$x;
	push @arr,'Input device '.$x.': '.$self->{$tag}->print_config() if ($self->{$tag});
    }
    push @arr,'Output device: '.$self->{'_dev'}->print_config() if ($self->{'_dev'});
    return join(', ',@arr);
}


sub local_init()
{
    #### Stub function intended for loverloading for any impelmention dependent initialisations ###
    my $self = shift;
    return $self;
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    ### allow call to get 'mode' for undefined devices ###
    return 'Automatic' if ($tag eq 'mode');
    return 'relay' if ($tag eq 'device_type');
}

sub observe($$)
{
    my $self = shift;
    my $action = shift; ## Must always be 'set' or 'set_noinfo' as logic devices emulates relays;
    my $value = shift;
    $self->set($value) if ($action eq 'set');
    $self->set_noinfo($value) if ($action eq 'set_noinfo');
}


sub set($)
{
    my $self = shift;
    my $res = shift;
    my $val = $self->read();
    $self->notify('set',$val,@_);
    $self->{'_dev'}->set($val) if ($self->{'_dev'});
    return $res;
}

sub set_noinfo($)
{
    my $self = shift;
    my $res = shift;
    my $val = $self->read();
    $self->notify('set_noinfo',$val,@_);
    $self->{'_dev'}->set_noinfo($val) if ($self->{'_dev'});
    return $res;
}

sub read()
{
    my $self = shift;
    $self->init();
    ### The default Logic device always returns 1 on read.... ###
    return 1;
}

sub test()
{
    my $self = shift;
    $self->init();
    my $res = 1;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = '_dev_'.$x;
	$res = 0 unless ($self->{$tag}->test);
    }
    return $res;
}

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 $type = $self->type();
    push @arr, 'Logic device "'.$self->name.'" of type "'.$type.'": ';
    my $val = $self->read($data);
    push @arr,'Value: '.$val;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = '_dev_'.$x;
	my $val = $self->{$tag}->bool($data);
#	$val = !$val if ($self->{'_reverse_input_'.$x});
	my $str = $self->{$tag}->test_string($data);
	chomp $str;
	push @arr,'Input device '.$x.': Boolean value: '.$val.' , '.$str;
    }
    push @arr,'Output device: '.$self->{'_dev'}->test_string($data) if ($self->{'_dev'});
    my $string .= join("\n",@arr)."\n";
    return $string;
}

package RFC::Logic_AND;
our @ISA = qw(RFC::Logic);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'AND logic device';
    $self->{'_default'}->{'class'} = 'AND';
    $self->{'_values_inputs'} = [2,3,4,5,6,7,8,9];
    return $self;
}

sub read
{
    my $self = shift;
    $self->init();
    my $res = 1;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = '_dev_'.$x;
	my $val = $self->{$tag}->bool(@_);
	$val = !$val if ($self->{'_reverse_input_'.$x});
	unless ($val)
	{
	    $res = 0;
	    last;
	}
    }
    return $res;
}

package RFC::Logic_NAND;
our @ISA = qw(RFC::Logic_AND);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'NAND logic device';
    $self->{'_default'}->{'class'} = 'NAND';
    return $self;
}

sub read
{
    my $self = shift;
    my $val = $self->SUPER::bool(@_);
    if ($val)
    {
	$val = 0;
    }
    else
    {
	$val = 1;
    }
    return $val;
}



package RFC::Logic_OR;
our @ISA = qw(RFC::Logic);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'OR logic device';
    $self->{'_default'}->{'class'} = 'OR';
    $self->{'_values_inputs'} = [2,3,4,5,6,7,8,9];
    return $self;
}

sub read
{
    my $self = shift;
    $self->init();
    my $res = 0;
    for (my $x = 0; $x < $self->{'_inputs'}; $x++)
    {
	my $tag = '_dev_'.$x;
	my $val = $self->{$tag}->bool(@_);
	$val = !$val if ($self->{'_reverse_input_'.$x});
	if ($val)
	{
	    $res = 1;
	    last;
	}
    }
    return $res;
}

package RFC::Logic_NOR;
our @ISA = qw(RFC::Logic_OR);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'NOR logic device';
    $self->{'_default'}->{'class'} = 'NOR';
    return $self;
}

sub read
{
    my $self = shift;
    my $val = $self->SUPER::bool(@_);
    if ($val)
    {
	$val = 0;
    }
    else
    {
	$val = 1;
    }
    return $val;
}


package RFC::Logic_XOR;
our @ISA = qw(RFC::Logic);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'XOR logic device';
    $self->{'_default'}->{'class'} = 'XOR';
    $self->{'_values_inputs'} = [2];
    return $self;
}

sub read
{
    my $self = shift;
    $self->init();
    my $val0 = $self->{'_dev_0'}->bool(@_);
    $val0 = !$val0 if ($self->{'_reverse_input_0'});
    my $val1 = $self->{'_dev_1'}->bool(@_);
    $val1 = !$val1 if ($self->{'_reverse_input_1'});
    my $res = 1;
    $res = 0 if ($val0 == $val1);
    return $res;
}

package RFC::Logic_NXOR;
our @ISA = qw(RFC::Logic_XOR);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'NXOR logic device';
    $self->{'_default'}->{'class'} = 'NXOR';
    return $self;
}

sub read
{
    my $self = shift;
    my $val = $self->SUPER::bool(@_);
    if ($val)
    {
	$val = 0;
    }
    else
    {
	$val = 1;
    }
    return $val;
}


package RFC::Logic_NOT;
our @ISA = qw(RFC::Logic);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'NOT logic device';
    $self->{'_setup_tags'} = ['class','mode','input_device_0','output_device'];
    $self->{'_default'} = {
	'mode' => 'Logic',
	'class' => 'NOT',
    };
    $self->{'_inputs'} = 1;
    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/);
    }
    my @list = ();
    foreach ($self->rig->avaliable_devices($self->{'_device_type'}))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Logic devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('logic'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any gas devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('gas'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Schmidt trigger devices as possible inputs ###
    foreach my $n ($self->rig->avaliable_devices('filter'))
    {
	next unless ($n);
	my $d = $self->rig->init_device('filter',$n);
	next unless ($d);
	next unless ($d->type eq 'Schmidt trigger latch');
        push @list,$n unless ($n eq $self->name()); ## Do not include self ##
    }
    ### Remove any duplicates in list (may happen as logic devices register as relays) ###
    my %hash = ();
    foreach (@list)
    {
	$hash{$_} = 1;
    }
    @list = ();
    foreach my $key (sort keys %hash)
    {
	push @list,$key;
    }
    my $tag = 'input_device_0';
    $self->{'_'.$tag} = $self->get_default($tag);
    my $conf = $self->get_conf($tag);
    $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    $self->{'_desc'}->{$tag} = 'Input device';
    $self->{'_values_'.$tag} = ['',@list];
    delete($self->{'_dev_1'});
    return $self;
}

sub read
{
    my $self = shift;
    $self->init();
    my $val0 = $self->{'_dev_0'}->bool(@_);
    $val0 = !$val0 if ($self->{'_reverse_input_0'});
    my $res = 1;
    $res = 0 if ($val0);
    return $res;
}



package RFC::Logic_Buffer;
our @ISA = qw(RFC::Logic);


sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'Buffer logic device';
    $self->{'_setup_tags'} = ['class','mode','input_device_0','output_device'];
    $self->{'_default'} = {
	'mode' => 'Logic',
	'class' => 'Buffer',
    };
    $self->{'_inputs'} = 1;
    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/);
    }
    my @list = ();
    foreach ($self->rig->avaliable_devices($self->{'_device_type'}))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Logic devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('logic'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any gas devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('gas'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Schmidt trigger devices as possible inputs ###
    foreach my $n ($self->rig->avaliable_devices('filter'))
    {
	next unless ($n);
	my $d = $self->rig->init_device('filter',$n);
	next unless ($d);
	next unless ($d->type eq 'Schmidt trigger latch');
        push @list,$n unless ($n eq $self->name()); ## Do not include self ##
    }
    ### Remove any duplicates in list (may happen as logic devices register as relays) ###
    my %hash = ();
    foreach (@list)
    {
	$hash{$_} = 1;
    }
    @list = ();
    foreach my $key (sort keys %hash)
    {
	push @list,$key;
    }
    my $tag = 'input_device_0';
    $self->{'_'.$tag} = $self->get_default($tag);
    my $conf = $self->get_conf($tag);
    $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    $self->{'_desc'}->{$tag} = 'Input device';
    $self->{'_values_'.$tag} = ['',@list];
    delete($self->{'_dev_1'});
    return $self;
}

sub read
{
    my $self = shift;
    $self->init();
    my $val0 = $self->{'_dev_0'}->bool(@_);
    $val0 = !$val0 if ($self->{'_reverse_input_0'});
    my $res = 0;
    $res = 1 if ($val0);
    return $res;
}


package RFC::Modulus;
our @ISA = qw(RFC::Logic);

sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{'_type'} = 'Arithmetic Modulus device';
    $self->{'_setup_tags'} = ['class','mode','device_type','input_device_0','divisor','offset','boolean_output','reverse_output','output_device','title','show_plot'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_reload_tags'} = ['class','mode','device_type','boolean_output'];
    $self->{'_desc'} = {
        'class' => 'Device class',
        'mode' => 'Device control mode',
        'input_device_0' => 'Raw device',
	'device_type' => 'Input device type',
	'offset' => 'Integer offset added to input before modulus operation',
        'divisor' => 'Divisor for modulus operation, must be an integer!',
        'boolean_output' => 'Force output to be either 0 or 1. For normal modular arithmetic, the result of the reminder (0 to n-1), but if this key is set to yes, any non-zero value will be set to 1 (thus output can be directly used for relay operations)',
        'reverse_output' => 'Indicates if the locgical output state should be reversed. Only avaliable if boolean_output is set to yes',
        'title' => 'Optional title',
        'output_device' => 'Relay device for output (optional)',
	};
    $self->{'_default'} = {
        'class' => 'Modulus',
        'device' => '',
	'device_type' => 'relay',
        'mode' => 'Readonly',
        'divisor' => 2,
	'offset' => 0,
        'boolean_output' => 'yes',
        'show_plot'=>'Yes',
        'reverse_output' => 'No',
    };
    bless $self,$class;
    $self->{'_inputs'} = 1;
    $self->{'_readonly'} = 1;
    $self->{'_mode'} = 'Automatic';
    $self->{'_info_string'} = '';
    $self->load_conf();
    if ($self->{'_boolean_output'} !~ /yes/i)
    {
        $self->{'_setup_tags'} = ['class','mode','device_type','input_device_0','divisor','offset','boolean_output','output_device','title','show_plot'];
    }
    my $div = $self->{'_divisor'};
    $self->die("Divisor must be a positive integer (value '$div' not allowed)\n") unless ($div && $div > 0 && $div == int($div));
    $self->{'_values_device_type'} = ['',$self->rig->list_types_nofilter()];
    $self->{'_values_boolean_output'} = ['Yes','No'];
    $self->{'_values_reverse_output'} = ['Yes','No'];
    $self->{'_inputs'} = 1;
    my @list = ();
    foreach ($self->rig->avaliable_devices($self->{'_device_type'}))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Logic devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('logic'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any gas devices as possible inputs ###
    foreach ($self->rig->avaliable_devices('gas'))
    {
	next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    ### Include any Schmidt trigger devices as possible inputs ###
    foreach my $n ($self->rig->avaliable_devices('filter'))
    {
	next unless ($n);
	my $d = $self->rig->init_device('filter',$n);
	next unless ($d);
	next unless ($d->type eq 'Schmidt trigger latch');
        push @list,$n unless ($n eq $self->name()); ## Do not include self ##
    }
    ### Remove any duplicates in list (may happen as logic devices register as relays) ###
    my %hash = ();
    foreach (@list)
    {
	$hash{$_} = 1;
    }
    @list = ();
    foreach my $key (sort keys %hash)
    {
	push @list,$key;
    }
    my $tag = 'input_device_0';
    $self->{'_'.$tag} = $self->get_default($tag);
    my $conf = $self->get_conf($tag);
    $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    $self->{'_desc'}->{$tag} = 'Input device';
    $self->{'_values_'.$tag} = ['',@list];
    delete($self->{'_dev_1'});
    return $self;
}

sub read
{
    my $self = shift;
    return -32768 unless ($self->{'_dev_0'});
    my $value = $self->{'_dev_0'}->read(@_) + $self->{'_offset'};
    my $n = $self->{'_divisor'};
    $n = 1 unless ($n);
    my $res = $value % $n;
    if ($self->{'_boolean_output'} =~ /yes/i)
    {
        $res = 1 if ($res != 0);
        if ($self->{'_reverse_output'} =~ /yes/i)
        {
            if ($res)
            {
                $res = 0;
            }
            else
            {
                $res = 1;
            }
        }
    }
    return $res;
}

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

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

sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'Divisor: '.$self->{'_divisor'};
    push @arr,'Input offset: '.$self->{'_offset'};
    push @arr,'Boolean output: '.$self->{'_boolean_output'};
    push @arr,'Reverse output: '.$self->{'_reverse_output'} if ($self->{'_boolean_output'} =~ /yes/i);
    push @arr,'Input device: '.$self->{'_dev_0'}->print_config();
    push @arr,'Output device: '.$self->{'_dev'}->print_config() if ($self->{'_dev'});
    return join(', ',@arr);
}


sub observe($$)
{
    my $self = shift;
    my $action = shift;
    my $value = shift;
    ### Overloads all actions to set / set_noinfo ##
    if ($action =~ /noinfo/)
    {
	return $self->set_noinfo($value);
    }
    else
    {
	return $self->set($value);
    }
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    ### allow call to get 'mode' for undefined devices ###
    return 'Automatic' if ($tag eq 'mode');
}

return 1;
