#!c:\Strawperl\perl\bin\perl.exe
# !!!! NOTE this is MY nonStandard path for StrawBerry perl
# the above line allows the program to run in a WINDOWS env, from a bash or 
# linux shell. Note this must agree with YOUR perl name and location!
#
# windows, execution like: perl txt2cw.pl from a "cmd" window
# or
# txt2cw.pl (if file extension .pl associated with your perl.exe)
#
# Copyright 2006-2023 by Gan Uesli Starling, KY8D, VA7KYD, and T000000139 all 
# original content from gus_morse.pl
#
# Thanks to Gan for his original source, without it this version would not 
# exist.
# I decided to completely change the name of the application since I changed 
# many things and did not want anyone confusing the two products.
#
# Windows speed-up modifications by Bill Lanahan, WA2NFN in gus_morse.pl
# Windows IWR, suffixes, tonal character emphasis, Wordsworth, expanded 
# ProSign support by Bill Lanahan, WA2NFN as the new" txt2cw.pl
#
# ****
# **** the base is a clone of Gan's gus_morse.pl found at his website.
# ****
# **** This source is ONLY tested in Windows 64bit. (the delivered lame.exe and 
# **** dll are for 64bit. ONLY used with MP3 output. Its possible that getting
# **** a 32 bit version of lame is needed for Win32.) If wav output is used, 
# **** the lame sub directory and its 2 files are UNNECESSARY.
# **** 
# **** Linux: logic within the MENU action would need to be added for linux
# **** In short, linux could need a bit of time
# **** Changes were made for IWR on Linux (not Suffixes, or emphasis symbol), but have NOT been 
# **** tested. ( Suffix, IWR, and emphais must be mutually exclusive.) The required linux changes would be 
# **** limited to getopts and the help output.
# **** lame.exe and .dll in the zip can be discarded
# ****
# **** email me if you confirm 32 bit windows working: wa2nfn@gmail.com
# ****
# **** 73 wa2nfn

# These modules you need to install.
use Audio::Wav;    # Precision of tone may depend on CPU speed.

my $DEBUG = 0; # manually set for dev testing

my $windoze_flag = 0;                  # Set to 1 only for LINUX.
$windoze_flag = 1 if ($^O =~ m/MSWin/);

# These modules are standard.
use Getopt::Long;
use Config;
#use warnings; # reduce noise on app interrupt
use strict;
use File::Copy;
use File::Path  qw( rmtree );

$| = 1;
# in case the user bails out
$SIG{INT} = \&handler;
$SIG{TERM} = \&handler;

sub handler {
    exit(0);
}

# Set defaults
my $program     = 'txt2cw.pl';
my $VERSION     = '1.0.3';     #  03/03/2024
my $txt_path    = './in.txt';
my $codec       = 'wav';
my $lang        = 'en';
my $wav_path    = '';
my $sample_rate = 11025;
my $tone        = 700;
my $max_wav_mins = 5.0;      # Minutes after which to break on next major punctuation.
my $wpm         = 25;        # Default speed of characters (not always their spacing).
my $wpmLast     = $wpm;      # DO NOT EDIT MANUALLY! keep the previous in case a speed change goes LOWER
my $farn        = 0;         # Speed of inter-char spaces, --f will fix, or later auto-set = wpm
my $incr        = 0.05;      # Increase per file of wpm
my $decr        = 0.05;      # Decrease per file of farn
my $rand_flag   = 0;         # Randomize words read in from file?
my $help_flag   = 0;         # Give help? Called by switch.
my $v_flag      = 0;         # Run verbosely?
my %tags = (
    generator => 'txt2cw.pl',
    genre     => "'Morse Code'",
    artist    => '',
);                                     # ID3 tags only.
my $volume         = 0.5;              # How loud?
my $about_flag     = 0;                # Tell user about this program?
my $quit_limit     = 8192;             # Exit after generating this many files.
my $test_flag      = 1;                # Set hi for dummy run sans wav files. Always done first.
my $dgt_cnt        = 4;                # Assume thousands of files. Will auto-reduce after self-test.
my $extra          = 0;                # Extra PARIS elements added to space between whole words (non-Farnsworth).
my $count_re       = '%04s';           # Default file-numbering if option.
my $wav_cnt        = 0;                # Inc at TOP of loop so MP3 tag won't be off by one.
my $punct          = '[]()_-!@$;:\'"' ; # String of punctuation chars to EXCLUDE. 
my $iwr            = 0;                # Do Instant Word Recognition speed increase when 1, do suffix feature when 2
my $matchFile      = '';               # File of words to send at iwrWpm, no default
my $iwrWpm         = 0;                # Speed to send IWR words
my %iwrWords       = ();               # IWR words to match against input
my $iwrMaxWords    = 1000;             # Limit count of IWR words
my $iwrHsWpm        = 0;               # iwr AND we are tranitioning to $iwrWpm for the word
my $prosign_flag   = 1;                # process <BT> fmt prosigns in input file and matchFile
my $wordsRead      = 0;                # for report 
my $wordsworth     = 0;                # make inter-char space same as the char dit speed
my $maxSuffixLen   = 15;               # keep performance within reason for dumb input
my $maxSuffixFound = 0;                # keep performance within reason
my $emphasize      = 0 ;               # on ONLY for a specially chozen char
my $emphasisTone   = 0;                # the new tone to use for emphasis
my $emphasisChar   = '';               # the single char to emphasize
my $emphasizeCnt   = 0;                # the number of instances found
my $silenceHeader  = 1;                # silence the cw of details abt speed in each file
my $shell          = '';               # if bash we need to know
my $wordToCheck    = '';               # debugging only
my $ot             = '';               # original cw TONE cmd *TONE=xx*
my $nt             = '';               # new cw TONE cmd *TONE=xx*
my $alertTone      = 0;                # if 1 AND iwr AND an empasisTone; then its a pre char alert else
                                       # the tone if for the entire IWR or suffix

STDOUT->autoflush(1) if ($shell =~ m/bash$/); # else windoze menu hangs

&GetOptions(
    "about"     => \$about_flag,
    "codec=s"   => \$codec,
    "decr=f"    => \$decr,
    "farn=f"    => \$farn,
    "help"      => \$help_flag,
    "incr=f"    => \$incr,
    "matchFile=s" => \$matchFile,
    "iwrWpm=f"  => \$iwrWpm,
    "lang=s"    => \$lang,
    "mins=f"    => \$max_wav_mins,
    "path=s"    => \$txt_path,
    "prosign"   => \$prosign_flag,
    "nopunct=s" => \$punct,
    "quit=i"    => \$quit_limit,
    "samp=i"    => \$sample_rate,
    "test"      => \$test_flag,
    "tone=i"    => \$tone,
    "verbose"   => \$v_flag,
    "wpm=f"     => \$wpm,
    "extra=i"   => \$extra,
);

