#! /usr/bin/perl -w
# 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.

#
# to update man page:
# pod2man --center="K1EL keyer driver" --release="Winkeydaemon" src/winkeydaemon > man/winkeydaemon.1
#
=pod

=head1 NAME

winkeydaemon - Morse Code daemon for the Winkey hardware keyer module

=head1 SYNOPSIS

B<winkeydaemon> [B<-enmV>] [B<-d> I<device>] [B<-b> I<baud>] [B<-p> I<port>] [B<-q> I<string>] [B<-s> I<speed>]

=head1 DESCRIPTION

B<winkeydaemon> is a program written in Perl used to control the the K1EL
Winkey2 keyer and some others that offer the K1EL protocol emulation
such as the Hamgadgets Master Keyer 1.
It provides an interface which is compatible to B<cwdaemon>, which means
it can be used in its place.
B<winkeydaemon> listens on a UDP socket and outputs commands to the K1EL
keyer on a serial port.

=head1 OPTIONS

=over 12

=item B<-d> I<device>

Serial device to be used (default is I</dev/ttyUSB0>)

=item B<-b> I<baud>

Serial baud rate (default is I<1200>)

=item B<-p> I<port>

UDP port (default is I<6789>, the standard B<cwdaemon> port)

=item B<-s> I<wpm>

Speed (default is I<24> WPM, 0 is speed potentiometer)

=item B<-q> string

QRV string, transmitted on start-up

=item B<-e>

Transmitted CW is echoed back on the client's UDP port (see: B<-p>)

=item B<-m>

Turns off (I<mutes>) sidetone in host mode on version 2 and 3 keyers.
On USB Lite Wk2 keyers with no speaker, this may disable the LED.

=item B<-n>

Run in debug mode, stay in foreground

=item B<-V>

Prints version, then exists.

=back

=cut

use strict;
use Pod::Usage qw(pod2usage);

my $version = "1.0.10   26 Jan 2020";
$main::VERSION = $version;
$Getopt::Std::STANDARD_HELP_VERSION = '1';

sub HELP_MESSAGE {
    pod2usage(-verbose => 0);
}

sub usage {
    HELP_MESSAGE();
    exit 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              = 24;
my $minSpeed           = 20;
my $maxSpeed           = 40;
my $serial             = "/dev/ttyUSB0";
my $baud               = 1200;
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, $opt_h);

getopts("emVnhp:s:d:b:s:q:") or usage();

if ($#ARGV != -1) {
    print "Extra arguments: @ARGV\n";
    usage();
}

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

if ($opt_h) {
    pod2usage(-verbose => 1);
    exit 1;
}

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($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";

$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 $count = port_write(0x00, 0x02);     ## open keyer interface

delay_ms(300);

## 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
}

$count = port_write(0x0E, $winKeyerMode);

delay_ms(300);

$count = port_write(0x03, 0x32);        ## weighting: none = 0x32

delay_ms(300);

$count = port_write(0x09, $pinCfg);     ## set pinout: LED=side-tone

delay_ms(200);

$count = port_write(0x04, 0x01, 0x00);  ## set PTT lead. tail [ms]

delay_ms(200);

## set min  WPM and speed range:
my $r = $maxSpeed - $minSpeed;
$count = port_write(0x05, $minSpeed, $r, 0);    ## set range

$count = port_write(0x02, $speed);      ## set the default speed

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;

#
# delay N milliseconds
#
sub delay_ms {
    my $ms = shift;
    select undef,undef,undef, $ms / 1000;
}

#
# write an array of bytes to the serial port
#
sub port_write {
    return $port->write(pack 'C*', @_);
}

