#
# Driver for SIKA TLK43/42/41 controller with RS485 MODBUS-RTU interface
# (over RS232)
#

package Lab::Instrument::TemperatureControl::TLK43;
our $VERSION = '3.510';

use strict;
use Lab::Instrument;
use Lab::Bus::MODBUS_RS232;
use feature "switch";
use Data::Dumper;
use Carp;

our @ISA = ("Lab::Instrument");

our %fields = (
	supported_connections => [ 'MODBUS_RS232' ],
	slave_address => undef,
	connection => undef,

	MemTable => {
		Measurement => 			0x0200,		# measured value
		Decimal => 				0x0201,		# decimal points dP
		CalculatedPower => 		0x0202,		# calculated power
		HeatingPower => 		0x0203,		# available heating power
		CoolingPower => 		0x0204,		# available cooling power
		State_Alarm1 => 		0x0205,		# state of alarm 1
		State_Alarm2 => 		0x0206,		# state of alarm 2
		State_Alarm3 => 		0x0207,		# state of alarm 3
		Setpoint		 =>		0x0208,		# current setpoint
		State_AlarmLBA =>		0x020A,		# state of alarm LBA
		State_AlarmHB =>		0x020B,		# state of alarm HB (heater break)
		CurrentHB_closed =>		0x020C,		# current for HB with closed circuit
		CurrentHB_open =>		0x020D,		# current for HB with open circuit
		State_Controller =>		0x020F,		# state of controller (0: Off, 1: auto. Reg., 2: Tuning, 3: man. Reg.
		PreliminaryTarget =>	0x0290,		# preliminary target value (TLK43)
		AnalogueRepeat =>		0x02A0,		# value to repeat on analogue output (TLK43)

		# SP group (parameters relative to setpoint)
		nSP =>					0x2800,		# number of programmable setpoints
		SPAt =>					0x2801,		# selects active setpoint
		SP1 =>					0x2802,		# setpoint 1
		SP2 =>					0x2803,		# setpoint 2
		SP3 =>					0x2804,		# setpoint 3
		SP4 =>					0x2805,		# setpoint 4
		SPLL  =>				0x2806,		# low setpoint limit
		SPHL =>					0x2807,		# high setpoint limit

		# InP group (parameters relative to the measure input)
		HCFG =>					0x2808,		# type of input with universal input configuration
		SEnS =>					0x2809,		# type of sensor (depends on HCFG)
		rEFL =>					0x2857,		# coefficient of reflection
		SSC =>					0x280A,		# start of scale
		FSC =>					0x280B,		# full scale deflection
		dP =>					0x280C,		# decimal points (for measurement)
		Unit =>					0x280D,		# 0=°C, 1=F
		FiL =>					0x280E,		# digital filter on input (OFF .. 20.0 sec)
		OFSt =>					0x2810,		# offset of measurement with dP decimal points (-1999..9999) ?
		rot =>					0x2811,		# rotation of the measuring straight line
		InE =>					0x2812,		# "OPE" functioning in case of measuring error (0=OR, 1=Ur, 2=OUr)
		OPE =>					0x2813,		# output power in case of measuring error (-100..100)
		dIF =>					0x2858,		# digital input function

		# O1 group (parameteres relative to output 1)
		O1F =>					0x2814,		# functioning of output 1 (0=OFF, 1=1.rEg, 2=2.rEg, 3=Alno, 4=ALnc)
		Aor1 =>					0x2859,		# Beginning of analogue output 1 scale (0=0, 1=no_0)
		Ao1F =>					0x285A,		# functioning of analogue output 1 (0=OFF, 1=inp, 2=err, 3=r.SP, 4=r.SEr)
		Ao1L =>					0x285B,		# Minimum reference for analogical output 1 for signal transmission (with dP, -1999..9999)
		A01H =>					0x285C,		# Maximum reference for analogical output 1 for signal transmission (with dP, A01L..9999)

		# O2 group (parameteres relative to output 2)
		O2F =>					0x2815,		# functioning of output 2 (0=OFF, 1=1.rEg, 2=2.rEg, 3=Alno, 4=ALnc)
		Aor2 =>					0x285D,		# Beginning of analogue output 2 scale (0=0, 1=no_0)
		Ao2F =>					0x285E,		# functioning of analogue output 2 (0=OFF, 1=inp, 2=err, 3=r.SP, 4=r.SEr)
		Ao2L =>					0x285F,		# Minimum reference for analogical output 2 for signal transmission (with dP, -1999..9999)
		A02H =>					0x2860,		# Maximum reference for analogical output 2 for signal transmission (with dP, A02L..9999)

		# O3 group (parameteres relative to output 3)
		O3F =>					0x2816,		# functioning of output 3 (0=OFF, 1=1.rEg, 2=2.rEg, 3=Alno, 4=ALnc)
		Aor3 =>					0x2861,		# Beginning of analogue output 3 scale (0=0, 1=no_0)
		Ao3F =>					0x2862,		# functioning of analogue output 3 (0=OFF, 1=inp, 2=err, 3=r.SP, 4=r.SEr)
		Ao3L =>					0x2863,		# Minimum reference for analogical output 3 for signal transmission (with dP, -1999..9999)
		A03H =>					0x2864,		# Maximum reference for analogical output 3 for signal transmission (with dP, A03L..9999)

		# O4 group (parameters relative to output 4)
		O4F =>					0x2817,		# functioning of output 4 (0=OFF, 1=1.rEg, 2=2.rEg, 3=Alno, 4=ALnc)

		# Al1 group (parameteres relative to alarm 1
		OAL1 =>					0x2818,		# Output where alarm AL1 is addressed (0=OFF, 1=Out1, 2=Out2, 3=Out3, 4=Out4)
		AL1t =>					0x2819,		# Alarm AL1 type (0=LoAb, 1=HiAb, 2=LHAb, 3=LodE, 4=HidE, 5=LHdE)
		Ab1 =>					0x281A,		# Alarm AL1 functioning (0=no function, 1=alarm hidden at startup, 2=alarm delayed, 4=alarm stored, 8=alarm acknowledged
		AL1 =>					0x281B,		# Alarm AL1 threshold (with dP, -1999..9999)
		AL1L =>					0x281C,		# Low threshold band alarm AL1 or Minimum set alarm AL1 for high or low alarm (with dP, -1999..9999)
		AL1H =>					0x281D,		# High threshold band alarm AL1 or Maximum set alarm AL1 for high or low alarm (with dP, -1999..9999)
		HAL1 =>					0x281E,		# Alarm AL1 hysteresis (with dP, 0=OFF..9999)
		AL1d =>					0x281F,		# Activation delay of alarm AL1 (with dP, 9=OFF..9999sec)
		AL1i =>					0x2820,		# Alarm AL1 activation in case of measuring error (0=no, 1=yes)


		# rEG group (parameters relative to controller
		Cont =>					0x283B,		# Control type (0=PID, 1=On.Fa, 2=On.FS, 3=nr, 4=3Pt)
		Func =>					0x283C,		# functioning mode output 1rEg (0=Heat, 1=Cool)
		Auto =>					0x283D,		# Autotuning Fast enable
		SELF =>					0x283E,		# Selftuning enable (0=No, 1=Yes)
		HSEt =>					0x283F,		# Hysteresis of ON/OFF Control (9999 ... -1999)
		Pb =>					0x2840,		# Proportional band (0...9999)
		Int =>					0x2841,		# Integral time (0=OFF...9999sec)
		dEr =>					0x2842,		# Derivative time (0=OFF...9999sec)
		FuOc =>					0x2843,		# Fuzzy overshoot control (0.00...2.00)
		tcr1 =>					0x2833,		# Cycle time of output 1rEg (0.1...130sec)
		Prat =>					0x2845,		# Power ration 2rEg/1rEg (0.1...999.9)
		tcr2 =>					0x2846,		# Cycle time of 2rEg (0.1...130sec)
		rS =>					0x2847,		# Manual reset (-100%...100%)
		tcor =>					0x2866,		# Time for motorised actuator run (4...1000sec)
		SHrl =>					0x2867,		# Minimum value for motorised actuator control (0.1...10%)
		PoSI =>					0x2868,		# Switch on position for motorised actuator (0=No, 1=close, 2=open)
		SLor =>					0x2849,		# Gradient of rise ramp (0.00...99.99)
		durt =>					0x284A,		# Duration time
		SLoF =>					0x284B,		# Gradient of fall ramp
		ro1L =>					0x2869,		# Minimum power in ouput from 1rEG (0...100%)
		ro1H =>					0x286A,		# Maximum power ... (ro1L...100%)
		ro2L =>					0x286B,		# Minimum power in output from 2rEG (0...100%)
		ro2H =>					0x286C,		# Maximum power... (ro2L...100%)
		tHr1 =>					0x286D,		# Split Range Power threshold of output 1rEG
		tHr2 =>					0x286E,		# ... of output 2rEG
		OPS1 =>					0x286F,		# Power variation speed in output from 1rEG (0...50%/sec)
		OPS2 =>					0x2870,		# ... from 2rEG
		StP =>					0x284C,		# Soft-start power (-100, -101=OFF, 100)
		SSt =>					0x284D,		# Soft-start time (0=OFF...7.59 h.min)

		

											# to be continued
		
	},

	MemCache => {	# used by read_int_cached and write_int_cached to cache 16bit values
	},
);


sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = $class->SUPER::new(@_);	# sets $self->config
	$self->_construct(__PACKAGE__, \%fields); 	# this sets up all the object fields out of the inheritance tree.
												# also, it does generic connection setup.

	return $self;
}



sub read_temperature {
	my $self=shift;
	my @Result = ();
	my $Temp = undef;
	my $dP = 0;
	#return undef unless defined($dP = $self->read_int_cached({ mem_address => 'dP' }));
	if(!defined($dP = $self->read_int_cached({ mem_address => 'dP' }))) {
		print "Error in cached read of dP\n";
		return undef;
	}

	return undef unless defined($Temp = $self->read_address_int( $self->MemTable()->{'Measurement'} ));
	
	$Temp ==  10001 ? warn("Warning: Measurement exception $Temp received. Sensor disconnected.\n") :
	$Temp ==  10000 ? warn("Warning: Measurement exception $Temp received. Measuring value underrange.\n") :
	$Temp == -10000 ? warn("Warning: Measurement exception $Temp received. Measuring value overrange.\n") :
	$Temp ==  10003 ? warn("Warning: Measurement exception $Temp received. Measured variable not available.\n") :
	return $Temp / 10**$dP;
	
	return undef;
}


sub read_int_cached { # { mem_address => $mem_address, ForceRead => (1,0) }
	my $self = shift;
	my $args = shift;
	my $mem_address = $args->{'mem_address'} || undef;
	my $ForceRead = $args->{'ForceRead'};
	if($mem_address !~ /^[0-9]*$/) {
		$mem_address = $self->MemTable()->{$mem_address} || undef;
	}

	if( !$ForceRead && exists($self->MemCache()->{$mem_address}) && defined($self->MemCache()->{$mem_address}) ) {
		return $self->MemCache()->{$mem_address};
	}
	else {
		return undef unless defined($self->MemCache()->{$mem_address} = $self->read_address_int($mem_address));
		return $self->MemCache()->{$mem_address};
	}
}