# Hash of known Morse code characters.
my %morse = (

    # Punctuation
    ' ' => sub { space(); },    # Equivalent to 7 dits, Farnsworth adjusted.
    '.' => sub { di(0); da(0); di(0); da(0); di(0); da(1); space(); },
    ',' => sub { da(0); da(0); di(0); di(0); da(0); da(1); space(); },
    ':' => sub { da(0); da(0); da(0); di(0); di(0); di(1); space(); },
    ';' => sub { da(0); di(0); da(0); di(0); da(0); di(1); space(); },      # KR
    '?' => sub { di(0); di(0); da(0); da(0); di(0); di(1); space(); },      # Question
    '!' => sub { da(0); di(0); da(0); di(0); da(0); da(1); space(); },      # KW (Non ITU, proposed by Heathkit)
    '?x' => sub { di(0); di(0); da(0); da(0); di(0); di(1); stp(); },       # Spanish inverted question
    '!x' => sub { da(0); di(0); da(0); di(0); da(0); da(1); stp(); } ,      # Spanish inverted bang
    "'" => sub { di(0); da(0); da(0); da(0); da(0); di(1); stp(); },        # Apostrophe, single quote
    '-' => sub { da(0); di(0); di(0); di(0); di(0); da(1); stp(); },        # Hyphen
    '–' => sub { da(0); di(0); di(0); di(0); di(0); da(1); stp(); },        # Hyphen for n-dash
    '—' => sub { da(0); di(0); di(0); di(0); di(0); da(1); stp(); da(0); di(0); di(0); di(0); di(0); da(1); stp(); }, # Double hyphen for m-dash
    '_' => sub { di(0); di(0); da(0); da(0); di(0); da(1); stp(); },        # UK (Non ITU) for underscore.
    '=' => sub { da(0); di(0); di(0); di(0); da(1); stp(); },               # BT
    '/' => sub { da(0); di(0); di(0); da(0); di(1); stp(); },               # DN
    '(' => sub { da(0); di(0); da(0); da(0); di(1); stp(); },               # KN
    ')' => sub { da(0); di(0); da(0); da(0); di(0); da(1); stp(); },        # KK
    '[' => sub { da(0); di(0); da(0); da(0); di(1); stp(); },               # Same as paren KN
    ']' => sub { da(0); di(0); da(0); da(0); di(0); da(1); stp(); } ,       # Same as paren KK
    '"' => sub { di(0); da(0); di(0); di(0); da(0); di(1); stp(); },        # RR
    '+' => sub { di(0); da(0); di(0); da(0); di(1); stp(); },               # AR
    '&' => sub { di(1); stp(); di(0); di(0); di(1); stp(); },               # e s (Non ITU)
    '$' => sub { di(0); di(0); di(0); da(0); di(0); di(0); da(1); stp(); }, # SX
    '@' => sub { di(0); da(0); da(0); di(0); da(0); di(1); stp(); },        # WR

    # Most common letters
    'A' => sub { di(0); da(1); stp(); },
    'B' => sub { da(0); di(0); di(0); di(1); stp(); },
    'C' => sub { da(0); di(0); da(0); di(1); stp(); },
    'D' => sub { da(0); di(0); di(1); stp(); },
    'E' => sub { di(1); stp(); },
    'F' => sub { di(0); di(0); da(0); di(1); stp(); },
    'G' => sub { da(0); da(0); di(1); stp(); },
    'H' => sub { di(0); di(0); di(0); di(1); stp(); },
    'I' => sub { di(0); di(0); stp(); },
    'J' => sub { di(0); da(0); da(0); da(1); stp(); },
    'K' => sub { da(0); di(0); da(1); stp(); },
    'L' => sub { di(0); da(0); di(0); di(1); stp(); },
    'M' => sub { da(0); da(1); stp(); },
    'N' => sub { da(0); di(1); stp(); },
    'O' => sub { da(0); da(0); da(1); stp(); },
    'P' => sub { di(0); da(0); da(0); di(1); stp(); },
    'Q' => sub { da(0); da(0); di(0); da(1); stp(); },
    'R' => sub { di(0); da(0); di(1); stp(); },
    'S' => sub { di(0); di(0); di(1); stp(); },
    'T' => sub { da(1); stp(); },
    'U' => sub { di(0); di(0); da(1); stp(); },
    'V' => sub { di(0); di(0); di(0); da(1); stp(); },
    'W' => sub { di(0); da(0); da(1); stp(); },
    'X' => sub { da(0); di(0); di(0); da(1); stp(); },
    'Y' => sub { da(0); di(0); da(0); da(1); stp(); },
    'Z' => sub { da(0); da(0); di(0); di(1); stp(); },

    '0' => sub { da(0); da(0); da(0); da(0); da(1); stp(); },
    '1' => sub { di(0); da(0); da(0); da(0); da(1); stp(); },
    '2' => sub { di(0); di(0); da(0); da(0); da(1); stp(); },
    '3' => sub { di(0); di(0); di(0); da(0); da(1); stp(); },
    '4' => sub { di(0); di(0); di(0); di(0); da(1); stp(); },
    '5' => sub { di(0); di(0); di(0); di(0); di(1); stp(); },
    '6' => sub { da(0); di(0); di(0); di(0); di(1); stp(); },
    '7' => sub { da(0); da(0); di(0); di(0); di(1); stp(); },
    '8' => sub { da(0); da(0); da(0); di(0); di(1); stp(); },
    '9' => sub { da(0); da(0); da(0); da(0); di(1); stp(); },

# Spanish characters. Work undelimited when *LANG=ES*
# In 2010, the Royal Spanish Academy officially removed 'ch' and 'll' from the alphabet.
# Only non-ITU code in actual use, according to PMs with EA stations on-line.
    'Nx' => sub { da(0); da(0); di(0); da(0); da(1); stp(); },    # N tilde

    # Esperanto characters. Work undelimited when *LANG=EO*
    'Cx' => sub { da(0); di(0); da(0); di(0); di(1); stp(); },
    'Gx' => sub { da(0); da(0); di(0); da(0); di(1); stp(); },
    'Hx' => sub { da(0); da(0); da(0); da(1); stp(); },
    'Jx' => sub { di(0); da(0); da(0); da(0); di(1); stp(); },
    'Sx' => sub { di(0); di(0); di(0); da(0); di(1); stp(); },
    'Ux' => sub { di(0); di(0); da(0); da(1); stp(); },

    # Additional ITU code. Defined but not in actual use.
    'Ex' => sub { di(0); di(0); da(0); di(0); di(1); stp(); },          # ITU E-Accent

    # Common prosigns. Require delimiting as *AA*, etc.
    # Some are redundant with punctuation.
    'AR' => sub { di(0); da(0); di(0); da(0); di(1); stp(); },         # 'End of message' or '+'
    'AS' => sub { di(0); da(0); di(0); di(0); di(1); stp(); },         # 'Wait'
    'BT' => sub { da(0); di(0); di(0); di(0); da(1); stp(); },         # 'Break' or 'Um, er, ah' or '=' or 'End of paragraph'
    'BK' => sub { da(0); di(0); di(0); di(1); stp(); da(0); di(0); da(1); stp();}, # 'BK' NOT a prosign 
    'CL' => sub { da(0); di(0); da(0); di(1); stp(); di(0); da(0); di(0); di(1); stp(); }, # 'Closing station' not a prosign
    'KA' => sub { da(0); di(0); da(0); di(0); da(1); stp(); },         #  Start of message.
    'KN' => sub { da(0); di(0); da(0); da(0); di(1); stp(); },         # 'Over to named station'
    # SK same as VA
    'SK' => sub { di(0); di(0); di(0); da(0); di(0); da(1); stp(); },  # 'End of contact'
    'VA' => sub { di(0); di(0); di(0); da(0); di(0); da(1); stp(); },  # 'End of contact'
    'IMI' => sub { di(0); di(0); da(0); da(0); di0(); di(1); stp(); }, # 'Huh?' or 'I say again'
    'SOS' => sub { di(0); di(0); di(0); da(0); da(0); da(0); di(0); di(0); di(1); stp(); },
    'ERROR' => sub { di(0); di(0); di(0); di(0); di(0); di(0); di(0); di(1); stp(); },
    'HH'    => sub { di(0); di(0); di(0); di(0); di(0); di(0); di(0); di(1); stp(); }, # 'Send Error'
    # SN same as VE
    'SN' => sub { di(0); di(0); di(0); da(0); di(1); stp(); },         # 'Understood'
    'VE'    => sub { di(0); di(0); di(0); da(0); di(1); stp(); },      # 'Verified'
    'DU'    => sub { da(0); di(0); di(0); di(0); di(0); da(1); stp(); }, # Hyphen
);
    
my %prosigns = (
    '<AR>' => 1,
    '<AS>' => 1,
    '<BT>' => 1,
    '<BK>' => 1,
    '<CL>' => 1,
    '<KA>' => 1,
    '<KN>' => 1,
    '<SK>' => 1,
    '<VA>' => 1,
    '<IMI>' => 1,
    '<SOS>' => 1,
    '<HH>' => 1,
    '<SN>' => 1,
    '<VE>' => 1,
    '<DU>' => 1,
 );
    

my @channels = ();    # use for writes

# When on Windoze, be ultra-simple MENU.
if ( $windoze_flag && $help_flag != 1 ) {
    my $foo;
    my $menuWpm = $wpm; # so we can test against moving value during menu use
    my $lame = ''; 
    my $os = $Config::Config{'osname'};

    # prevent MP3 showing as a choice if no lame file
    if ( $os =~ /Win64/i ) {
       $lame = "./lame3.100-64/lame.exe";
    } elsif ( $os =~ /Win32/i ) {
       $lame = "./lame3.100-32/lame.exe";
    }

    if ( $lame ne '' ) {
        if ( -f "$lame" ) {
	   ; # offer MP3
    } else {
	    # if still empty do not offer MP3
	    $lame = '';
        }
    }

    print "\n\t\t\t\t   $program\n\t\t\t\t     v $VERSION\n\n\t\t\t\t   by WA2NFN\n\n";
    print "\n Input options (enter for default or uppercase value in y/N)...\n\n";

    print " Input file name? ($txt_path): ";
    chomp( $foo = <STDIN> );
    $foo = $txt_path if (! $foo);

    if ( $foo =~ m/\.txt$/ ) {
        $foo =~ s/\\/\//g if ( $foo =~ m|\\| );
        if ( (length($foo) >= 2)
            && ( substr( $foo, 0, 2 ) ne './' )
            && ( substr( $foo, 1, 2 ) ne ':/' ) ) {
            # prepend DOT so file gets written locally
            $txt_path = "./$foo";
        } else {
            $txt_path = $foo;
        }
    } else {
      print " Error: input file name must end in \".txt\".\n";
      exit(10);
    }

    # can we read it
    if (! -f $txt_path) { print "\nfile $txt_path not found\n"; exit(0); }
    if (! -r $txt_path) { print "\nfile $txt_path not readable\n"; exit(0); }
    if (! -s $txt_path) { print "\nfile $txt_path is empty\n"; exit(0);}

    print "\n";
    print " Character speed, in wpm? ($wpm): ";
    chomp( $foo = <STDIN> );
    $menuWpm = $foo if $foo =~ m/^(0?.|[0-9])[0-9]+$/;
    $menuWpm = sprintf("%.2f",$menuWpm);
    if ($menuWpm < 5.00) {
        print " FYI: Char wpm too low, setting it to 5 wpm.\n";
	$menuWpm = 5.00;
    }
    
    print "   Per-file char-speed increment, in wpm? ($incr): ";
    chomp( $foo = <STDIN> );
    $incr = $foo if $foo =~ m/^[0-9.]+$/;

    print "\n";
    printf(" Farns/Words-worth speed, in wpm ( <= %d, 0 = none)? (0): ",$menuWpm);
    chomp( $foo = <STDIN> );
    $farn = $foo if $foo =~ m/^[0-9.]+$/;

    if ($farn > $menuWpm) {
      print " Error: Farns/Words-worth speed exceeds character speed.\n";
      exit(10);
    }

    if (! $farn || $farn <= 0) {
	    $farn = $menuWpm; # effectively no-farns
    } else {
      print "   Farnsworth (F) for ALL spacing, or Wordsworth (w) for words only? (F/w): ";
      chomp( $foo = <STDIN> );
      $wordsworth = 1 if $foo =~ m/w/i;
      print "     Per-file Farnsworth increment in wpm? ($decr): " if $wordsworth == 0;
      print "     Per-file Wordsworth increment in wpm? ($decr): " if $wordsworth == 1;
      chomp( $foo = <STDIN> );
      $decr = $foo if $foo =~ m/^[0-9.]+$/;
    }
    $wpm = $menuWpm; 

    print "\n";
    print " Extra dit-widths between words? ($extra): ";
    chomp( $foo = <STDIN> );
    $extra = $foo if $foo =~ m/^[0-9]+$/;

    print "\n";
    print " CW tone in hz? ($tone): ";
    chomp( $foo = <STDIN> );
    $tone = $foo if $foo =~ m/^[0-9]+$/;

    print "\n";
    print " File length, in minutes? ($max_wav_mins): ";
    chomp( $foo = <STDIN> );
    $max_wav_mins = $foo if $foo =~ m/^[0-9.]+$/;

    print "\n";
    print " Max number of output files? ($quit_limit): ";
    chomp( $foo = <STDIN> );
    $quit_limit = $foo if $foo =~ m/^[0-9]+$/;
    $quit_limit = 1 if ($quit_limit < 1 );
    # optional functionality

    print "\n";
    print " Optional functions:\n   - match IWR words (i)\n   - match suffixes (s)\n   - Neither (N) (i/s/N): ";
    chomp( $foo = <STDIN> );

    if ($foo =~ m/s/i) {
        $iwr = 2;
        print "   Suffix file? (ending in .txt): ";
        chomp( $foo = <STDIN> );
        $foo =~ s|\\|/|g;
        $matchFile = $foo if $foo =~ m/\.txt$/;

	$menuWpm = $farn if ($farn > 0);

        if ($matchFile) {
            printf ("     Suffix speed, in wpm? ( > %d): ", $menuWpm);
            chomp( $foo = <STDIN> );
            $iwrWpm = $foo if $foo =~ m/^[0-9.]+$/;

            if ( $iwrWpm <= $menuWpm ) {
                print "\n Error: Suffix of ($iwrWpm) wpm, is too low.\n";
                exit(0);
            }
        } else {
            print "\n Error: You asked for suffixes, but did not provide a file name.\n";
            exit(0);
        }

        if (! -f $matchFile) { print "\nfile $matchFile not found\n"; exit(0); }
        if (! -r $matchFile) { print "\nfile $matchFile not readable\n"; exit(0); }
        if (! -s $matchFile) { print "\nfile $matchFile is empty\n"; exit(0);}
        # get the tone
        print "     Tone for suffixes, in Hz, different than: $tone): ";
        chomp( $foo = <STDIN> );
        $emphasisTone = $foo if ($foo =~ m/[0-9]+/);
	if ($emphasisTone != 0) {
            print "   Use tone as a pre-alert (y/N): ";
            chomp( $foo = <STDIN> );
            $alertTone = 1 if ($foo =~ m/y/i);
	}

    } elsif ($foo =~ m/i/i) { 
        $iwr = 1;
        print "\n";
        print "   IWR word file? (ending in .txt): ";
        chomp( $foo = <STDIN> );
        $foo =~ s|\\|/|g; 
        $matchFile = $foo if $foo =~ m/\.txt$/;

	$menuWpm = $farn if ($farn > 0);

        if ($matchFile) {
		   print "     IWR word speed, in wpm? ( > $menuWpm): ";
           chomp( $foo = <STDIN> );
           $iwrWpm = $foo if $foo =~ m/^[0-9.]+$/;
           if ( $iwrWpm <= $menuWpm ) {
              print "\n Error: IWR word speed of ($iwrWpm) wpm, is too low.\n";
              exit(0);
           }
        } else {
            print "\n Error: You asked for IWR word match, but did not provide a file name.\n";
            exit(0);
        }
        if (! -f $matchFile) { print "\nfile $matchFile not found\n"; exit(0); }
        if (! -r $matchFile) { print "\nfile $matchFile not readable\n"; exit(0); }
        if (! -s $matchFile) { print "\nfile $matchFile is empty\n"; exit(0);}

        # get the tone
        print "     Tone for IWR, different than (if desired): ($tone): ";
        chomp( $foo = <STDIN> );
        $emphasisTone = $foo if ($foo =~ m/[0-9]+/);
	if ($emphasisTone != 0) {
            print "       Use tone as a pre-alert (y/N): ";
            chomp( $foo = <STDIN> );
            $alertTone = 1 if ($foo =~ m/y/i);
	}
    }

    if ($emphasisTone == 0) {
        print "\n";
        print " A symbol to emphasize, by tone? : ";
        chomp( $foo = <STDIN> );
          if ( $foo ) {
              $foo = uc($foo);
              $foo =~ s/\s+//g;

              if (exists($morse{$foo})) {
                  $emphasisChar = $foo;
              } else {
                 $foo =~ s/[<>]//;
                 if (exists($morse{$foo})) {
                     $emphasisChar = $foo;
                 } else {
                     print "\n Error: invalid symbol (Prosigns like <AR>, no quotes, else simple 1 key entry.\n";
                     exit(77);
                 }
              }
              # get the tone
              print "   Emphasis tone, in Hz, different than CW tone of: $tone): ";
              chomp( $foo = <STDIN> );
              $emphasisTone = $foo if ($foo =~ m/[0-9]+/);

              if ($emphasisTone == $tone) {
                  print "\n Error: Tones are the same.\n";
                  exit(0);
              }
          } else {
              $emphasize = 0;
          }
    }

    $punct =~ s/$emphasisChar//;
    print "\n";
    print " Punctuation you MAY choose to Ignore/Silence: $punct\n   Ignore ALL? (Y/n): ";
    chomp( $foo = <STDIN> );
    if ( ! $foo || $foo =~ m/y/i) {
        ;
    } else {
        print "   Ignore: []() (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/[\(\[\)\]]//g;
        }
        print "   Ignore: _- (underscore, dash) (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/[_-]//;
        }
        print "   Ignore: ! (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/!//;
        }
        print "   Ignore: @ (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/@//;
        }
        print "   Ignore: \$ (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/\$//;
        }
        print "   Ignore: ; (semicolon) (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/;//;
        }
        print "   Ignore: : (colon) (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/://;
        }
        print "   Ignore: ' (apostrophe) (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/'//;
        }
        print "   Ignore: \" (double quote) (Y/n): ";
        chomp( $foo = <STDIN> );
        if ( $foo =~ m/n/i ) {
           $punct =~ s/"//;
        }
        print "   Ignore ALL you list (enter for none): ";
        chomp( $foo = <STDIN> );
        if ( $foo !~ '' ) {
	   $foo = uc($foo);
           $punct .= $foo;
        }
    }

    print "\n";
    print " Sound <XX> formatted ProSigns? (Y/n): ";
    chomp( $foo = <STDIN> );
    $prosign_flag = 0 if ( $foo =~ m/n/i);

    print "\n";
    print " Silence audible header? (Y/n): ";
    chomp( $foo = <STDIN> );
    $silenceHeader = 0 if ( $foo =~ m/n/i);
    if ($lame) {
       print "\n";
       print " Output as WAV or MP3 files? ($codec): ";
       chomp( $foo = <STDIN> );
       $codec = 'mp3' if $foo =~ m/mp3/i;
    }
}

