#! /usr/bin/perl -w
# NAME
# winkeydaemon - morse daemon for the winkey hardware keyer module
#
# SYNOPSIS
# winkeydaemon [options] ...
#
# OPTIONS
# -d  Serial device (default is /dev/ttyUSB0)
# -b  Serial baud rate (default is 1200)
# -e  Transmitted CW is echoed back on the client's UDP port (see: '-p')
# -m  Turns off ('mutes') sidetone in host mode on version 2 and 3 keyers
#     On USB Lite Wk2 keyers with no speaker, this may disable the LED.
# -n  Run in debug mode
# -p  UDP port (default is 6789)
# -q  QRV string, transmitted on start-up
# -s  Speed (default is 24 wpm, 0 is speed potentiometer)
# -V  Prints version, then exists.
#
# DESCRIPTION
#
# winkeydaemon is a driver for the winkey2/3 keyers and compatible keyers
# such as the Hamgadgets Master Keyer 1. It provides an interface which is
# compatible to the cwdaemon, which means it can be used instead of the
# cwdaemon.
#
# The winkeydaemon listens to a udp socket # and outputs commands to the k1el
# keyer on a serial port.
#

# The winkeydaemon implements the following cwdaemon-compatible commands:
# <ESC>"0"                 Reset to default values
# <ESC>"2"<"speed value">  Set keying speed (5 ... 60 wpm)
# <ESC>"4"                 Abort message
# <ESC>"5"                 Stop (Exit) the daemon
# <ESC>"7"<"weight value"> Set weighting (-50 ... 50)
# <ESC>"c"<"x">            Tune x seconds long (limit = 10 seconds)
# <ESC>"d"<"delay">        PTT on delay 0..50 (0 .. 50ms)
# Any message              Send morse code message  (max 1 packet!)
# qrz de pa0rct ++test--   In- and decrease speed on the fly in 2 wpm steps
#
# COPYING
#
# This program is published under the GPL license.
#   Copyright (C) 2007, 2008 Rein Couperus PA0R (rein at couperus.com)
#   Copyright (C) 2013, 2017 Wilbert Knol PE7T (knol00 at gmail.com)
#   Copyright (C) 2015 Nate Bargmann, N0NB <n0nb@arrl.net>
#
# *    winkeydaemon is free software; you can redistribute it and/or modify
# *    it under the terms of the GNU General Public License as published by
# *    the Free Software Foundation; either version 2 of the License, or
# *    (at your option) any later version.
# *
# *    winkeydaemon is distributed in the hope that it will be useful,
# *    but WITHOUT ANY WARRANTY; without even the implied warranty of
# *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# *    GNU General Public License for more details.
# *
# *    You should have received a copy of the GNU General Public License
# *    along with this program; if not, write to the Free Software Foundation,
# *    Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.

use strict;

my $version = "1.0.8   05 Feb 2018";
$main::VERSION = $version;
$Getopt::Std::STANDARD_HELP_VERSION = '1';
##
##    This is PA0R version 1.0 with modifications (below) by PE7T
##
##    To make  'winkeydaemon' work with  my 'K1EL winkeyer2  USB lite'
##    kitset, the following changes have been made:
##
## 1. Stop bits  has been changed to 2.
##
## 2. Initialisation  now starts with opening host  mode: '0x00 0x02'.
##    Reset '0x00 0x01' has been removed.
##
## 3. Iambic mode 'B' has been made the default: '0x0E 0x84'
##
## 4. The default serial port has been changed to '/dev/ttyUSB0'
##
## 5. Cleaned up spurious whitespaces and re-indented the code.
##
## 6. Fixed  some  (but   not  all)  'uninitialized  value'  run-time
##    warnings.
##
## 7. Changed  'buffered speed  change 0x1C' to  'set WPM  speed 0x02'
##    Reuesting a speed of '0'  selects the speed potentiometer as the
##    speed source.
##
## 8. 'Winkeyer USB  lite' will  not program  a requested  speed  that
##    falls  outside  the potentiometer  speed  range.  This range  is
##    defined  by  '$minSpeed'  and  '$maxSpeed'.  A  warning  is  now
##    printed on STDERR when the user requests an out-of-range speed.
##
## 9. Removed  automatic 'QRV'  on  start-up,  to prevent  accidental
##    QRM. Replaced with '-q <qrv-string>' option.
##
## 10 Configuring the serial  port using Device::SerialPort appears to
##    be buggy.  As a work-around, a  system call is made to 'stty' to
##    force 1200 baud, 8 databits, 2 stop bits, raw, no echo etc etc.
##
## 11 Added '-m' option to mute sidetone on version 2 and 3 keyers.
##
## 12 The '-e' option turns on  winkeyer's 'echo' and makes the daemon
##    echo  transmitted CW  as  UDP  datagrams  on  all client sockets
##    as per option '-p'.
##
##    From Zoli, ha5cqz:
## 13 Switched to select-based timeout for UDP receive. This allows
##    fine granular control and the timeout is set to 50 ms, which
##    gives a maximum keyer data rate ~20 cps.
##    In/decrease speed in 2 wpm steps, conforming to cwdaemon.
##    Added baud rate setting. Could be needed for non original keyers.
##    Added use strict and using Data::Dumper to display datagram in
##    debug mode.
##    Selecting printable chars was changed to regexp. It is easier to
##    read than raw ASCII codes.
##    Added pot value reporting in debug mode. All status bits are
##    evaluated and reported.
##

