package RFC::CalTemp;
#$Id: CalTemp.pm,v 1.7 2025/06/13 08:30:36 sqko Exp $
use strict;
use warnings;
use SocketClient;

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_controler($@)
{
    my $type = shift;
    my $id = undef;
    $_ = $type;
    CASE:
    {
        /CAL3300/ and do {$id = CAL3300->new(@_); last CASE};
	/CAL9300/ and do {$id = CAL9300->new(@_); last CASE};
	/CAL9400/ and do {$id = CAL9400->new(@_); last CASE};
	/CAL9500/ and do {$id = CAL9500->new(@_); last CASE};
    }
    return $id;
}

sub get_list()
{
    #### Returns a list of known controler types ###
    return ('CAL3300','CAL9300','CAL9400','CAL9500');
}

############################################################################
###  Class definitions for use with Cal temperature controlers          ####
###  The interface is always degrees celsius for setpoints and          ####
###  degrees celsius/hour for ramprates!                                ####
###  The internal conversions within the classes manage the differences ####
###  between the different types of controlers                          ####
###  Note that the base class Eurotherm does not do any conversion what ####
###  so ever, it merely reports the direct responses from the           ####
### controler. Thus the base class should normally nt be used directly! #### 
############################################################################

sub new
{
    my $class = shift;
    my $self = {
        '_type' => 'DEFAULT',
        '_tty' => shift,
        '_address' => shift,
        '_ramp' => undef,
        '_temp' => undef,
        '_atemp' => undef,
        '_aset' => undef
	};
    bless $self, $class;
    $self->{'_errcodes'} = {
	2 => 'Variable address error',
	3 => 'Variable data error',
	4 => 'Operation error or permission denied',
    };
    return $self;
}

sub name
{
    my $self = shift;
    return $self->{'_type'};
}


sub modbus_int_read
{
    my $self = shift;
    my $tag = hex(shift);
    my $res = serial_client_raw($self->{'_tty'},'cal_temp','r',$self->{'_address'},$tag);
    $res = serial_client_raw($self->{'_tty'},'cal_temp','r',$self->{'_address'},$tag) unless ($res);
    if ($res && $res =~ /[\s\t]+(\d+)[\s\t]*$/)
    {
	return $1;
    }
    if ($res && $res =~ /code[\s\t]+(\d+)/)
    {
	my $err = $self->{'_errcodes'}{$1};
	die "Error communicating with controler at address $self->{'_address'} on tty $self->{'_tty'}. Error: $err\n";
    }
    else
    {
	die "Error communicating with controler at address $self->{'_address'} on tty $self->{'_tty'}. No response\n";
    }
}

sub modbus_int_send
{
    my $self = shift;
    my $tag = hex(shift);
    my $val = shift;
    my $res = serial_client_raw($self->{'_tty'},'cal_temp','ws',$self->{'_address'},$tag,$val);
    if ($res && $res =~ /[\s\t]+(\d+)[\s\t]*$/)
    {
	return $1;
    }
    if ($res && $res =~ /code[\s\t]+(\d+)/)
    {
	my $err = $self->{'_errcodes'}{$1};
	die "Error communicating with controler at address $self->{'_address'} on tty $self->{'_tty'}. Error: $err\n";
    }
}

sub get_temp
{
    my $self = shift;
    $self->{'_temp'} = undef;
    $self->{'_temp'} = $self->modbus_int_read('0x007F') / 10;
    return $self->{'_temp'};
}

sub get_ramp
{
    my $self = shift;
    $self->{'_ramp'} = undef;
    my $ramp = $self->modbus_int_read('0x02D0') / 10;
    $self->{'_ramp'} = $ramp;
    return $self->{'_ramp'};
}

sub get_active_setpoint
{
    ## Cal temperature controlers do not have active setpoint, returning temperature istead
    my $self = shift;
    $self->{'_aset'} = undef;
    $self->{'_aset'} = $self->modbus_int_read('0x001C') / 10;
    return $self->{'_aset'};
}