sub write_int_cached {	# { mem_address => $mem_address, mem_value => $Value }  stores mem_value as number (int)
	my $self = shift;
	my $args = shift;
	my $mem_address = $args->{mem_address} || undef;
	my $mem_value = int($args->{mem_value}) || undef;
	if($mem_address !~ /^[0-9]*$/) {
		$mem_address = $self->MemTable()->{$mem_address} || undef;
	}

	return undef unless $self->write_address({ mem_address => $mem_address, mem_value => $mem_value });
	return( ($self->MemCache()->{$mem_address} = $mem_value) );
}


sub set_setpoint { # { Slot => (1..4), Value => Int }
	my $self=shift;
	my $args=shift;
	my $TargetTemp = $args->{'Value'};
	my $Slot = $args->{'Slot'};
	my $nSP = 1;
	my $dP = 0;

	return undef unless defined($nSP = $self->read_int_cached('nSP'));
	return undef unless defined($dP = $self->read_int_cached('dP'));

	if ($Slot > $nSP || $Slot < 1) { 
		return undef;
	}
	else {
		$TargetTemp = sprintf("%.${dP}f",$TargetTemp) * 10**$dP;	# rounding, shifting decimal places
		return undef if ($TargetTemp > 32767 || $TargetTemp < -32768);	# still fitting in a signed 16bit int?
		#$TargetTemp = ( $TargetTemp + 2**16  ) if $TargetTemp < 0;
		return $self->write_address({ mem_address => $self->MemTable()->{'Setpoint'}+$Slot-1, mem_value => $TargetTemp });
	}
}


sub set_active_setpoint { # $value
	my $self=shift;
	my $TargetTemp = shift;
	my $Slot = 1;
	my $dP = 0;
	return undef unless defined($Slot = $self->read_int_cached({ mem_address => 'SPAt' }));
	return undef unless defined($dP = $self->read_int_cached({ mem_address => 'dP' }));

	$TargetTemp = sprintf("%.${dP}f",$TargetTemp) * 10**$dP;	# rounding, shifting decimal places
	return undef if ($TargetTemp > 32767 || $TargetTemp < -32768);	# still fitting in a signed 16bit int?
	#$TargetTemp = ( $TargetTemp + 2**16  ) if $TargetTemp < 0;
	return $self->write_address({ mem_address => $self->MemTable()->{'SP1'}+$Slot-1, mem_value => $TargetTemp });
}