# used by iwr and suffix if tone used for every line read
if ($emphasisTone != 0) {
  if ($alertTone) {
      $nt = "*TONE=$emphasisTone*E  *TONE=$tone*"; # a short blip and space as a warning
      $ot = "";
  } else {
      $nt = "*TONE=$emphasisTone*";
      $ot = "*TONE=$tone*";
  }
}

# moved to after windoze menu else never gets used
# dit length is the master time unit, as follows:
# secs_per_min / PARIS_elements / words_per_min
my $dit_length;

my @punct = ();

$punct = uc($punct);             # because input is UC
@punct = split( '', $punct );    # User-hated punctuation into array.
for (@punct) {

    if ( $_ =~ m/[\[\]\(\)\$\?]/ ) {
        $_ = qq|\\| . qq|$_|;    # Escape brackets and parens. and a $
    }
}

# parse matchFile, store good values for lookup during match_ck or isSuffix_ck
if ($iwr == 1 || $iwr == 2) {

    # verify file & create hash for later use
    if ( open MATCHFILE, "<$matchFile" ) {
        my $iwrCnt  = 0;
        my $lineCnt = 0;
        while (<MATCHFILE>) {
            chomp($_);
            $lineCnt++;
            next if ( $_ =~ m/\*/ ); # * used for command so we won't allow them
            next if ( $_ =~ m/^$/ ); # skip empty line
            $_ =~ s/^\s*//;          # Lose leading whitespace.
            next if (m/^#/);         # skip comments
            $_ =~ s/#.*$//;          # Lose trailing comment.
            $_ =~ s/\s+$//;          # Lose trailing whitespace.

            if ( $_ =~ m/ / ) {
                print " Warning: matchFile '$matchFile' multiple words on line: $lineCnt, ignoring it.\n";
                next;
            }

            $_ = uc($_);

            if (m/[<>]/) {
		    if ($prosign_flag && $iwr == 1) {
                        # if its valid we store it
			if (!exists($prosigns{$_})) {
                            next;
                        }
		    } else {
	                next;
		    }
	    }

            if ($iwr == 1) { # word mode
                # trim punct if user gave any
                punct( \$_ );

                if ( length($_) > 1 &&  !exists( $iwrWords{$_} ) ) {
                    $iwrWords{$_} = 0; # use as a count of instances later
                    $iwrCnt++;
                }
             } else { # its 2 which is suffix mode
                 # only take alphas
                 if ($_ !~ m/^[A-Z]{2,$maxSuffixLen}$/) {
                     print " Warning: matchFile '$matchFile' has non-alphas or less than 2 or greater than $maxSuffixLen ($_) on $lineCnt, to use as a suffix, so ignoring it.\n";
                     next;
                 } else {
                     if ( !exists( $iwrWords{$_} ) ) {
                         $iwrWords{$_} = 0; # use as a count of instances later
                         $iwrCnt++;
                         if (length($_) > $maxSuffixFound) {
                             $maxSuffixFound = length($_);
                         }
                     }
                 }
             }

             if ( $iwrCnt > $iwrMaxWords ) {
                 print " Warning: matchFile '$matchFile' has over $iwrMaxWords words, ignoring them.\n" if ($iwr == 1);
                 print " Warning: matchFile '$matchFile' has over $iwrMaxWords suffixes, ignoring them.\n" if ($iwr == 2);
                 $iwr = 0;    # save time later
                 last;
             }
        }
        close MATCHFILE;

        if ( $iwrCnt == 0 ) {
            print " Warning: matchFile '$matchFile' has no words for IWR matching.\n" if ($iwr == 1);
            print " Warning: matchFile '$matchFile' has no suffixes for matching.\n" if ($iwr == 2);
            $iwr = 0;    # save time later
        }

    } else {
        print " Error: Cannot read matchFile '$matchFile': $! \n";
        $iwr = 0;    # save time later, not doing any iwr
        exit();
    }
}

# need these for space and wordspace timing functions
$farn = $wpm if $farn > $wpm; # can't let farn over take char speed
$farn = $wpm if (! $farn || $farn == 0);

sub quick_help {
    my $help_msg = <<END_HELP_MSG;
    
USAGE:
$0 [ options ]
  
OPTIONS (for Linux):
--a[bout]   Tell about file at head.
--c[odec]   Audio codec: wav, ogg, mp3
--d[ecr]    Decrement of Farnsworth difficulty for each file 2nd thru Nth.
--e[xtra]   PARIS elements added to space between words: 0 <= extra < ?
--f[arn]    Farnsworth spacing in wpm: 0 <= farn < wpm, (0 = off, default)
--g[raphic] Path to cover art, if any. 
--h[elp]    This message
--i[ncr]    Increment of WPM, for each file 2nd thru Nth.
--l[ang]    Language: en, eo, es
--m[ins]    New file every N-plus minutes, approximately: 1 <= mins < ?
--n[opunct] Remove user-designated punctuation.
--p[ath]    Text file path. Will output to same directory.
--q[uit]    Quit if exceeds this number of output files.
--s[amp]    Sample rate: 8000, 11025, 22050, etc
--t[one]    Tone in Hz: 500 < Hz < ?
--v[erbose] Give verbose feedback
--w[pm]     Words per minute: 2 < wpm < ?

EXAMPLES (long, on Linux):
  txt2cw.pl --path '/drills.txt' --wpm 25 --farn 10 --tone 750 --samp 8000 --codec mp3 --rand
  txt2cw.pl --path '/foo.txt' --wpm 18 --tone 800 --codec wav --lang eo:
  txt2cw.pl --path './foobar.txt' --wpm 25 --farn 12.5 -tone 700 --code mp3
  
EXAMPLE (short, on Linux):
  txt2cw.pl --p 'practice.txt' --t 800 --f 12.5 --d 0.0417 --wpm 22 --i 0.0055 --c mp3 --test
  
DEFAULTS:
  txt2cw.pl --p './input.txt' --w 25 --t 700 --s 11025 --d 10 --c wav --r --l en
  
END_HELP_MSG

my $help_msg_windoze = <<END_HELP_MSG_WINDOZE;
    
USAGE:
$0 [ -help ]
  
Below is the display of the "menu" questions in lieu of
command line options. A few comments in the form of # comment, 
are added.

 Input file name? (./in.txt): tst.txt
    # in addition to the .txt suffix, the file must be a
    # text file, that is characters as typed in an editor like:
    # notepad, or vi - NOT a word processor like: Microsoft Word.
 Character speed, in wpm? (25):
        Per-file char-speed increment, in wpm? (0.05): 0
        # can be a whole number or decimal
 Farns/words-worth speed, in wpm ( <= 25, 0 = none)? (0):
 Extra dit-widths between words? (0):
 CW tone in hz? (700):
 File length, in minutes? (5):
        # this is an average estimate
 Max number of output files? (8192):
        # The above two together determine the amount of practice 
	# material, therefore run time and diskspace.
 Optional functions:
        # either of the following can be used for IWR type training
	# will require a second file containing the IWR words or suffixes
        - match IWR words (i)
        - match suffixes (s)
        - neither (N) ?: i
        IWR word file? (ending in .txt): i.txt
		# file format for IWR or suffixes as follows
		# comments like this line ok
		# completely blank of space lines
		# data lines, may have leading or trailing spaces
		# the word or suffix cannot include spaces
                IWR word speed, in wpm? ( > 25): 30
		# if IWR or SUFFIX is choosen, the matched "word" can ALSO be of a
		# different tone
                Tone for IWR, in hz, different than: (CW tone value shown): 
 A symbol to emphasize, by tone? : "
        # a single character or prosign. sounded by its different tone
	# can use as a TEMPORARY aid in learning a new character 
	# You must listen for the pattern, not just the tone!
        Emphasis tone, in Hz, different than CW tone: 700): 750
	# this will NOT be shown if you chose tone in IWR or Suffixes.
        Pre-alert tone, instead of using the tone for the entire matched word, play an "E " at the new tone.
 Punctuation to ignore? (  []()!@$;":'_  ):
        # One or more questions will allow ignoring all, or sets of
	# punctuation. 
 Sound <XX> formatted ProSigns? (y/N):
        # If 'y' (default) supported prosigns in the input file, as well as the 
	# word or suffix file will be sent as CW. In any other case the all >, and <
	# will be ignored - unsupported prosigns are discarded.
 Silence audible header? (Y/n):
        # info in the form of: file path at XX Char WPM sent in CW
	# if answer is 'N'
 Output as WAV or MP3 files? (wav):
        # windows env, only seen IF a local lame folder exists

 Below is a sample IWR word file:

 # file created for listening to "Call Of The Wild"

 and
 the
 did
 do
 she
 #wolf  <== commented out instead of erasing
 73
 <SK>   <== not likely to be found, note all entries can be upper/lower case
 snow


 Below is a sample suffix file:

 # my first few suffixes
 # case doesn't matter, must be at least 2 in length, only alphas
 ing
 tion
 ed
 ly

 Supported Prosigns:

  ITU prosigns:
    <AR> <AS> <BT> <KA> <KN> <SK> <VA> <SOS> <HH> <SN> <VE>
    <VA> & <SK> same sound different look in text
    <SN> & <VE> same sound different look in text
    + or = in input are sent as the prosign, regardless of prosign option.

  Prosign format in some text, but will be sent as 2 letters:
    <BK> <CL> 

  Punctuation sometimes in prosign format, sent as the actual 
    punctuation:
    <IMI> (question mark ?) <DU> (hyphen or dash -)

  PC Environment:
    It's recommended that you creat a new folder (directory) where you
    will run txt2cw.pl. When run, a new folder will be created with the
    name of the input file less the ".txt" extension. Assuming you 
    answer "Y" to create the     files or "Y" to overwrite it if it 
    already exists, then the input file is copied there and sub folders
    will be created to hold the wav or mp3 audio files.
      
    The directories are named like: 000-127, to mean this holds up to 
    the first 128 files (assuming the input was large, or you asked for
    short files to be created. This makes it easier for you to manually
    remove unwanted files with Windows Explorer when they are no longer
    of interest. 

    It is best to NOT have Windows Explorer or your media player sitting
    in the target directory.

    
END_HELP_MSG_WINDOZE

    if ($windoze_flag) {
        print "$help_msg_windoze";
    } else {
        print "$help_msg";
    }

    exit(0);
}

quick_help() if $help_flag && $windoze_flag;
quick_help() if $help_flag;

# Give a quick prediction of when speed will converge on normal WPM.
if ( $incr || $decr ) {
    my $x     = 1;
    my $farn_ = $farn;
    my $wpm_  = $wpm;


    if ($farn != $wpm ) {
        while (1) {
            $farn_ += $decr;
            $wpm_  += $incr;

            if ( $farn == 0 ) {
                last;
            } elsif ( $farn_ >= $wpm_ ) {
                printf( "\n NOTE: Farnsworth & WPM speeds will converge at %.2f wpm on the $x output file.\n", $wpm_ );
                last;
            } elsif ( $x > 1_000 ) {
                print "\n FYI: With char WPM=$wpm & per file wpm incr=$incr; and farn WPM=$farn & per file incr.=$decr,\n Farn will not converge in the first 1000 output files.\n";
                last;
            }
            ++$x;
	    last if $x >= $quit_limit;
        }
    }
}

# Operations embedded in text, like: *TONE=800* *WPM=20*
my %ops = (
    'ABOUT' => sub { $about_flag = $_[0]; print "    Okay! Head and tail flag = $_[0] \n" if $v_flag; },
    'CODEC' => sub { $codec = $_[0]; print "    Okay! Codec = $_[0] \n" if $v_flag; },
    'DECR' => sub { $decr = $_[0]; print "    Okay! DECR = $_[0] \n" if $v_flag; }, # Inform FARN change regardless of v_flag.
    'FARN' => sub { $farn = $_[0]; if ($farn) { print "    Okay! FARN = $_[0] \n" unless ($iwr); } },
    'INCR' => sub { $incr = $_[0]; print "    Okay! INCR = $_[0] \n" if $v_flag; },
    'LANG' => sub { $lang = lc( $_[0] ); print "    Okay! Language = $_[0] \n" if $v_flag; },
    'MAX' => sub { $max_wav_mins = $_[0]; print "    Okay! Max *.wav = $_[0] minutes.\n" if $v_flag; },
    'NEXT' => sub { next_wav(); print "    Okay! Next file triggered. \n" if $v_flag; },
    'QUIT' => sub { $quit_limit = $_[0]; print "    Okay! Quit after $_[0] files. \n" if $v_flag; },
    'TONE' => sub { $tone = $_[0]; print "    Okay! Tone = $_[0] Hz \n" if $v_flag; },
    'EXTRA' => sub { $extra = $_[0]; print "    Okay! $_[0] PARIS elements added to inter-word spaces \n" if $v_flag; },
    'WPM' => sub { set_wpm( $_[0] ); unless ($iwr) { print "    Okay! WPM = $_[0] \n"; } }, # Inform regardless of v_flag.
    'WPM_F' => sub { $wpmLast = $wpm; set_wpm( $_[0] ); $farn = $_[0]; }, # combo wpm and farn for iwr word
    'LHS' => sub { $iwrHsWpm = 1 if ($iwr == 1 || $iwr == 2); }, # Leave High Speed wpm
);

# Generate named master directory for audio files. Example: "r:/CW_Foo_Bar".
sub choose_dir {
    my ($path) = @_;

    unless ($test_flag) {

        if ( ( -d "$path" ) || ( -f "$path" ) ) {
            print "\n Warning: directory (or file) already exists: '$path'\n\n OVERWRITE IT? (y/N) > ";
            my $foo;
            chomp( $foo = <STDIN> );

            if ( $foo =~ m/y/i ) {
                if ( rmtree($path) eq 0 ) {
                    die "\n ERROR: could not create directory '$path'.\n Close any app or audio player which is accessing that path.\nThen rerun '$program'.\n";
                }
            } else {
                die "\n Nothing created. Bye.\n";
            }
        }

        if ( mkdir "$path" ) {
            # print "Created '$path'\n";
        } else {
            print " Error: Could not create directory '$path': $! \n";
        }
    }
    return $path;
}

# Generate or reuse numerically named sub-directory for audio files. "r:/CW_Foo_Bar/000-127".
sub choose_subdir {
    my ( $ptr, $div, $dir ) = @_;
    my $blw = $ptr - $ptr % $div;
    my $abv = $blw + $div;
    my $subdir =
        sprintf( $count_re, $blw ) . '-' . sprintf( $count_re, $abv - 1 );
    if ( $ptr % $div == 0 ) {
        choose_dir("$dir/$subdir");
    }
    return "$dir/$subdir/";
}

sub set_wpm {
    # $wpm is the globally set value

    if ( $farn == 0 || $farn >= $wpm ) { # Don't let farn fall behind once it has already converged or been turned off.
        $farn = $wpm = sprintf( "%.2f", shift );
    } else {
        $wpm = sprintf( "%.2f", shift );
    }
    $dit_length = 60 / 50 / $wpm * $sample_rate;
}
set_wpm($wpm);    # So can be flagged inside of text.

my $pi          = 3.14159265359 * 2;
my $bits_sample = 16;
my $max_no      = ( 2**$bits_sample ) / 2 * $volume;
my $details     = {
    'bits_sample' => $bits_sample,
    'sample_rate' => $sample_rate,
    'channels'    => 1,
};

my $write;
my $msg_head;
sub add_head { morsify( 0, ( split //, $msg_head ) ) }

# Lose the text file name.
sub get_dir_only {
    pop @_;
    return join '/', @_;
}

# Create file path for *wav
sub wav_name {
    my @path_elems = split /\//,   $txt_path;
    my @name_elems = split /\s|_/, pop @path_elems;    # Name sans spaces.
    $name_elems[-1] =~ s/\.txt$/\.wav/;       # Audio files named like text input.
                                              # Create the pathname.
    my $wav_path = join '/', @path_elems;     # Assemble custom path...
    $wav_path .= '/' . join '_', @name_elems; # ...with custom dir for audio files...
    $wav_path =~ s/\.wav$//;                  # ...named like files themselves.
                                              # Create the filename.
    unshift @name_elems, sprintf( $count_re, $wav_cnt );   # Prepend file count.
    my $wav_name = join '_', @name_elems;                  # Assemble file name
    # Find or make the main dir, sub-dir...

    if ( $wav_cnt == 0 ) {
        choose_dir($wav_path); 
    } # Choose or create outer path, "r:/foo/CW_Moby_dick"
    $wav_path = choose_subdir( $wav_cnt, 128, $wav_path ) ;  # Choose or create inner path, "/foo/CW_Moby_dick/000-127"
    return "$wav_path$wav_name";
}

# Create a new, ennumerated output *.wav file.
sub new_wav {
    my $wav = new Audio::Wav;
    $wav_path = wav_name();     
    set_wpm($wpm);

    print "\n Generating audio files in output directory...\n" if ($wav_cnt == 0 && $test_flag == 0);
    unless ($test_flag) {
        mk_tag_hash();
        $write = $wav->write( "$wav_path", $details );
        $write->set_info( 'name'  => "$tags{'name'}" );
        $write->set_info( 'genre' => "$tags{'genre'}" );
	
        if ( $farn < $wpm ) {
            $write->set_info( 'comment' =>
                  sprintf( "%.2f chars spaced at %.2f wpm", $wpm, $farn ) );
        } else {
            $write->set_info( 'comment' => "Generated $tags{'generator'}" );
        }
    }
    if ( $wav_cnt > 0 ) { # so we don't increment until after we have a file
        $farn = sprintf( "%.2f", $farn + $decr );
        set_wpm( $wpm + $incr );
        if ( $farn > $wpm ) {
            $farn = $wpm;    # Can shorten no more.
        }
    }
    my $msg = "    $wav_path ";
    $msg =~ s/\.wav/.mp3/ if ($codec =~ m/mp3/i);
    if ( $farn > 0 && $farn + 0.001 < $wpm ) {    # Because sometimes $farn = X.9999
        # changed @ to at in case user had eliminated 2 with puctuation option
        $msg .= sprintf( "at Farn %.2f/ Char %.2f WPM", $farn, $wpm );
        $msg_head = sprintf( "FILE: $wav_cnt at Farn %.2f/ Char %.2f WPM", $farn, $wpm );
    } elsif ( $wordsworth && $farn > 0 && $farn + 0.001 < $wpm ) {    # Because sometimes $farn = X.9999
        $msg .= sprintf( "at Wordsworth %.2f WPM", $farn, $wpm );
        $msg_head = sprintf( "FILE: $wav_cnt at Wordsworth %.2f WPM", $farn, $wpm );
    } else {
        $msg .= sprintf( "at Char %.2f WPM", $wpm );
        $msg_head = sprintf( "FILE: $wav_cnt at Char WPM: %.2f ", $wpm );
    }

    print "$msg\n" unless ($test_flag);
    $msg_head .= " *KA* ";
    if ($silenceHeader) {
	# clobber previous, space so first char is not clipped
	if ($prosign_flag) {
            $msg_head = " *KA* " unless ($about_flag); 
        } else {
            $msg_head = " VVV " unless ($about_flag);
	}
    }
    add_head() unless $wav_cnt >= $quit_limit;
    ++$wav_cnt;
}

# one less perl module for users to download remove HiRes WA2NFN 5/27/2023
sub current_DTG {
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
        localtime();
        return sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
        $year + 1900,
        $mon + 1, $mday, $hour, $min, $sec
    );
}

# Provide basic default info tags.
sub mk_tag_hash {
    $tags{'name'} = ( split /\//, $txt_path )[-1];
    $tags{'name'} =~ s/\.txt$//;
    $tags{'name'} =~ s/_/ /g;
    $tags{'name'} = ucfirst $tags{'name'};
    $tags{'date_time'} = current_DTG();
}

# Called by certain punctuation to break *.wav files
# into managable sizes at apporopriate points.
sub next_wav {
    print(" Done writing file: $wav_path \n\n") if $v_flag;
    $write->finish() unless $test_flag;
    ## FUTURE oggify();
    mp3ify() if ( $codec =~ /mp3/i && $test_flag == 0 );
    new_wav();
}

# Remove user-designated punctuation from text.
sub punct {
    my $sref = shift;

    for (@punct) {
        if ( $_ =~ m/[:;]/ ) {
            $$sref =~ s/$_/*BT* /g if $prosign_flag;    # Replace colons and semicolons with break plus space.
        } else {
            $$sref =~ s/$_//g;    # Other puncts replace with nothing.
        }
    }
}

# A dit element.
sub di {
    my $no_gap = shift;
    cw( $dit_length );
    gap() unless $no_gap;
}

# sure could pass a parameter, this seemd more readable
# A dah element.
sub da {
    my $no_gap = shift;
    cw( $dit_length * 3);
    gap() unless $no_gap;
}

# Generate CW tone of required length
sub cw {
    my $newTone = $tone;
    $newTone = $emphasisTone if ($emphasize);

    for ( 0 .. $_[0] ) {

        my $y = $max_no;
        if ( $_ < 15 ) { 
            # Rise time.
            $y *= $_ / 15;
        } elsif ( $_[0] - $_ < 15 ) {
            # Fall time.
            $y *= ( $_[0] - $_ ) / 15 ;
        }
        $channels[$_] = ( $y * sin( $pi * $_ / $sample_rate * $newTone ) );

    }

    $write->write(@channels);
    @channels = ();
}

# Make space between dits.
sub gap {
    for ( 0 .. $dit_length ) {
        $channels[$_] = 0;
    }

    $write->write(@channels);
    @channels = ();
}

# Make space between chars, uses Farnsworth speed for calc.
# same as wpm if no --f option given.
# PARIS = 50 elems, 31/50ths sound, 19/50ths silence.
# Formula per ARRL. QEX April 1990

sub stp {
    if ($wordsworth) {
       # so no impact on char space
       $farn = $wpm;
    }

    my $ta = ( 60 * $wpm - 37.2 * $farn ) / ($farn * $wpm);
    my $tc = 3 * $ta / 19;  # 3x for inter-char.
    my $stp_length = sprintf("%.0f",$tc * $sample_rate);

    for ( 0 .. $stp_length ) {
        $channels[$_] = 0;
    }

    $write->write(@channels);
    @channels = ();
}

# Make space between words, uses Farnsworth speed for calc.
# same as wpm if no --f option given.
sub space {
    my $ta;
    my $tc;
    my $stp_length;

    # Several possibilities depending on how speeds are bing used
    # The code has a little redundancy for clarity

    # are we doing IWR or suffix option? If so the SPACE time following
    # a high speed "word" is different. At low speed it is the same as 
    # another case.
    if ( ($iwr == 1 || $iwr == 2 ) && $iwrHsWpm != 0 ) {
       # some of the word space has been written by stp() its iwrHsWpm
       # but it was at the higher speed, thus it's too short we
       # have to make up the difference here.

       $ta = ( 60 * $wpmLast - 37.2 * $farn ) / ($wpmLast * $farn);
       $tc = ( 7 + $extra ) * $ta / 19;
       $stp_length = sprintf("%0.f", $tc * $sample_rate);
       $wpmLast = $wpm; # reset
       $iwrHsWpm = 0; # reset ONLY the first SPACE after transitioning from Hi speed is impacted
    } else {
        if ($wordsworth) {
           $ta = ( 60 * $wpm - 43 * $farn ) / ($farn * $wpm);
           $tc = ( 4 + $extra ) * $ta / 7 ; # 7x for inter-word.
        } else {
           # farns and std
           $ta = ( 60 * $wpm - 37.2 * $farn ) / ($farn * $wpm);
           $tc = ( 4 + $extra ) * $ta / 19 ; # 7x for inter-word.
        }
        $stp_length = sprintf("%0.f", $tc * $sample_rate);
    }

    for ( 0 .. $stp_length ) {
        $channels[$_] = 0;
    }

    $write->write(@channels);
    @channels = ();
}

# Assemble special character key from all between paired asterisks.
# Return key and advanced pointer.
# Example special characters: *AR*, *KN*, *SK*, *Oops!*
sub special_char {
    my ( $aref, $i ) = @_;
    my $char = '';
    my $j;
    ++$i;    # Skip since '*' not defined in Morse code.

    # Assemble key for presumed special char.
    for ( $j = $i ; $j <= $#$aref ; ++$j ) {
        last if $aref->[$j] eq '*';
        $char .= $aref->[$j];
    }

    # Return key and new pointer.
    if ( defined( $morse{"$char"} ) ) {
        print "    Okay! Special char: *$char* \n" if $v_flag;
        return ( $char, $j );
    } else {
        if ( defined( $ops{"$char"} ) || $char =~ /=/ ) {
            special_op("$char");
            return ( 'NOOP', $j );    # Undefined char will be skipped.
        } elsif ( $j - $i > 16 ) {
            print "    Error: Lone asterisk '*' found in text. Replaced by 'error' code. \n" if $v_flag; 
                return ( 'ERROR', $i + 1 );
            } else {
                print "    Error: Undefined char: *$char* found in text. Replaced by 'error' code. \n" if $v_flag;
                return ( 'ERROR', $j );
            }
        }
}

# Perform embedded special operations such as *foobar* from input text.
sub special_op {
    my ( $op, $arg ) = split /=/, $_[0];
    if ( defined( $ops{$op} ) ) {
        $ops{$op}->($arg);
    } else {
        print "    Warning: Skipping undefined special op: *$op* \n" if $v_flag;
    }
}

# Not exact PARIS length. Assume char-mix will average out.
sub next_file_trigger {
    my $outfile_char_cnt = shift;
    my $outfile_mins     = $outfile_char_cnt / $farn / 5;
    return $outfile_mins > $max_wav_mins;
}

# For flagging a file-break on appropriate punctuation.
# ASCII quote-symbol as HEX \042 so editor won't foobar syntax highlighting.
my $break_file_here = '(\.\042)|(\?\042)|(!\042)'    # End of quotation.
  . '|(\. )|(\? )|(! )'                              # Sentence break mid-line.
  . '|(\.$)|(\?$)|(!$)';                             # Sentence break at end-of-line.

# Is this the start of a fresh pragraph? Give it a BT prosign.
# Spaces give listener a restful short break, rather like in an actual QSO.
sub paragraph_check {
    my $cnt = 1;
    my ( $i, $char ) = @_;

    if ( $i == 0 ) {    # Zeroth char in line?
        if ( $char eq qq|\n| ) {    # Is 0th char a newline?
            unless ($test_flag && $prosign_flag) {
                &{ $morse{'BT'}};
		$cnt++;
	    }                      # Insert break prosign.
            for ( 1 .. 3 ) { &{ $morse{' '} }; }    # Pause
	    $cnt += 3;
            return $cnt;    # Increment character count.
        } else {
            return 0;
        }
    } else {
        return 0;
    }
}

# Roman numerals for sustitution by arabic
my @roman = qw(
  I II III IV V VI VII VIII IX X
  XI XII XIII XIV XV XVI XVII XVIII XIX XX
  XXI XXII XXIII XXIV XXV XXVI XXVII XXVIII XXIX XXX
  XXXI XXXII XXXIII XXXIV XXXV XXXVI XXXVII XXXVIII XXXIX XL
  XLI XLII XLIII XLIV LXV LXVI XLVII XLVIII XLIX L
  LI LII LIII LIV LV LVI LVII LVIII LIX LXX
  LXI LXII LXIII LXIV LXV LXVI LXVII LXVIII LXIX LXX
  LXXI LXXII LXXIII LXXIV LXXV LXXVI LXXVII LXXVIII LXXIX LXXX
  LXXXI LXXXII LXXXIII LXXXIV LXXXV LXXXVI LXXXVII LXXXVIII LXXXIX XC
  XCI XCII XCIII XCIV XCV XCVI XCVII XCVIII XCVIX C
);

# Title chapters as Arabic (not Roman) numerals.
# English and Spanish
sub fix_chapter_enumeration {
    no warnings;
    my $sref = shift;
    my $j    = 0;
    for ( 0 .. scalar @roman - 1 ) {
        $j++;
        if ( $lang eq 'en' ) {
            $$sref =~ s{\s+chapter $roman[$_]\.?\s*\n}{\nCHAPTER $j\n}i;
        } elsif ( $lang eq 'es' ) {
            $$sref =~ s{\s+capitulo $roman[$_]\.?\s*\n}{\nCAPITULO $j\n}i;

        }
    }
}

# De-accent these chars regardless of language.
# As '*' is undefined for Morse, an effective deletion.
my @accents = qw(
  à A è E ì I ò O ù U ý Y À A È E Ì I Ò O Ù U Ý Y
  ä A ë E ï I ö O ü U ÿ Y Ä A Ë E Ï I Ö O Ü U Ÿ Y
  â A ê E î I ô O û U     Â A Ê E Î I Ô O Û U
  á A é E í I ó O ú U     Á A É E Í I Ó O Ú U
  ã A         õ O         Ã A         Õ O
  ç C Ç C     ø O                     Ø O
  ‘ ' ’ ' “ " ” " « " » "
  … =
);

# De-accent Spanish chars when not Spanish

#my @accents_not_es = qw( ñ N Ñ N );
my @accents_not_es = qw( ñ N Ñ N é E É E );

# X-ify Spanish chars when is Spanish
my @accents_es = qw( é Ex É Ex ñ Nx Ñ Nx ¿ ?x ¡ !x);
#my @accents_es = qw( ñ Nx Ñ Nx);    # qw( é Ex É Ex ñ Nx Ñ Nx ¿ ?x ¡ !x);

# De-hat Esperanto chars when not Esperanto.
my @accents_not_eo = qw(
  ĉ C ĝ G ĥ H ĵ J ŝ S ŭ U
  Ĉ C Ĝ G Ĥ H Ĵ J Ŝ S Ŭ U
);

# X-ify hatted letters when is Esperanto.
my @accents_eo = qw(
  ĉ Cx ĝ Gx ĥ Hx ĵ Jx ŝ Sx ŭ Ux
  Ĉ Cx Ĝ Gx Ĥ Hx Ĵ Jx Ŝ Sx Ŭ Ux
);

sub fix_accents {
    no warnings;
    my $sref = shift;

    # General swap-out of accented chars.
    for ( 0 ... scalar @accents / 2 - 1 ) {
        $$sref =~ s{$accents[$_*2]}{$accents[$_*2+1]}g;
    }

    # Special case for when Spanish or not.
    if ( $lang ne 'es' ) {
        for ( 0 ... scalar @accents_not_es / 2 - 1 ) {
            $$sref =~ s{$accents_not_es[$_*2]}{$accents_not_es[$_*2+1]}g;
        }
    } elsif ( $lang eq 'es' ) {
        for ( 0 ... scalar @accents_es / 2 - 1 ) {
            $$sref =~ s{$accents_es[$_*2]}{$accents_es[$_*2+1]}g;
        }

        # Lose start-of-phrase punctuation.
        $$sref =~ s|[¿¡]||g;

    }

    # Special case for when Esperanto or not.
    if ( $lang ne 'eo' ) {
        for ( 0 ... scalar @accents_not_eo / 2 - 1 ) {
            $$sref =~ s{$accents_not_eo[$_*2]}{$accents_not_eo[$_*2+1]}g;
        }
    } elsif ( $lang eq 'eo' ) {
        for ( 0 ... scalar @accents_eo / 2 - 1 ) {
            $$sref =~ s{$accents_eo[$_*2]}{$accents_eo[$_*2+1]}g;
        }
    }
}

# Convert string to Morse code.
sub morsify {
    my $outfile_char_cnt = shift;
    my $line_cnt         = shift;
    for ( my $i = 0 ; $i <= $#_ ; ++$i ) {
       my $char = $_[$i];
       $outfile_char_cnt += paragraph_check( $i, $char );

       # Give indication of output
       print " Line $line_cnt: " . ( join( '', @_ ) . "\n" ) if $v_flag && $i == 0;
       if ( $char eq '*' ) { ( $char, $i ) = special_char( \@_, $i ) }

       # Traktu Esperanton laux la iksa sistemo.
       if ( $lang eq 'eo' || $lang eq 'es' ) {
           no warnings;    # Look-ahead returns uninitialized at EOS!
           next if $char =~ /x/i
              && $i > 0
              && $_[ $i - 1 ] =~ /C|G|H|J|S|U|N/;   # When to skip X.
           $char .= 'x' if $_[ 1 + $i ] =~ /x/i;    # When to Esperantize.
       }

       next unless defined( $morse{"$char"} );

       # experimental emphasis of a single chars tone
       if ($char eq $emphasisChar) {
          $emphasize = 1;
          $emphasizeCnt++;
       }

       &{ $morse{"$char"} } unless $test_flag;
       $emphasize = 0; # to be sure only on char
       ++$outfile_char_cnt;

       my $break_file_re = $break_file_here;
       $break_file_re .= '|(, )|(,$)' if $wpm < 20;    # On commas too, when semi slow.
       $break_file_re .= '|(.\ )|(\.$)' if $wpm < 15;  # On spaces too, when very slow.

       # Break multi-file output at appropriate end-of-phrase punctuation.
       if ( $i > 1 && next_file_trigger($outfile_char_cnt) ) {
           no warnings; # Look-behind returns uninitialized at start-of-string!
           my $recent = join '', @_[ $i - 1, $i ];
           if ( $recent =~ /$break_file_re/ ) {
               next_wav() unless $wav_cnt >= $quit_limit; # bailout
               $outfile_char_cnt = 0;
           }
       }
    }
    return $outfile_char_cnt;
}

# Since neither POE::Component::Enc::Ogg nor any similar
# module was available for Win32, convert to Ogg only
# on Unician platforms.
sub oggify {
    if ( $codec =~ /ogg/i && $test_flag == 0 ) {
        if ( $Config::Config{'osname'} !~ /Win/i ) {
            `nice oggenc -q 3 $wav_path           \\
                -t \"$tags{name}\"                \\
                -G \"$tags{genre}\"               \\
                -d \"$tags{date_time}\"           \\
                -c \"generator=$tags{generator}\" \\
                -c \"wpm=$wpm\"                   \\
                -c \"farn=$farn\"`;
            unlink $wav_path;    # Lose the *.wav
        } else {
            print "Sorry! I have not yet figured out how to do oggenc in Win32. \n";
        }
    }
}

# Convert to mp3 and delete the wav.
sub mp3ify {
        my $lame = '';
        my $cmd  = '';

        # The Title Tag
        my $title = "$tags{name} @ ";
        if ( $farn < $wpm ) { $title .= sprintf( "%.2f/", $farn ) }
        $title .= "$wpm WPM";
	if ($iwrWpm > 0) {
           $title .= ", IWR @ $iwrWpm WPM";
	}

        # Are we on Linux or Windows?
        my $os = $Config::Config{'osname'};

        if ( $os !~ /Win/i ) {
            $cmd = "lame ";    # Let LAME itself choose quality and bitrate for best tone
        } elsif ( $os =~ /Win64/i ) {
            $lame = "./lame3.100-64/lame.exe";
            if ( -f "$lame" ) {
                $cmd = "$lame ";
            } else {
                die(" no lame.exe to match OS $os");
            }
        } elsif ( $os =~ /Win32/i ) {
            $lame = "./lame3.100-32/lame.exe";
            if ( -f "$lame" ) {
                $cmd = "$lame ";
            } else {
                die(" no lame.exe to match OS $os");
            }
        } else {
            # maybe in the path
            print " Trying for lame.exe in your PATH\n";
            $cmd = "lame.exe ";
        }

        $cmd .= qq|--tt \"$title\" |;
        $cmd .= qq|--ta \"$tags{artist}\" |;

        # The Comment Tag
        if ( $farn < $wpm ) {
            $cmd .=
                qq|--tc \"|
              . sprintf( "%.2f wpm spaced at %.2f wpm", $wpm, $farn )
              . qq|\" |;    # 30 chars max allowed
        } else {
            $cmd .= qq|--tc \"Generated by $tags{generator}\" |;
        }

        $cmd .= qq|--tg \"Audiobook\" |;
        $cmd .= qq|--tl \"$tags{name}\" |; # So players like Sansa Clip can group in sequence,
	$cmd .= qq|--tn \"$wav_cnt\" |;
        $cmd .= qq| \"$wav_path\" |;
        $cmd .= qq|--silent| if ($windoze_flag);

	`$cmd`;
        unlink $wav_path;    # Lose the *.wav
}

# Put a copy of the text inside output dir.
sub embed_text {
    my $dir = $txt_path;
    $dir =~ s/\.txt//;
    if ( copy( $txt_path, $dir ) ) {
	    #print "\n Input file copied to output directory.\n"; # too much screen noise
    } else {
        print "\n Warning: Could not copy input text file to output directory.\n";
    }
}

# A split on // will separate cxapelito base char from its 'x'
# This sub will repair an Esperanto iksa sistemo pair after
# a split on // by re-associating the 'x' to its base and
# replacing the 'x' with a space.
sub fix_iksa_split {
    for ( 0 .. $#_ - 1 ) {
        if ( $_[ 1 + $_ ] =~ /x/i ) {
            $_[ 1 + $_ ] = '';    # Teleport orphan 'x' from isolation...
            $_[$_] .= 'x';        # ...re-uniting it to its cxapelito.
        }
    }
    return @_;
}

$farn     = $wpm if $farn == 0;
$count_re = '%04s';

my $totalLinesInFile = 0;
# Read input text, convert to audio file(s).
sub gus_morse {
    my $wpm_  = $wpm;
    my $farn_ = $farn;
    $iwrHsWpm = 0 if $test_flag == 0; # in case set during test run

    if ( open INFILE, "<$txt_path" ) {

        my $line_cnt = 0;
        new_wav();
        my $outfile_char_cnt = 0;

        print "\n Be patient if the input file is large...\n" if $test_flag;
        while (<INFILE>) {
            ++$line_cnt;              # For verbose reporting.
	    $_ =~ s/[[^:ascii:]]//g;  # in case some random non-ascii UTF

            $_ = uc($_);              # Morse hash keys are UC.
            $_ =~ s|(\s{7}\*){5}|=|g; # Swap those 5-star subparagraph lines: "       *       *       *       *       *"
            $_ =~ s/\s+/ /g;          # Swap whitespace, compressing plural.
            punct( \$_ );             # Remove user-hated punctuation.
            fix_accents( \$_ );       # Many UTF-8 chars and punctuation to ASCII
            fix_chapter_enumeration( \$_ );    # Roman numerals to arabic.
	    $_ =~ s/(<[A-Z]{2}>)|(<SOS>|<IMI>)//g if ($prosign_flag ==  0); # ignore Prosigns

            if ( ( length $_ > 1 ) && ( $_ !~ /\*/ ) ) {
                # pre parse entire line looking for iwr word matches
                if ( $iwr == 1 || $iwr == 2 ) { 
                    # only can do one of the following
                    # if match_ck matches, a word, make speed changes
                    $_ = match_ck( $_, $line_cnt ) if ($iwr == 1);
                    # if suffix_ck matches, a suffix, make speed changes
                    $_ = suffix_ck( $_, $line_cnt ) if ($iwr == 2);
                }
            }
            $_ .= "\n";  # So can break out on minutes when file has no punctuation.
            $outfile_char_cnt = morsify( $outfile_char_cnt, $line_cnt, ( split //, $_ ) );
            print "\nDEBUG: line to file:\n\n<$_> <$wav_cnt>\n" if $DEBUG;
	    last if $wav_cnt >= $quit_limit; 
        }
        $write->finish() unless $test_flag;
	# FUTURE oggify();
        mp3ify() if ( $codec =~ /mp3/i && $test_flag == 0 );
        embed_text() unless $test_flag;
        if ($test_flag) {
            printf( "\n WPM starts at %.f WPM and finishes with %.2f WPM.", $wpm_, $wpm );
            if ( $farn_ != $wpm_  && $wordsworth == 0 ) {
                printf( "\n Farnsworth starts at %.f WPM and finishes with %.2f WPM", $farn_, $farn );
            }

            if ( $wordsworth == 1 ) {
              printf("\n Wordsworth starts at %.f WPM and finishes with %.2f WPM", $farn_, $farn );
            }
            printf( "\n\n Expect %s total file(s).",$wav_cnt) if ($wav_cnt >= 1);
            $farn = $farn_;
            $wpm  = $wpm_;
        }
        return 1;
    } else {
        print "\n Error: Cannot read text input file '$txt_path': $! \n";
        exit(0);
    }
}

sub match_ck {
    my $words    = shift;
    my $line_cnt = shift;
    my $haveDouble = 0;
    my $haveSingle = 0;
    my $rt  = '  ';
    my @words;

    $iwrHsWpm = 0; 
    # disable further iwr feature
    if ( $farn >= $iwrWpm  || ($farn == 0 && $wpm > $iwrWpm) ) { 
        print "\n WARNING: farn/wpm speed exceeds iwrWpm speed ($iwrWpm) at input line ($line_cnt). further iwr now disabled.\n";
        if ($iwr == 1) {
            $iwr = 11;    # now disabled, but has history of 1
        } elsif ($iwr == 2) {
            $iwr = 22;    # now disabled, but has history of 2
        } else {
		print "BUG\n"; # wdl
            $iwr = 0;    # now disabled - shoud never happen
        }
        return $words;
    }

    $words =~ s/</ </g; # more processing before return
    $words =~ s/>/> /g;
    @words = split( ' ', $words );

    # modify the read line
    foreach (@words) {
        if (m/[<>]/) {
	   if ($prosign_flag) {
              # if its validwe keep it
              if (!exists($prosigns{$_})) {
                 next;
              }
	    } else {
	         next;
	    }
	}

        $wordsRead++;
        my $actualWd = '';

        if ( substr( $_, 0, 1 ) eq '*' ) {
            $rt .= "$_ ";
            next;
        }

	$wordToCheck = $_ if ($DEBUG);

        # look it up
        if ( exists( $iwrWords{$_} ) ) {
            print "\nDEBUG: IWR:\n $_\n" if $DEBUG;
            $rt .= "$nt*WPM_F=$iwrWpm*$_*LHS**WPM=$wpm**FARN=$farn*$ot ";
            $iwrWords{$_}++; # record hit
            next;
        } elsif ( $_ =~ m/([-A-Z0-9]+)([,.?;;_]+)/ ) {    # if like IWR[.,;:?_]
            my $tail = '';
            $actualWd = $1;
            $tail     = $2;

            if ( exists( $iwrWords{$actualWd} ) ) {
                print "\nDEBUG: IWR + PUNCT:\n $_\n" if $DEBUG;
                # we have a match, frame the word with speed changes
                # but exclude the punct
                $rt .= "$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$tail$ot ";
                $iwrWords{$actualWd}++; # record hit
            } else {
                # just a plain word followed by punct
                print "\nDEBUG: plain wd + PUNCT:\n $_\n" if $DEBUG;
                $rt .= "$_ ";
            }
            next;
        } elsif ( $_ =~ m/"/ ) {    # like: "IWR" "IWR or IWR" OR a " but not IWR word

            if (  substr( $_, 0, 1 ) eq '"' && substr( $_, -1, 1 ) eq '"' ) { # "IWR" case  
                $actualWd = substr( $_, 1, length($_) - 2 );

                if ( exists( $iwrWords{$actualWd} ) ) {
                    print "\nDEBUG: IWR in double quotes:\n $_\n" if $DEBUG;

                    # quoted iwr ie "word"
                    # but exclude the quotes
                    $rt .= "\"$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$ot\" ";
                    $iwrWords{$actualWd}++; # record hit
                } else {
                    print "\nDEBUG: plain wd double quotes:\n $_\n" if $DEBUG;
                    # just a plain word followed by punct
                    $rt .= "$_ ";
                }
                next;
            } elsif ( substr( $_, 0, 1 ) eq '"' ) {    # "IWR case

                $actualWd = substr( $_, 1, length($_) - 1 );
                if ( exists( $iwrWords{$actualWd} ) ) {
                    print "\nDEBUG: double quote + IWR :\n $_\n" if $DEBUG;

                    # quoted iwr ie "word
                    # but exclude the quotes
                    $rt .= "\"$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$ot ";
                    $iwrWords{$actualWd}++; # record hit
                } else {
                    print "\nDEBUG: double quote + plain :\n $_\n" if $DEBUG;
                    # just a plain word followed by punct
                    $rt .= "$_ ";
                }
                next;
            } elsif ( substr( $_, -1, 1 ) eq '"' ) {   # if like: IWR"

                $actualWd = substr( $_, 0, length($_) - 1 );
                if ( exists( $iwrWords{$actualWd} ) ) {
                    print "\nDEBUG: double quote AFTER IWR :\n $_\n" if $DEBUG;

                    # we have a match, frame the word with speed changes
                    # but exclude the quotes
                    $rt .= "$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$ot\" ";
                    $iwrWords{$actualWd}++; # record hit
                } else {
                    print "\nDEBUG: double quote AFTER plain :\n $_\n" if $DEBUG;
                    # just a plain word followed by punct
                    $rt .=  "$_ ";
                }
                next;
            } else {
                print "\nDEBUG: double within a random plain :\n $_\n" if $DEBUG;
                # just a plain
                $rt .= "$_ ";
                next;
            }
        } elsif ( $_ =~ m/'/ ) {    # like: 'IWR' 'IWR or IWR' OR a ' but not IWR word

            if ( (substr( $_, 0, 1 ) eq '\'') && (substr( $_, -1, 1 ) eq '\'' ) ) {    # if like: 'IWR'
                $actualWd = substr( $_, 1, length($_) - 2 );

                if ( exists( $iwrWords{$actualWd} ) ) {

                    print "\nDEBUG: IWR within single quotes:\n $_\n" if $DEBUG;
                    # quoted iwr ie 'word'
                    # but exclude the quotes
                    $rt .= "'$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$ot' ";
                    $iwrWords{$actualWd}++; # record hit
                } else {
                    print "\nDEBUG: plain within single quotes:\n $_\n" if $DEBUG;
                    # just a plain word  with random single quote
                    $rt .= "$_ ";
                }
                next;

            } elsif ( substr( $_, -1, 1 ) eq '\'' ) { # if like IWR', like: smiths'
                # almost the same as previous case

                $actualWd = substr( $_, 0, length($_) - 1 );
                if ( exists( $iwrWords{$actualWd} ) ) {

                    print "\nDEBUG: IWR + single quote:\n $_\n" if $DEBUG;
                    # but exclude the quotes from hi speed
                    $rt .= "$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$ot' ";
                    $iwrWords{$actualWd}++; # record hit
                } else {
                    print "\nDEBUG: plain + single quote:\n $_\n" if $DEBUG;
                    # just a plain word followed by punct
                    $rt .= "$_ ";
                }
                next;
            } elsif ( substr( $_, 0, 1 ) eq '\'' ) {    # if like 'IWR, like: 'twas
                # almost the same as previous case
                $actualWd = substr( $_, 1, length($_) - 1 );
                if ( exists( $iwrWords{$actualWd} ) ) {
                    print "\nDEBUG: single quote + IWR :\n $_\n" if $DEBUG;

                    # quoted iwr ie 'word
                    # but exclude the quotes
                    $rt .= "'$nt*WPM_F=$iwrWpm*${actualWd}*LHS**WPM=$wpm**FARN=$farn*$ot ";
                    $iwrWords{$actualWd}++; # record hit
                } else {
                    print "\nDEBUG: single quote + plain :\n $_\n" if $DEBUG;
                    # just a plain word followed by punct
                    $rt .= "$_ ";
                }
                next;
            } else {
                print "\nDEBUG: single quote within random word:\n $_\n" if $DEBUG;
                # just plain word
                $rt .= "$_ ";
                next;
            }
        } else {
            print "\nDEBUG: plain final chance:\n $_\n" if $DEBUG;
            # just plain word
            $rt .= "$_ ";
            next;
        }
    }

    if ($prosign_flag) {
        $rt =~ s/[<>]/*/g; # so they will attempt to sound as prosign
    } else {
        $rt =~ s/[<>]//g if !$prosign_flag; 
    }

    return $rt;    # modified with possible speed changes
}

# used ONLY if $iwr eq 2; that is SUFFIX mode, not WORD (see match_ck)
sub suffix_ck {
    my $words    = shift;   # save untouched. Return intact if this was test run
    my $line_cnt = shift;
    my $rt  = '';
    my @words;

    # if an existing *WPM was read and it exceeds the iwrWpm we will disable further use of iwr feature or else
    # the iwr words would be sent at a lower speed than the other text.
    if ( $wpm >= $iwrWpm ) { 
        print "\n WARNING: wpm speed ($wpm) exceeds suffix speed ($iwrWpm) at line ($line_cnt). suffix now disabled.\n";
        $iwr = 0;    # now disabled
        return $words;
    }

    # ********* "words" are really only "suffixes"

    $words =~ s/</ </g;
    $words =~ s/>/> /g;
    @words = split( ' ', $words );

    # modify the read line
    foreach (@words) {
      my $head = '';
      my $tail = '';
      my $suffix = '';
      my $foo = '';
      $wordsRead++;

      if ( substr( $_, 0, 1 ) eq '*' ) {
        $rt .= "$_ ";
        next;
      }

      if ( exists($iwrWords{$_}) ) {
          print "\nDEBUG: IWR word = suffix:\n $_\n" if $DEBUG;
          $iwrWords{$_}++; # record hit
          $rt .= "$_ ";
          next;
      } elsif ( $_ =~ m/^[A-Z]{4,}$/ ) { # simple suffix on a word
          print "\nDEBUG:  real word:\n $_\n" if $DEBUG;
          $foo = isItSuffix($_);
          $rt .= "$foo ";
          next;
      } elsif ( $_ =~ m/(^[A-Z]{4,})([,.?;'";_]+)$/ ) { # word at least 2 char followed by punct.
          print "\nDEBUG: suffix on a word + punct:\n $_\n" if $DEBUG;
          $head = $1;
          $tail = $2;
          $foo = isItSuffix($head);
          $rt .= "$foo$tail ";
          next;
      } elsif ( (substr( $_, 0, 1 ) eq '\'') || (substr( $_, 0, 1 ) eq '"' ) ) {    # if like: 'wd' or "wd" 
          print "\nDEBUG: got initial quote:\n $_\n" if $DEBUG;
          my $head;
          my $tail;
          my $actualWd = $_;
          $_ = m/(^['"]+)([A-Z]+)(['"]*)$/; 
          $head = $1;
          $tail = $3;
          $actualWd = $2;
          $rt .= $head;

          if ($2 =~ m/[A-Z]{4,}/) {
              $foo = isItSuffix($actualWd);
              $rt .= "$foo$tail ";
          } else {
              print "\nDEBUG: plain string (not all alphas) begins with quotes:\n $_\n" if $DEBUG;
              $rt .= "$_ ";
          }
          next;
      } else {
          print "\nDEBUG: plain word last chance:\n $_\n" if $DEBUG;
          $rt .= "$_ ";
          next;
      }
    }
    return $rt;
}

# isItSuffix will test suffixes in hash 
sub isItSuffix {
   my $string = shift;
   my $original = $string;
   my $hashSize = keys %iwrWords;
   my $rt = '';
   my $gotOne = 0;
   my $suffix = '';

   # string MAY be alphas+suffix, cycle through the suffix Use longest first

   if ($hashSize == 1) {
        for ( keys %iwrWords ) {
            $suffix = $_;
       }

       if ($_ =~ m/$suffix$/ ) {
          print "\nDEBUG:  string ends in STRING IS $string\n" if $DEBUG;
          $string =~ s/$suffix$//;
        
          print "\nDEBUG:  string now has :\n$string\n" if $DEBUG;
          # make sure $string is not too short
          if (length($string) < 2 ) {
              # we can't have suffix "ed" claim to be a suffix of "led"
              $rt = $original;
          print "\nDEBUG:  string TOO SHORT now has :\n$rt\n" if $DEBUG;
          } else {
              $rt .= "$string$nt*WPM_F=$iwrWpm*$suffix*LHS**WPM=$wpm**FARN=$farn*$ot ";
          print "\nDEBUG:  string GOOD  :\n$rt\n" if $DEBUG;
              $iwrWords{$suffix}++; # record hit
              $gotOne = 1;
          }
        }

    } else {
        print "\nDEBUG:  has size GREATER than 1 real word:\n\n" if $DEBUG;

        foreach my $suffix ( reverse sort { length $iwrWords{$a} <=> length $iwrWords{$b} } keys %iwrWords) {
          if ($string =~ m/$suffix$/ ) {
             $string =~ s/$suffix$//;
        
             # make sure $string is not too short
             if (length($string) < 2 ) {
                # we can't have suffix "ed" claim to be a suffix of "led"
                next;
             }
             $rt .= "$string$nt*WPM_F=$iwrWpm*$suffix*LHS**WPM=$wpm**FARN=$farn*$ot ";
             $iwrWords{$suffix}++; # record hit
             $gotOne = 1;
          }
        }
    }

    if ($gotOne) {
        return $rt;
    } else {
        return $string;
    }
}

# Test for number of files. Ask to proceed. Then do as asked.
my $wpm_start = $wpm;
if ( gus_morse(1) ) {    # First a test run.
    my $foo;

    # for IWR or suffix report
    if ($iwr > 0) {
        print "\n";
        print "\n        IWR Word Report" if ($iwr == 1 || $iwr == 11);
        print "\n         Suffix Report" if ($iwr == 2 || $iwr == 22);
        print "\n    IWR Word         Occurrences" if ($iwr == 1 || $iwr == 11);
        print "\n    Suffix           Occurrences" if ($iwr == 2 || $iwr == 22);
        print "\n ===============     ===========\n";

        my $iwrOcc = 0;
        foreach my $word ( reverse sort { $iwrWords{$a} <=> $iwrWords{$b} } keys %iwrWords) {
          printf(" %-15s           %d\n",$word,$iwrWords{$word}) if ($iwrWords{$word} > 0);
          $iwrOcc += $iwrWords{$word};
        }

        if ($iwr == 1 || $iwr == 11) { 
          printf("\n Total of (%d) IWR word occurrences found in (%d) IWR words given.\n",$iwrOcc,$wordsRead) 
        } else { # must be 2 or 22
          my $plural = 'es';
          if ($iwrOcc < 1 ) {
              $plural = '';
          }

          printf("\n Total of (%d) suffix%s occurrences found in (%d) suffix words read.\n",$iwrOcc,$plural,$wordsRead);
        }  
    } else {
        if ($emphasisTone != 0) {
	  print "\n";
	  print "\n Emphasized Symbol Report ";
	  print "\n   Symbol    Occurrences";
	  print "\n   ======   =============\n";
	  printf( "      %s         %d\n",$emphasisChar,$emphasizeCnt);
	}
    }

    print "\n Create file? (Y/n) > " if ($wav_cnt == 1);
    printf( "\n Create %s files? (Y/n) > ", $wav_cnt ) if ($wav_cnt > 1);

    chomp( $foo = <STDIN> );
    $foo = 'y' if (! $foo);

    if ( $foo =~ m/y/i ) {
       $test_flag = 0;
       $wpm       = $wpm_start;
       $dgt_cnt   = 3 if $wav_cnt < 999;
       $count_re  = '%0' . $dgt_cnt . 's';    # Set file enumeration format.
       $wav_cnt   = 0; 
       gus_morse(0);                           # Create files for real.
    } else {
       print "\n Exit, no files created.\n";
       exit(55);
    }
}

__END__
_
=head1 NAME

Morse Code Text-to-Audio Converter (NOT UPDATED FOR TXT2MORSE)

=head1 SYNOPSIS

C<perl gus_morse.pl --path /media/ramdisk/morse.txt --wpm 26 -incr 0.1 --farn
13 --decr 0.2 --tone 750 --samp 11025 --codec mp3 --rand>

=head1 DESCRIPTION

Reads in text file, writes out Morse code as audio file. Writes initially to
C<*.wav> then converts.

=head1 MODULES USED

C<Getopt::Long>

C<Audio::Wav>

C<File::Path qw( rmtree )>

C<File::Copy>

C<Config>

=head1 COMMAND LINE OPTIONS

Control behavior of text-to-audio conversion using these options.

=head2 --p[ath]
 
Valid system file path to input text file. Audio output file(s) will be written
to same directory, with extensions for inumeration and codec. 
Default = './morse.txt'

=head2 --w[pm] 

Character speed as words-per-minute...independent of character spacing. 
Default = 26.0.

=head2 --i[ncr] 

For each new file generated in series, increase the --wpm by this value in wpm.
Default = 0;

=head2 --f[arn] 

Farnsworth spacing. Spreads out inter-character & inter-word spacing by 
stretching the gaps to this value in WPM. 

=head2 --e[xtra] 

Inter-word spacing. Spreads out inter-word spacing by adding N to the 
7 PARIS elements for a space. Default = 0;

=head2 --d[ecr] 

For each new file generated in series, increase the --farn by this value
in wpm. Default = 0; 

=head2 --t[one] 

Tone of CW characters in Hz. Default = 700

=head2 --m[ins] 

Once output file exceeds this limit in minutes, a new file will split off at 
next major punctuation.

=head2 --n[opunct] 

Arg is a string of characters which are to be passed over or substituted when 
encountered in a text file.

=head2 --s[amp]

Sampling rate of the C<*.wav> file in Hz. Default = 11025.

=head2 --c[odec] 

Which audio codec (format) as final output? Default = C<wav> On Linux you may 
also choose C<*.ogg> if you have the C<oggenc> package installed or C<mp3> 
should you have the C<lame> package installed.

=head2 --g[raphic]

Path to  C<*.png> or C<*.jpg> file, if any, for cover-art tag. Used only with 
C<--codec mp3> on Linux.

=head2 --l[ang] 

Language of input C<*.txt> file and subsequent Morse code charset.

=over 

=item en 

English via US ASCII (Default)

=item eo

Esperanto: prefere laŭ Unikodo, anstataŭ la iksa sistemo. 

=item es

Spanish, includes N-tilde char.

=head2 --v[erbose] 

Verbosity flag provides verbose feedback.

=head2 --h[elp] Help

display basic help/usage message.

=head2 --test Test

Perform dry run as predictive test, generating no *.wav files. Use this mode to
try out various combinations of --wpm, --decr, --incr and view the results in
quick order. 

=head1 SPECIAL CHARACTERS

Converter will parse input text for *-delimited special characters. Examples:
*AR* *SK* *KN* *BT* *SOS* *ERROR*

=head1 EMBEDED OPERATORS

Converter will parse input text for *-delimited special operators. These have
the same effect as their CLI arg equivalents, but may be embeded mid-stream in
the text file so as to take effect mid-stream during the playout. Use them to
simulate QSO between multiple stations. 

=head2 Regular Ops

These have same effect as their CLI-arg equivalents. Examples: *TONE=775* 
*WPM=20.6* *DIFF=8.5* *LANG=EN* *LANG=EO* *QUIT=99* *GRAPIC=COVER.JPG*

These differ from their CLI-arg equivalents in requiring either a 0 or a 1 as 
integer arguments. On the CLI they are flags, always equal to 1. As embedded 
operators they may be toggled on and off.

=head2 *NEXT*

This op has no CLI-arg equivalent. Its function is to trigger a break between 
consecutive output files.

=head1 BUILT-IN REGEX

=head2 Roman Numerals

Chapter titles enumerated as Roman will all become Arabic up to a limit of 100.

=head2 Excess Whitespace

Plural spaces will be reduced to single, leading and trailing spaces on lines
removed.

=head2 Full Stop

Sentence final punctuation is followed by a short pause, as would be heard if 
read by a human narrator.

=head1 AUTHOR

Gan Uesli Starling <F<gan@starling.us>>
Bill Lanahan <F<wa2nfn@qsl.net>>

=head1 LICENSE

Authored 2006-2023, Gan Uesli Starling, KY8D, VA7KYD, T000000139. 
Enhancements Authored 2023, Bill Lanahan, WA2NFN.
No rights reserved.

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

=head1 SCRIPT CATEGORIES

Convert

=cut