sub get_active_temp
{
    my $self = shift;
    $self->{'_atemp'} = undef;
    $self->{'_atemp'} = $self->modbus_int_read('0x001C') / 10;
    return $self->{'_atemp'};
}

sub set_temp
{
    my $self = shift;
    $self->{'_temp'} = shift;
    return $self->send_temp();
}


sub activate_temp()
{
    my $self = shift;
    my $val = $self->modbus_int_read('0x0125');
    unless ($val & 0x2)
    {
	$val = $val | 0x02;
	$self->modbus_int_send('0x0125',$val);
    }
}

sub send_temp
{
    my $self = shift;
    $self->modbus_int_send('0x007F',$self->{'_temp'} * 10);
    my $t = $self->get_temp();
    unless ($t == $self->{'_temp'})
    {
	$self->modbus_int_send('0x007F',$self->{'_temp'} * 10);
	$t = $self->get_temp();
	unless ($self->{'_temp'} == $t)
	{
	    die "Error communicating with controler at address $self->{'_address'} on tty $self->{'_tty'}. Recieved: '$t', expected '".$self->{'_temp'}."'\n";
	    return undef;
	}
    }
    $self->activate_temp();
    return $self->{'_temp'};
}


sub set_ramp
{
    my $self = shift;
    my $ramp = shift;
    $self->{'_ramp'} = $ramp;
    $self->{'_ramp'} = 1 if ($self->{'_ramp'} < 1);
    return $self->send_ramp();
}

sub send_ramp
{
    my $self = shift;
    $self->{'_ramp'} = sprintf("%.1f",$self->{'_ramp'});  ## Round ramprate to 1 decimal place ###
    $self->modbus_int_send('0x02D0',$self->{'_ramp'} * 10);
    my $t = $self->get_ramp();
    unless ($t == $self->{'_ramp'})
    {
	$self->modbus_int_send('0x02D0',$self->{'_ramp'} * 10);
	$t = $self->get_ramp();
	unless ($self->{'_ramp'} == $t)
	{
	    die "Error communicating with controler at address $self->{'_address'} on tty $self->{'_tty'}. Recieved: '$t', expected '".$self->{'_ramp'}."'\n";
	    return undef;
	}
    }
    return $self->{'_ramp'};
}

sub get_power()
{
    my $self = shift;
    ## Can not return output power
    return -32768;
}


######################
##                  ##
##  End base class  ##
##                  ##
######################


package CAL3300;

our @ISA = qw(RFC::CalTemp);

sub new
{
    my $type = shift;
    my $self = $type->SUPER::new(@_);
    bless $self, $type;
    $self->{'_type'} = 'Cal3300';
    return $self;
}

package CAL9300;

our @ISA = qw(RFC::CalTemp);

sub new
{
    my $type = shift;
    my $self = $type->SUPER::new(@_);
    bless $self, $type;
    $self->{'_type'} = 'Cal3300';
    return $self;
}

package CAL9400;

our @ISA = qw(RFC::CalTemp);

sub new
{
    my $type = shift;
    my $self = $type->SUPER::new(@_);
    bless $self, $type;
    $self->{'_type'} = 'Cal9400';
    return $self;
}

package CAL9500;

our @ISA = qw(RFC::CalTemp);

sub new
{
    my $type = shift;
    my $self = $type->SUPER::new(@_);
    bless $self, $type;
    $self->{'_type'} = 'Cal9500';
    return $self;
}

sub modbus_int_send
{
    my $self = shift;
    my $tag = hex(shift);
    my $val = shift;
    my $res = serial_client_raw($self->{'_tty'},'cal_temp','w',$self->{'_address'},$tag,$val);
    if ($res && $res =~ /[\s\t]+(\d+)[\s\t]*$/)
    {
	return $1;
    }
    if ($res && $res =~ /code[\s\t]+(\d+)/)
    {
	my $err = $self->{'_errcodes'}{$1};
	die "Error communicating with controler at address $self->{'_address'} on tty $self->{'_tty'}. Error: $err\n";
    }
}

