morswave

#!/usr/bin/perl -w
#
# morswave  --crb3 30Sep05/08Oct05/26apr06/02Aug06/02mar14
#  a recovery of gen_morsewavs      --crb3 26jun03
#
# program copyright (C) 2005/2014 Carroll R. Bryan III, WB1HKU.
# Released under the GNU General Public License, version 2, as
# posted at http://www.gnu.org.
#
# produces WAV files of International Morse signals by sinewave
# generation.
#
# Unless the -C switch is used, the sinewaves are abrupt coming
# and going. sinewave generation starts at 0-degree, so no
# unexpected harmonics there, but the abrupt ending sounds like
# keyclicks on trailing edges at high ditrate and low frequecy.
# The -C switch applies linear ramp envelope-shaping to both
# edges of each sinewave burst. It sounds a little more like
# crystal-filtered-IF radio, a little harder to copy, but it
# eliminates the tail-clicks. The -H switch ramps the leading
# edge as well; that sounds a bit like a DC receiver with active
# filtering.
#
# The program has three possible functions:
# -A        generate a complete letterset
# -b <n>    generate an n-char random burst (one burst per run)
# -m <text> generate a text message: inline 'string', or '@file'.
#
# Morse params:
# -f <n>    sinewave frequency in Hz
# -F        toggle Farnsworth spacing on/off (default: OFF, or FCC spacing)
# -w <n>    wpmx: words-per-minute-times-ten
# -t <file> use specified tablefile instead of internal DATAset
#
# WAV params:
# -r <rate> samples-per-second sample-rate
# -c <n>    audio channels. 1,2 is mono,stereo
# -B <n>    bits per sample: 8 or 16.
# -I        toggle whether right chan is inverted/uninverted copy of left
# -C        clickfree, as described above.
# -e        toggle: echo created filenames for caller to use
#
# /home/crb3/crb3/perl/m/morstrain/
#
# C port will be to /home/crb3/crb3/c/music/wave/morse/
#
# Version History:
# v0.1  --crb3 08Oct05  initial working version. -C unimplemented
# v0.2  --crb3 02Aug06  -C implemented with linear shaping ramp
# v0.3  --crb3 02Mar14  strictify it, clean it up a little
#
use strict;

my $debug=0;
my $chatty=0;
my $shutup=0;

$|=1 if $debug;

my $declicktime=2E-3;       # 2 ms linear envelope-shaping ramp

(my $me = $0)  =~ s/^.*\///; # whack off any pathing
my %params=(
  'pgm' => $me,
#
# default params
#
  'wpmx' => 165,        # 16.5 wpm default, fast but copyable
  'freq' => 770,        # 770 Hz default, a common sidetone pitch
  'farns' => 0,         # farnworth OFF by default

  'samrate' => 11025,       # samples-per-second in Hz
  'sambits' => 16,      # 8-bit/16-bit WAVs emitted
  'samchans' => 1,      # 1,2 == mono, stereo
  'flipside' => 0,      # stereo chans are inverse of each other?
  'doloud' => 0,        # (override) full-excursion, not half?
  'declick' => 0,       # apply anti-keyclick linear ramp?
  'headclik' => 1,      # apply declick to start of burst for
                # symmetry? or only to tail where needed?
  'echoit' => 0,        # echo created filenames on stdout?
  'unclickramp' => 22,      # 2 ms at default samrate
#
# WAV header constants...
#
  'riff' => 'RIFF',
  'wave' => 'WAVE',
  'data' => 'data',
  'fmt_' => 'fmt ',
  'storage' => 1,                     # compression method. 1 = no compression

);