sub set_setpoint_slot { # { Slot => (1..4) }
	my $self = shift;
	my $args = shift;
	my $Slot = int($args->{'Slot'}) || return undef;
	my $nSP = undef;
	return undef unless defined($nSP = $self->read_int_cached('nSP'));

	if ($Slot > $nSP || $Slot < 1) {
		return undef;
	}
	else {
		return $self->write_address({ mem_address => $self->MemTable()->{'SPAt'}, mem_value => $Slot });
	}
}


sub set_Precision {	# $Precision
	my $self = shift;
	my $precision = int(shift);

	return undef if ($precision < 0 || $precision > 3);
	return $self->write_address({ mem_address => $self->MemTable()->{'sP'}, mem_value => $precision });
}

sub set_speed {	# set speed of temperature increase and decrease, in deg/minute. set "off" to disable (infinite speed)
	my $self = shift;
	my $speed = shift;

	$speed=100 if($speed =~ /off/i);
	$speed=sprintf("%.2f", $speed) * 100; # 2 decimal places hardwired, transferred as int

	$self->write_address({ mem_address => $self->MemTable()->{'SLoF'}, mem_value => $speed });
	$self->write_address({ mem_address => $self->MemTable()->{'SLor'}, mem_value => $speed });
	return 1;
}

sub set_speed_rising {	# set speed of temperature increase, in deg/minute. set "off" to disable (infinite speed)
	my $self = shift;
	my $speed = shift;

	$speed=100 if($speed =~ /off/i);
	$speed=sprintf("%.2f", $speed) * 100; # 2 decimal places hardwired, transferred as int

	return $self->write_address({ mem_address => $self->MemTable()->{'SLor'}, mem_value => $speed });
}

sub set_speed_falling {	# set speed of temperature decrease, in deg/minute. set "off" to disable (infinite speed)
	my $self = shift;
	my $speed = shift;

	$speed=100 if($speed =~ /off/i);
	$speed=sprintf("%.2f", $speed) * 100; # 2 decimal places hardwired, transferred as int

	return $self->write_address({ mem_address => $self->MemTable()->{'SLoF'}, mem_value => $speed });
}


sub read_range { # { mem_address => Address (16bit), MemCount => Count (8bit, (1..4), default 1)
	my $self = shift;
	my $args = shift;
	my $mem_address = $args->{mem_address} || undef;
	my $MemCount = $args->{MemCount} || 1;
	$MemCount = int($MemCount);
	if($mem_address !~ /^[0-9]*$/) {
		$mem_address = $self->MemTable()->{$mem_address} || undef;
	}

	if(!$mem_address || !$MemCount || $mem_address > 0xFFFF || $mem_address < 0x0200 || $MemCount > 4 || $MemCount <= 0) {
		return undef;
	}
	else {
		return $self->connection()->Read( function => 3, mem_address => $mem_address, MemCount => $MemCount );
	}
}


sub read_address_int { # $Address
	my $self = shift;
	my @Result = ();
	my $SignedValue = 0;
	my $mem_address = shift || undef;
	if($mem_address !~ /^[0-9]*$/) {
		$mem_address = $self->MemTable()->{$mem_address} || undef;
	}

	if(!$mem_address || $mem_address > 0xFFFF || $mem_address < 0x0200) {
		print "Address invalid\n";
		return undef;
	}
	else {
		@Result = $self->connection()->Read( function => 3, mem_address => $mem_address, MemCount => 1 );
		if(scalar(@Result)==2) { # correct answer has to be two bytes long
			$SignedValue = unpack('n!', join('', @Result));
		}
		else {
			warn "Error on bus level\n";
			return undef;
		}
	}
}


sub write_address {	# { mem_address => Address (16bit), mem_value => Value (16 bit word) }
	my $self = shift;
	my $args = shift;
	my $mem_address = $args->{mem_address} || undef;
	my $mem_value = int($args->{mem_value}) || undef;
	
	if($mem_address !~ /^[0-9]*$/) {
		$mem_address = $self->MemTable()->{$mem_address} || undef;
	}

	if( !$mem_address || (!$mem_value && $mem_value != 0) || $mem_address > 0xFFFF || $mem_address < 0x0200 || $mem_value > 0xFFFF || $mem_value < 0) {
		return undef;
	}
	else {
		return $self->connection()->Write( function => 6, mem_address => $mem_address, mem_value => $mem_value );
	}
}