use Device::SerialPort qw( :PARAM :STAT 0.07 );
use IO::Socket;
use IO::Select;
use Getopt::Std;
use Data::Dumper; $Data::Dumper::Useqq = 1;

my $debug              = 0;
my $speed              = 32;
my $minSpeed           = 12;
my $maxSpeed           = 40;
#my $serial             = "/dev/ttyUSB0";
my $serial             = "/dev/ttyACM0";
#my $baud               = 1200;
my $baud               = 115200;
my $server_port        = 6789;
my $qrvMsge            = '';

our ($opt_V, $opt_n, $opt_p, $opt_s, $opt_d, $opt_q, $opt_b);
our ($opt_e, $opt_m);

getopts("emVnp:s:d:s:q:b:");

if ($opt_V) {
    $opt_V = undef;
    print "\n$0 version $version\n\n";
    exit(0);
}

if ($opt_n) {
    $debug = 1;
}

if ($opt_p) {
	$server_port = $opt_p;
}

if ($opt_b) {
	$baud = $opt_b;
}

if ($opt_s) {
	$speed = $opt_s;
}

if ($opt_d) {
	$serial = $opt_d;
}

if ($opt_q) {
	$qrvMsge = uc($opt_q);
}

my $pinCfg = 0x0F;
if ($opt_m) {
  # Side tone to be muted:
  $pinCfg = 0x0D;
}

if (-d "/tmp/.winkey") {
	# ok, no action required
} else {
	my $dir = "/tmp/.winkey";
	`mkdir "$dir"`;
	if ($debug) {print "Arranging mutex directory\n";}
}

########## Initialize the serial port


my @sttyCmd=qw(raw clocal cread -crtscts cs8 cstopb -parenb -echo -echoe -echoctl -echok -echonl -echoprt -isig -iexten);
unshift @sttyCmd, ("stty", "-F", $serial, $baud);
print "Running @sttyCmd \n" if $debug;
#system(@sttyCmd) == 0 or die;


my $port=Device::SerialPort->new($serial)
    || die "$0: could not construct port.\n";


$port->write_settings or die;
#$port->baudrate(1200) || die "$0: could not set baud rate.\n";
$port->baudrate($baud) || die "$0: could not set baud rate.\n";
$port->parity("none") || die "$0: could not set parity.\n";
$port->databits(8)    || die "$0: could not set data bits.\n";
$port->stopbits(2)    || die "$0: could not set stop bits.\n";

$port->dtr_active(1)  || die "$0: could not set DTR.\n";
$port->rts_active(0)  || die "$0: could not set RTS.\n";

my $timeout = 0;

$port->read_char_time(0);
$port->read_const_time(1);

########## Initialize the udp port:

my $peerName = undef;
my $server = IO::Socket::INET->new(LocalPort => $server_port, Proto => "udp")
  or die "Couldn't setup udp server on port $server_port : $@\n";

########### Initialize keyer

my $openKeyer = sprintf("%c%c", 0x00, 0x02);	## open keyer interface
my $count = 0;
#my $count = $port->write($openKeyer);

select undef,undef,undef, 0.3;

## set mode: normal word space, no autospace, serial echo,
##           iambic-B,  paddle echo as requested by '-e' , paddle watchdog.
my $winKeyerMode = 0x84;
if (defined $opt_e) {
  $winKeyerMode = 0xC4; # Paddle echo
}

my $setmode = sprintf ("%c%c", 0x0E, $winKeyerMode);
#$count = $port->write($setmode);

select undef,undef,undef, 0.3;

$setmode = sprintf ("%c%c", 0x03, 0x32); ## weighting: none = 0x32
#$count = $port->write($setmode);

select undef,undef,undef, 0.3;

my $setpins = sprintf ("%c%c", 0x09, $pinCfg); ## set pinout: LED=side-tone
#$count = $port->write($setpins);

select undef,undef,undef, 0.2;