########## Start operations ########
sub Do_operations {
####################################

    my $busy = 0;
    my $xoff = 0;
    my @fifo = ();
    my $tune_on = 0;
    my $tune_end;
    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) {
                shift @chars;
                my $cmd = shift @chars // '';
                my $arg;
                { no warnings; $arg = int(join '', @chars); }

		if ($cmd eq "2") {          ## set speed
		    $speed = $arg;
		    if ($speed != 0) {
			warn "Warning: can't set $speed WPM outside pot range: $minSpeed...$maxSpeed\n"
			    unless (($minSpeed <= $speed) && ($speed <= $maxSpeed));
		    }

		    if ($debug) {print "setspeed=$speed\n";}
		    $count = port_write(0x02, $speed);

		} elsif ($cmd eq "5") {     ## exit daemon
		    if ($debug) {print "Exiting\n";}
		    last;

		} elsif ($cmd eq "7") {     ## set weight
                    my $wgt = 50 + $arg;
		    if ($wgt < 10) { $wgt = 10;}
		    if ($wgt > 90) { $wgt = 90;}

		    if ($debug) {print "weight=$wgt\n";}
		    $count = port_write(0x03, $wgt);

		} elsif ($cmd eq "d") {  ## set PTT lead in (00...50)
                    my $delay = $arg;
                    if ($delay < 0) { $delay = 0;}
                    if ($delay > 50) { $delay = 50;}

		    if ($debug) { print "PTT lead in = $delay\n";}
                    my $delaybyte = int($delay / 10);
		    $count = port_write(0x04, $delaybyte, 0x00);

		} elsif ($cmd eq "c") {     ## TUNE
                    if ($arg > 0) {
                        if ($arg > 10) { $arg = 10; }

                        $tune_on = 1;
                        $tune_end = time() + $arg;

                        if ($debug) { print "Tune on\n";}
                        $count = port_write(0x0B, 1);
                    }

		} else {
		    $count = port_write(0x0A);      ## stop keying
                    @fifo = ();
		    $tune_on = 0;
		}

	    } else {
                my $gap = 0;
		foreach my $c (@chars) {
                    $c = uc($c);
		    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 ($c eq '~') {
                        $gap = 1;
                    } elsif ($gap) {
                        push @fifo, ("|") x 4;
                        $gap = 0;
                    }
		}

		if ($debug) {print "Fifo: ",@fifo,"\n";}

	    }
	}

        if ($tune_on && time() > $tune_end) {   # stop tuning
            $tune_on = 0;
            if ($debug) { print "Tune off\n";}
            $count = port_write(0x0B, 0);
        }

        #
        # 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
                };
              }
            }
        }
    }

    $count = port_write(0x00, 3);       ## close keyer
    undef $port;
    exit;
  }

__END__

=head1 CONFORMING TO cwdaemon

A command consists of either a string of ASCII text to be sent as Morse
Code by the keyer, or a string consisting of a leading ESCape character
(decimal 27) followed immediately by a numeral or a single ASCII command
character and an additional numeric value, depending on the command.

B<winkeydaemon> accepts the following B<cwdaemon> commands:

=over 16

=item <ESC>0

Reset to default values

=item <ESC>2I<speed>

Set keying speed (5 ... 60 WPM)

=item <ESC>4

Abort message

=item <ESC>5

Stop (exit) the daemon

=item <ESC>7I<weight>

Set weighting (-50 ... 50)

=item <ESC>cI<x>

Tune I<x> seconds long (limit = 10 seconds)

=item <ESC>dI<delay>

PTT on delay (0 ... 50ms)

=item I<Any message>

Send Morse Code message

=item I<qrz de pa0rct +test->

Increase and decrease speed on the fly in 2 WPM steps (each B<+>
and B<-> character in the string increases and decreases the
Morse speed by 2 WPM, for example, I<+++test---> will cause the
word I<test> to be sent 6 WPM faster than the preceeding text (if
any) and the succeeding text (if any) will be sent at the set
speed).

=back

=head1 NOTES

The Perl module B<Device::SerialPort> is required. For Debian and derivatives
this can be found as the B<libdevice-serialport-perl> package.
For Slackware and derivatives this can be found on Slackbuilds dot org
(B<http://slackbuilds.org>) as the perl-Device-SerialPort build script.
Other distributions will vary. It is always available from meta::cpan
(B<https://metacpan.org/release/Device-SerialPort>).

While an B<init>(8) script is included, running B<winkeydaemon> as a system
daemon is not required. A normal user account can run B<winkeydaemon> as
long as the account is a member of the group of the serial device
(often I<dialout> but can vary).

=head1 BUGS

A lack of testing on a wider range of keyers.

Bug reports and patches can be reported through the
L<https://github.com/N0NB/winkeydaemon> GitHub Web site.

=head1 EXAMPLE

Start B<winkeydaemon> using a custom serial device name:

winkeydaemon -d /dev/mk1

=head1 AUTHORS

B<winkeydaemon> was originally written by Rein Couperus, PA0R.

Joop Stakenborg, PG4I, developed a package for the Debian GNU/Linux
distribution adding a manual page and an init script.

Wilbert Knol, PE7T, extended it to work with the Winkeyer USB models.

Nate Bargmann, N0NB, collated the various works and is hosting the project
at GitHub (L<https://github.com/N0NB/winkeydaemon>).

This manual page was originally written by Joop Stakenborg, PG4I,
for the Debian project (but may be used by others).
It has been expanded by Nate Bargmann, N0NB.