my($use_table,$do_all,$do_burst,$do_message)=(0,0,0,0);
my($key,$arg,$tablefile,$burst,$message);
while(defined($ARGV[0]) and index($ARGV[0],'-')==0){
  $arg=shift(@ARGV);                    # get any switches
  $key=substr($arg,1,1);        # get no-arg switches first
  substr($arg,0,2)="";
  if($key eq "v"){                      # verbose?
    $chatty ^= 1;
    next;
  }elsif($key eq "q"){                  # silent running?
    $shutup^=1;
    next;
  }elsif($key eq "F"){                  # Farnsworth spacing
    $params{farns}^=1;
    next;
  }elsif($key eq "I"){                  # inverse: right channel is inverted
    $params{flipside}^=1;       #  copy of left chan
    next;
  }elsif($key eq "C"){                  # cleanup. sinewaves end at zero-
    $params{declick}^=1;        #  -crossing for click-free keying.
    next;
  }elsif($key eq "A"){                  # generate a complete tableset array
    $do_all^=1;             #  of WAVs with these params
    next;
  }elsif($key eq "e"){                  # generate a complete tableset array
    $params{echoit}^=1;             #  of WAVs with these params
    next;
  }elsif($key eq 'H'){          # ramp leading edge of burst too?
    $params{headclik} ^= 1;
    next;
  }elsif($key eq 'L'){          # full-excursion sines. not half?
    $params{doloud} ^= 1;
    next;
  }
  $arg =~ s/^\=//;                      # handles switch=arg
  $arg=shift(@ARGV) if($arg eq "" and index($ARGV[0],'-') != 0);
                                        # handles space-separated switch/arg
  if($key eq "w"){          # wpm x 10
    $params{wpmx}=$arg;
  }elsif($key eq "c"){          # 1 or 2, for mono or stereo
    $params{samchans}=$arg;
  }elsif($key eq "f"){          # sidetone frequency
    $params{freq}=$arg;
  }elsif($key eq "r"){          # samples per second samplerate
    $params{samrate}=$arg;
  }elsif($key eq "B"){          # bits per sample, 8 or 16
    $params{sambits}=$arg;
  }elsif($key eq "t"){          # code-structure table supplants <DATA>
    $tablefile=$arg;
    $use_table=1;
  }elsif($key eq "b"){          # random-char burst: how many?
    $burst=$arg;
    $do_burst=1;
  }elsif($key eq 'm'){
    $message=$arg;
    $do_message=1;
  }else{
    warn "$me: unrecognized option -$key $arg\n";
  }
}

#
# constants...
#
my $TWOPI=(atan2(1,1)*8);   # from the camel book, with tweak
my $paris=50;           # dits (bauds) in 60 secs for 1wpm

#
# facts are in, so run basic calculations once
#

$params{wpm}=$params{wpmx}/10;  # in perl, we have easy decimals.
my $ditperiod = 60 /($paris * $params{wpm});
$params{ditsams} = $params{samrate} * $ditperiod;

$params{samalign}=$params{samchans} * ($params{sambits}/8);
$params{bytrate}=$params{samrate} * $params{samalign};

#
# WAV sine amplitude is set at half of available headroom.
# this is deliberate, so the loudness is more like that of
# normal PC soundcard files.
# Use the -L switch to override this and produce WAVfiles
# with full excursions.
#
my $maxwav=(2**($params{sambits})); # unsigned-bits excursion
$maxwav /= 2 unless $params{doloud};    # half of that (save your hearing)

$params{maxvol}=$maxwav/2;  # half of that -- zerocrossing-to-halfmax
$params{cyclesams}=$params{samrate} / $params{freq};
$params{unclickramp} = int($declicktime / (1/ $params{samrate}));
#
# fetch the morse table in
#
my $t={};
my $fH;
if($use_table){
  if(open(FH,"<$tablefile")){
    $fH = \*FH;
  }else{
    warn "$me: no file $tablefile to open; using internal tables\n";
    $use_table=0;
  }
}
unless($use_table){
  $fH = \*DATA;
}
build_table_struct($t,$fH);
close($fH); # if $use_table;
#
# if there's a message to send, it might be a file (using the
# old CP/M-hacker signal for that, a leading '@'). Doing it this
# way, rather than with shell-level redirection, keeps an
# unknown number and sequence of tabled characters from being
# interpreted as shell metacharacters. file newlines are
# converted to spaces.
#
if($do_message){
  my($ms,@msg);             # local to this block
  if(substr($message,0,1) eq '@'){
    substr($message,0,1)="";
    $params{messagefile}=$message;  # save that for naming
    open(MSG,"<$message") or die "$me: message file $message not found\n";
    (@msg)=(<MSG>);
    close(MSG);
    foreach $ms (@msg){
      $ms =~ s/\r?\n$//;        # chomp DOS or UNIX
    }
    $message = join(' ',(@msg));
  }
}
my $pt=\%params;    # there, now both are used via references.

if($debug){
  use Data::Dumper;
  my $dumped=Dumper($pt);
  print $dumped;
  $dumped=Dumper($t);
  print $dumped;
}
my(@tsorted)=sort (keys %$t);

#
# Now the commandline tasks.
#
# do_all means to generate a WAV file for each letter in the
# table, at current Morse and WAV settings. the names are
# explicit: they're meant to be program-called.
#
if($do_all){        # might as well emit in sorted order
  foreach my $letter (@tsorted){
    gen_morsfile($t,$pt,$letter);
  }
}