1;










=head1 NAME

Lab::Instrument::TLK43 - Electronic process controller TLKA41/42/43 (SIKA GmbH)

=head1 SYNOPSIS

    use Lab::Instrument::TLK43;
    
    my $tlk=new Lab::Instrument::TLK43({ Port => '/dev/ttyS0', slave_address => 1, Baudrate => 19200, Parity => 'none', Databits => 8, Stopbits => 1, Handshake => 'none'  });

	or

	my $Bus = new Lab::Bus::MODBUS({ Port => '/dev/ttyS0', Interface => 'RS232', slave_address => 1, Baudrate => 19200, Parity => 'none', Databits => 8, Stopbits => 1, Handshake => 'none' });
	my $tlk=new Lab::Instrument::TLK43({ Bus => $Bus });

    print $tlk->read_temperature();
	$tlk->set_setpoint(200);

=head1 DESCRIPTION

The Lab::Instrument::TLK43 class implements an interface to SIKA GmbH's TLK41/42/43 process controllers. The devices
have to be equipped with the optional RS485 interface. The device can be fully programmed using RS232 and an interface
converter (e.g. "GRS 485 ISO" RS232 - RS485 Converter).

The following parameter list configures the RS232 port correctly for a setup with the GRS485 converter and a speed of 19200 baud:
Port => '/dev/ttyS0', Interface => 'RS232', Baudrate => 19200, Parity => 'none', Databits => 8, Stopbits => 1, Handshake => 'none'


=head1 CONSTRUCTOR

    my $tlk=new(\%options);

=head1 METHODS
 

=head2 read_temperature

    $temp = read_temperature();

Returns the currently measured temperature, or undef on errors.


=head2 set_setpoint

    $success=$tlk->set_setpoint({ Slot => $Slot, Value => $Value })

Set the value of setpoint slot $Slot.

=over 4

=item $Slot

The TLK controllers provide 4 setpoint slots. $Slot has to be a number of (1..4) and may not
exceed the nSP-parameter set in the device (set_setpoint return undef in this case)

=item $Value

Float value to set the setpoint to. Internally this is held by a 16bit number.
set_setpoint() will cut off the decimal values according to the value of the "dP" parameter of the device.
(dP=0..3 meaning 0..3 decimal points. only 0,1 work for temperature sensors)

=back


=head2 set_active_setpoint

    $success=$tlk->set_active_setpoint($Value);

Set the value of the currently active setpoint slot.

=over 4

=item $Value

Float value to set the setpoint to. Internally this is held by a 16bit number.
set_setpoint() will cut off the decimal values according to the value of the "dP" parameter of the device.
(dP=0..3 meaning 0..3 decimal points. only 0,1 work for temperature sensors)

=back


=head2 read_range

    $value=$tlk->read_range({ mem_addresss => (0x0200..0xFFFF || Name), MemCount => (1..4) })

Read the values of $MemCount memory slots from $mem_address on. The Address may be specified as a 16bit Integer in the valid range,
or as an address name (see TLK43.pm, %fields{'MemTable'}). $MemCount may be in the range 1..4.
Returns the memory as an array (one byte per field)


=head2 read_address_int

    $value=$tlk->read_range({ mem_addresss => (0x0200..0xFFFF || Name), MemCount => (1..4) })

Read the value of the 16bit word at $mem_address on. The Address may be specified as a 16bit Integer in the valid range,
or as an address name (see TLK43.pm, %fields{'MemTable'}).
Returns the value as unsigned integer (internally (byte1 << 8) + byte2)



=head2 write_address

    $success=$tlk->write_address({ mem_address => (0x0200...0xFFFF || Name), mem_value => Value (16 bit word) });

Write $Value to the given address. The Address may be specified as a 16bit Integer in the valid range,
or as an address name (see TLK43.pm, %fields{'MemTable'}).


=head2 set_setpoint_slot

    $success=$tlk->set_setpoint_slot({ Slot => $Slot })

Set the active setpoint to slot no. $Slot.

=over 4

=item $Slot

The TLK controllers provide 4 setpoint slots. $Slot has to be a number of (1..4) and may not
exceed the nSP-parameter set in the device (set_setpoint_slot return undef in this case)

=back


=head1 CAVEATS/BUGS

probably many

=head1 SEE ALSO

=over 4

=item L<Lab::Instrument>

=back

=head1 AUTHOR/COPYRIGHT

Copyright 2010 Florian Olbrich

This library is free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=cut