my $senddelay = sprintf ("%c%c%c", 0x04, 0x01, 0x00); ## set PTT lead. tail [ms]
#$count = $port->write($senddelay);

select undef,undef,undef, 0.2;

## set min  WPM and speed range:
my $r = $maxSpeed - $minSpeed;
my $setRange = sprintf ("%c%c%c%c", 0x05, $minSpeed, $r, 0);
#$count = $port->write($setRange);

my $setspeed = sprintf ("\r\n\\w%d\r\n", $speed);  ## set the default speed
$count = $port->write($setspeed);
if ($debug) {
	print "Set speed to $speed wpm\n";
}

#my $msg = sprintf ("pb4pt?");
#$count = $port->write($msg);

if ($debug) {
	Do_operations();	## do not fork, debug
} else {
	if (fork) {			## run as daemon
		exit;
	} else {
		for my $handle (*STDIN,*STDOUT, *STDERR) { # silent...
			open $handle, "+<", "/dev/null"
			or die "Cannot reopen $handle to /dev/null: $!";
		}
		Do_operations();
	}
}

exit;


########## Start operations ########
sub Do_operations
{
    my $busy = 0;
    my $xoff = 0;
    my @fifo = ();
    my $tune_on = 0;
    my $datagram;
    my $saw;

    $count = $port->write($qrvMsge) if defined $qrvMsge;

    my $select = new IO::Select();
    $select->add($server);

    my %peerNames; # active clients, past and present
    while (1) {

		# look for a UDP packet
		#
		my @ready = $select->can_read(0.05);  # 50 ms timeout
		if (@ready) {
			my $s = $server->recv($datagram, 100);
			print "Got ",Data::Dumper->Dump([$datagram],['datagram']) if $debug;

			my $newPeer = 0;
			if ( defined $s ) {
				$peerName = $s; # update latest active client
				unless ( exists $peerNames{$s} ) {
					$peerNames{$s} = '1'; # add new client to hash.
					$newPeer = 1;
				}
			}

			if ( $debug and $newPeer) {
				my ($peerPort, $peerAddr) = unpack_sockaddr_in($peerName);
				print "New client:", inet_ntoa($peerAddr), ":$peerPort\n";
			}

			my @chars = split '', $datagram;
			if (ord($chars[0]) == 27) {	# Escape \e

				if ($chars[1] eq "0") {			# Escape-0 <speed> ==> Reset to default values
					if ($debug) {
						print "Reset to default values\n";
					}
				} elsif ($chars[1] eq "2") {	# Escape-2 <speed> ==> set speed
					$speed = $chars[2];
					$speed = $speed .  $chars[3] if defined $chars[3];
					if ($speed != 0) {
						warn "Warning: can't set $speed WPM outside pot range: $minSpeed...$maxSpeed\n"
						unless (($minSpeed <= $speed) && ($speed <= $maxSpeed));
					}
					$setspeed = sprintf ("\r\n\\w%d\r\n", $speed);
					$count = $port->write($setspeed);
					if ($debug) {
						print "Set speed to $speed wpm\n";
					}
				} elsif ($chars[1] eq "3") {	# Escape-3 <tone in Hz> ==> Set tone freq
					if ($debug) {
						print "Set tone - not implemented\n";
					}
				} elsif ($chars[1] eq "4") {	# Escape-4 ==> Abort (keying/tuning)
					my $stopkeying = sprintf("%c", 0x0A);
					$count = $port->write($stopkeying);
					@fifo = ();
					$tune_on = 0;
				} elsif ($chars[1] eq "5") {	# Escape-5 ==> exit daemon
					last;
				} elsif ($chars[1] eq "7") {	# Escape-7 ==> set weight
					my $wgt;
					if ($chars[2] eq "-") {
						$wgt = $chars[2] . $chars[3] ;
						if ( defined $chars[4] ) {
							$wgt = $chars[2] . $chars[3] . $chars[4]
							unless ord($chars[4]) == 0;
						}
					} else {
						$wgt = $chars[2];
						if ( defined $chars[3] ) {
							$wgt = $chars[2] . $chars[3]
							unless ord($chars[3]) == 0;
						}
					}
					$wgt += 50;
					if ($wgt < 10) { $wgt = 10;}
					if ($wgt > 90) { $wgt = 90;}

					if ($debug) {
						print "Set weight to $wgt\n";
					}
					my $setweight = sprintf ("\r\n\\L%d\r\n", $wgt);
					$count = $port->write($setweight);
				} elsif ($chars[1] eq "d") {  # Escape-d ==> set PTT lead in (00...50)
					my ($delay, $delaybyte);
					if (ord($chars[3]) == 0) {
						$delay = 0;
						$delaybyte = 0x02;
					} else {
						$delay = $chars[2] . $chars[3];
						$delaybyte = int ($delay / 10);
					}
					if ($debug) {
						print "PTT lead in = $delay\n";
					}
					if ($delaybyte > 5) {
						$delaybyte = 5;
					}
					#$senddelay = sprintf ("%c%c%c", 0x04, $delaybyte, 0x00);
					#$count = $port->write($senddelay);
				} elsif ($chars[1] eq "c") {  # Escape-c ==> TUNE
					if ($tune_on) {
						$tune_on = 0;
						if ($debug) {
							print "Tune off\n";
						}
					} else {
						$tune_on = 1;
						if ($debug) {
							print "Tune on\n";
						}
					}
					my $tuning = sprintf("\r\n\\t\r\n");
					$count = $port->write($tuning);
				} elsif ($chars[1] eq "g") {	# Escape-g ==> Set volume of keyer
					if ($debug) {
						print "Set volume - not implemented\n";
					}
				} else {
					printf "Other escape %d\n", $chars[1];
					my $stopkeying = sprintf("%c", 0x0A);
					$count = $port->write($stopkeying);
					@fifo = ();
					$tune_on = 0;
				}
			} else {
				foreach my $c (@chars) {
					my $cr = ord($c);
					# easy chars: 0-9 A-Z space ' ) / : < = > ? @ | backspace , .
					if ($c =~ /^[0-9A-Z ')\/:<=>?@|\b,.]$/) {
						push @fifo, $c;
					} elsif ($c eq '&') {
						push @fifo, sprintf ("%c%s%s", 0x1B, "A", "S");
					} elsif ($c eq '!') {
						push @fifo, sprintf ("%c%s%s", 0x1B, "S", "N");
					} elsif ($c eq '(') {
						push @fifo, ")";
					} elsif ($c eq '*') {
						push @fifo, "<";
					} elsif ($c eq '+') {
						if ($speed < 90) {
							$speed += 2;
							push @fifo, sprintf ("%c%c", 0x1C, $speed);
						}
					} elsif ($c eq '-') {
						if ($speed > 8) {
							$speed -= 2;
							push @fifo, sprintf ("%c%c", 0x1C, $speed);
						}
					} elsif ($cr == 0) {
						last;
					}
					if ($debug > 1) {
						print $cr, "\n";
					}
				}
				if ($debug) {
					print "Fifo: ",@fifo,"\n";
				}
			}
		}

		# send chars if buffer is not full
		#
		if (!$xoff && @fifo) {
			$count = $port->write(shift @fifo);
			if ($debug) {
				print "Wrote $count bytes, Fifo: ",@fifo,"\n";
			}
		}

		# get status and echo from the keyer
		#
		($count,$saw) = $port->read(1); # will read 1 char
		next unless $count;

		my $stat = ord($saw);
		if (($stat & 0xc0) == 0xc0) {
			if ($debug) {
				printf "\nStat: 0x%02x\n", $stat;
			}
			$xoff = 0;
			if ($stat == 0xc0) {
				if ($debug) {
					print "\tIdle\n";
				}
				if (-e "/tmp/.winkey/keyer_busy") {
					`rm /tmp/.winkey/keyer_busy`;
				}
				$busy = 0;
			} else {
				if ($stat & 1) {
					if ($debug) {
						print "\tBuffer 2/3 full\n";
					}
					$xoff = 1;
				}
				if ($stat & 2) {
					if ($debug) {
						print "\tBrk-in\n";
					}
				}
				if ($stat & 4) {
					if ($debug) {
						print "\tKeyer busy\n";
					}
					`touch /tmp/.winkey/keyer_busy`;
					$busy = 1;
				}
				if ($stat & 8) {
					if ($debug) {
						print "\tTuning\n";
					}
				}
				if ($stat & 16) {
					if ($debug) {
						print "\tWaiting\n";
					}
				}
			}
		} elsif (($stat & 0xc0) == 0x80) {
			if ($debug) {
				print "Pot: ", $stat & 0x7f, "\n";
			}
		} else {
			if ($debug) {
				print $saw, "\n";
			}
			if ( defined $opt_e && $saw ge ' ' && $saw le '~' ) {
				# Printable echo chars only..
				# ..on all client sockets:
				if ( scalar(%peerNames) ) {
					eval {
						local $SIG{ALRM} = sub { die "alarm time out" };
						foreach my $pName ( keys(%peerNames) ) {
							# Echo to all known clients, past and present:
							alarm 1;
							my $r = send($server, $saw, 0, $pName);
							alarm 0;
						}
						1;  # return value from eval on normalcy
					};
				}
			}
		}
	}

	my $keyerclose = sprintf ("%c%c", 0x00, 3);
	$count = $port->write($keyerclose);
	undef $port;
	exit;
}