#
# do_burst takes a numeric argument, and sends that many random
# characters as a one-'word' WAV file. if you're using a
# success-history wrapper program, though, you're better off
# having that wrapper generate '-m' messages based on the user's
# worst scores, rather than pure random.
#
if($do_burst){
  srand( time() ^ ($$ + ($$<< 15)) );   # from the camel book p223
  my $text="";
  for (1..$burst){
    $text .= $tsorted[rand($#tsorted)];
  }
  gen_morsfile($t,$pt,$text);
}
#
# do_message takes a text string (of any length) and produces
# one WAV file, with proper interword spacing. That file can
# be one letter or a whole qso. If the first char of the string
# is '@', the rest of the string is regarded as a filename, the
# contents of which are read in as the message.
#
if($do_message){
  gen_morsfile($t,$pt,$message);
}

print "-x-\n" if $debug;


#----------------------

#
# gen_morsfile.
#
# generate a WAV file using the provided text and structed params.
#
sub gen_morsfile {
  my($t,$pt,$txt)=(@_);
  my ($fn);

  my $bs=gen_baudstring($t,$pt,$txt);

  ($fn=$txt) =~ s/ /\-/g;   # underwire the spaces for a filename
  $fn=gen_wavfname($pt,$fn);    # standardize it

  my $samlen = length($bs) * $pt->{ditsams};

  open(WAV,">$fn") or die "$me: can't make WAVfile $fn\n";
  $fH = \*WAV;
  print "$fn\n" if $pt->{echoit};   # echo name to stdout for
                    #  caller to use

  gen_wavheaders($pt,$fH,$samlen);

  emit_bauds($pt,$bs,$fH);

  close(WAV);
}

#
# gen_wavheaders.
#
# emit WAV file headers to an open filehandle, using current
# structed params and provided samplecount.
#
sub gen_wavheaders {
  my($pt,$fH,$samct)=(@_);  # \% \*FH $

  my $databyct=$samct * $pt->{samchans} * ($pt->{sambits}/8);
  my $riffsize=$databyct + 8    # data header/byct
                  + 16 + 4 ;    # fmt header

  my $headers=pack("a4Ia4"."a4IvvIIvv"."a4I",
        $pt->{riff},
        $riffsize,      # hoping the native endian is vax/intel
        $pt->{wave},

        $pt->{fmt_},
        16,                     # fmtcnt, size of 'fmt ' args
        $pt->{storage},
        $pt->{samchans},
        $pt->{samrate},
        $pt->{bytrate},
        $pt->{samalign},
        $pt->{sambits},

        $pt->{data},
        $databyct  );

  return(print $fH $headers);
}

#
# gen_wavfname.
#
# generate a specifying WAVfile filename, specifying the params
# used to generate the Morse, plus the text itself.
# usually, that's the characters themselves. if the message text
# came out of a file, though, use the filename instead, otherwise
# the resultant filename will be lo-o-o-ong.
# factored out for clarity. oh, yeah, gotta fudge out metachars...
# '/' becomes '`' etc
#
sub gen_wavfname {
  my($pt,$didah,$let)=(@_);
  my($unklik,$chans);

  $chans = ($pt->{samchans} == 2 ? "stereo" : "mono");

  if($pt->{declick}){
    $unklik = 'C';
    $unklik .= 'H' if $pt->{headclik};
  }else{
    $unklik="";
  }
  $unklik .= 'F' if $pt->{farns};

  if($pt->{messagefile}){
    ($didah=$pt->{messagefile}) =~ s/^.*\///;   # whack path, leave fn.t
  }else{
    $didah = lc($didah);
  }
  $didah = "$let.$didah" if defined $let;

  $didah =~ tr/\\\?\//HQ|/;

  my $wfn = join('.',
    "$pt->{pgm}\-$didah",
    "$pt->{wpmx}$unklik",
    "$pt->{freq}",
    "$chans\-$pt->{sambits}",
    "wav");
  return($wfn);
}

#
# gen_baudstring.
#
# generate a keydown/keyup Morse version of the provided text
# string, doing lookups in the current tablefile hash and using
# structed params.
#
sub gen_baudstring {
  my($t,$pt,$txt)=(@_);     # \%table, \%params, $text
  my $bs="";
  my $let;

  my $spd = '-' x ($pt->{farns} ? 14 : 4);  # CHECK THESE AGAINST MORBEEP
                        # padding for interword spacing

  foreach my $letter (split(//,$txt)){
    if($letter eq ' '){     # presume this comes after-word, so
      $bs .= $spd;      #  after-letter unkey is already there.
    }else{
      $let = $t->{$letter};
      $bs .= string_bauds($pt,$let);
    }
  }
  return($bs);      # return something like 'xxx-x-xxx-x---x-xxx-x------'
}

#
# string_bauds.
#
# takes in a letterform in one of two symbol-sets, looked up
# from a tablefile hash, and returns a single keydown/keyup
# sequence string. this is where the tablefile gets interpreted,
# functionally for a single letter at a time.
#
sub string_bauds {
  my($pt,$inline)=(@_);     # \%params $string
  my $seq="";

  foreach my $baud (split(//,$inline)){
    if($baud eq '#'){       # key for a ditlength.
      $seq .= 'x';
    }elsif($baud eq '_'){   # unkey for a ditlength
      $seq .= '-';
    }elsif($baud eq '-'){   # dah
      $seq .= 'xxx-';
    }elsif($baud eq '.'){   # dit
      $seq .= 'x-';
    }else{
      warn "$me: unknown symbol $baud in $inline\n";
      return(0);
    }
  }
#
# now put the char-tail unkeys on. farns? 7. else, 3,
# already got one dit of unkey, unless the tables are botched.
# this is inter-char spacing.
#
  $seq .= ($pt->{farns} ? '------' : '--');
  return($seq);
}

#
# emit_bauds.
#
# take in a string of 'x-xxx-', a key/unkey sequence, and emit
# sinewave samples to an already-open WAV or RAW file or stream.
# 'x' is keydown, at freq $freq; '-' is is keyup, at freq 0.
# dits and dahs start at zero-crossing but don't often end that
# way, so effectively there's a little bit of keyclick-on-break.
# params:
#   sambits = 8 or 16 (bits per sample)
#   samchans = 1 or 2 (channels of audio)
#   wpmx = words-per-minute * 10
#   freq = sinewave frequency (Hz)
#   cyclesams = samples-per-cycle, derived from freq and samplerate
#   peak sample amplitude for sample size (set to half-power)
#
sub emit_bauds {
  my($pt,$seq,$fH)=(@_);
  my($bauds,$samfreq,$samcount,$c);
  my $i=0;  # i don't often use an 'i' var, but this is an index.

  while(defined($c=substr($seq,$i)) and $c ne ""){
    if($c =~ /^x+/){        # keydown
      $samfreq=$pt->{freq};
    }elsif($c =~ /^\-+/){   # keyup
      $samfreq=0;
    }else{
      warn "$me: bad baud char \'$c\' at index $i in emit_bauds string \'$seq\'\n";
      return(0);
    }

    $i += ($bauds=length($&));      # advance index past current group.
                    # grouping keeps keydown dahs from
                    # clicking at dit intervals.

    $samcount = $bauds * $pt->{ditsams};

    unless(emit_samples($pt,$samcount,$samfreq,$fH) ){
      return(0);
    }
  }
  return(1);
}

#
# emit_samples.
#
# low-level tone/silence-emitter function. sends a specified count
# of sinewave-or-silence (freq=0) sample-blocks out to an already-
# opened filehandle. returns: 1, success. 0, error (write error).
# 'freq' param is used only as a keydown/keyup flag here.
#
# params are pulled out of struct for faster access in the core loop:
#  write-once, read-manymany. On a slow machine (like my 400 MHz K6),
# this program still takes almost as much time to generate the Morse
# as it does to send it.
#
sub emit_samples {
  my($pt,$samcount,$samfreq,$fH)=(@_);  # \%params, $ct, \*WAV

  my $flipside = $pt->{flipside};
  my $samchans = $pt->{samchans};
  my $sambits = $pt->{sambits};
  my $maxvol = $pt->{maxvol};
  my $cyclesams = $pt->{cyclesams};
  my $declik = $pt->{declick};
  my($sam,$isam,$lsam,$rsam);
  my $samstep=0;
  my $oldsam=0;
  my $hdclik = $pt->{headclik};
  my $cnt;
  my $clikmax = ($pt->{declick} ? $pt->{unclickramp} : 0);
  my $sammax=$samcount;
  my($kmul,$out);

  while($samcount > 0){
    if($samfreq and $samstep){
      $sam =$maxvol * ( d_sin(360 * ($samstep / $cyclesams)));
    }else{
      $sam=0;
    }

    if($declik){
      if($hdclik and ( ($cnt=$sammax-$samcount) < $clikmax)){
        $kmul = $cnt / $clikmax;
        $sam *= $kmul;
      }elsif( ($cnt=$samcount) < $clikmax){
        $kmul = $cnt / $clikmax;
        $sam *= $kmul;
      }
    }

    $isam=$sam;
    if($sambits==8){
      $sam ^= 0x80;               # 8bit WAV samples are unsigned
    }
    $lsam=$rsam=$sam;
    if($flipside){
      if($sambits==8){
        $rsam= $sam ^ 0xFF;
      }else{
        $rsam = 0-$sam;
      }
    }

    if($samchans==2){
      if($sambits==16){
        $out = pack("v2",$lsam,$rsam);
      }else{    # 8-bit
        $out = pack("c2",$lsam,$rsam);
      }
    }else{        # one channel
      if($sambits==16){
        $out = pack("v",$lsam);
      }else{    # 8-bit
        $out = pack("c",$lsam);
      }
    }
    unless(print $fH $out){ # print to open (\*TYPEGLOB) fileHandle
      warn "write-to-filehandle error\n";
      return(0);
    }

    $oldsam=$isam;
    $samcount-- if $samcount;   # don't underflow
    $samstep++;
  }
  return(1);
}

#
# d_sin.
#
# sine in degrees. uses $TWOPI global.
#
sub d_sin {
  my $d = shift(@_);

  return( sin(($d/360)*$TWOPI) );
}

#
# build_table_struct.
#
# suck in a morse table, on an open filehandle from either a
# file or from DATA, and build an encoding table with it.
# there's no return value, instead the provided hashref is
# festooned like a Yule tree.
#
sub build_table_struct {
  my($t,$fH)=(@_);      # \%table \*HANDLE

  my($junk,$ln,$val,$key);

  while(defined($ln=<$fH>) and index($ln,'__END__')<0){
    chomp $ln;
    next if $ln =~ /^\s*$/;
    ($key,$val,$junk)=split(/\s+/,$ln);
    $t->{$key} = $val;
  }
}


__DATA__

a   .-
b   -...
c   -.-.
d   -..
e   .
f   ..-.
g   --.
h   ....
i   ..
j   .---
k   -.-
l   .-..
m   --
n   -.
o   ---
p   .--.
q   --.-
r   .-.
s   ...
t   -
u   ..-
v   ...-
w   .--
x   -..-
y   -.--
z   --..
1   .----
2   ..---
3   ...--
4   ....-
5   .....
6   -....
7   --...
8   ---..
9   ----.
0   -----
?   ..--..      imi
.   .-.-.-
,   --..--
=   -...-
-   -....-
/   -..-.
+   .-.-.       ar
\   ........    hh
&   #__#_#_#_
@   .--.-.
__END__

=pod

Clean Enough?

morswave generates calculated-sinewave Morse code signals as
WAV files. It's designed to be used in a Morse training system,
generating the required WAV files at the start of a training run
so the session itself proceeds without delay.

The keydown periods start at the zero-crossing, which is clean,
and stop at the required samplecount, no matter what the
sinewave is doing. This makes for noticeably clicky endings.

The -C option puts a stop to that, imposing a linear-ramp filter
on the first and last couple of milliseconds of samples. Normal
on-the-air Morse has an ASR-style key-envelope with defined
attack and release times, to prevent make- and break-time
keyclicks and their harmonic content. The result of the -C
option sounds like such signals. At some tone frequencies, in
fact, it sounds a little hooty, like a signal from a DC receiver
as passed through an audio filter.

The simple linear ramp does impose its own, lesser, distortion,
sounding like mild speaker thumps. In a Morsecode trainer setup,
this doesn't matter. If you're driving a transmitter with these
WAV signals, though, you'll need to clean them up to keep your
transmitter out of trouble.

8-bit sampled sinewaves, which is what you'll probably use if an
embedded MCU is driving a transmitter with tabled values, need
cleanup to drive a transmitter, period; the sampling is too
granular for a clean signal. You can clean it up slightly by
doubling the 'maxvol' parameter to use the full 8-bit waveform
range with the -L option, but you'll still need a low-pass
filter to get rid of harmonics.

Figuring It Out

Sending-rate is measured in words-per-minute. The standard test
is the word PARIS sent continuously for a minute. Including
standard spacing, that word has 46 dits of time within, plus an
additional 4 dits interword spacing on the trailing silence, so
for each wpm we get 50 dits in 60 seconds. We take in a dpm*10
value as arg so we can get fractional dpm at the low end; let's
call that 'wpmx'.

Working with WAV files, the natural time-granularity is the
samplerate, so structed params are calculated down to a convenience
constant, ditsams, samples-per-dit.

=cut


__END__