#!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 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 = ( '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 1, '' => 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 = ); $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 = ); $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 = ); $incr = $foo if $foo =~ m/^[0-9.]+$/; print "\n"; printf(" Farns/Words-worth speed, in wpm ( <= %d, 0 = none)? (0): ",$menuWpm); chomp( $foo = ); $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 = ); $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 = ); $decr = $foo if $foo =~ m/^[0-9.]+$/; } $wpm = $menuWpm; print "\n"; print " Extra dit-widths between words? ($extra): "; chomp( $foo = ); $extra = $foo if $foo =~ m/^[0-9]+$/; print "\n"; print " CW tone in hz? ($tone): "; chomp( $foo = ); $tone = $foo if $foo =~ m/^[0-9]+$/; print "\n"; print " File length, in minutes? ($max_wav_mins): "; chomp( $foo = ); $max_wav_mins = $foo if $foo =~ m/^[0-9.]+$/; print "\n"; print " Max number of output files? ($quit_limit): "; chomp( $foo = ); $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 = ); if ($foo =~ m/s/i) { $iwr = 2; print " Suffix file? (ending in .txt): "; chomp( $foo = ); $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 = ); $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 = ); $emphasisTone = $foo if ($foo =~ m/[0-9]+/); if ($emphasisTone != 0) { print " Use tone as a pre-alert (y/N): "; chomp( $foo = ); $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 = ); $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 = ); $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 = ); $emphasisTone = $foo if ($foo =~ m/[0-9]+/); if ($emphasisTone != 0) { print " Use tone as a pre-alert (y/N): "; chomp( $foo = ); $alertTone = 1 if ($foo =~ m/y/i); } } if ($emphasisTone == 0) { print "\n"; print " A symbol to emphasize, by tone? : "; chomp( $foo = ); 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 , 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 = ); $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 = ); if ( ! $foo || $foo =~ m/y/i) { ; } else { print " Ignore: []() (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/[\(\[\)\]]//g; } print " Ignore: _- (underscore, dash) (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/[_-]//; } print " Ignore: ! (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/!//; } print " Ignore: @ (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/@//; } print " Ignore: \$ (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/\$//; } print " Ignore: ; (semicolon) (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/;//; } print " Ignore: : (colon) (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/://; } print " Ignore: ' (apostrophe) (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/'//; } print " Ignore: \" (double quote) (Y/n): "; chomp( $foo = ); if ( $foo =~ m/n/i ) { $punct =~ s/"//; } print " Ignore ALL you list (enter for none): "; chomp( $foo = ); if ( $foo !~ '' ) { $foo = uc($foo); $punct .= $foo; } } print "\n"; print " Sound formatted ProSigns? (Y/n): "; chomp( $foo = ); $prosign_flag = 0 if ( $foo =~ m/n/i); print "\n"; print " Silence audible header? (Y/n): "; chomp( $foo = ); $silenceHeader = 0 if ( $foo =~ m/n/i); if ($lame) { print "\n"; print " Output as WAV or MP3 files? ($codec): "; chomp( $foo = ); $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 () { 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 = < 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 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 <== 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: & same sound different look in text & 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: Punctuation sometimes in prosign format, sent as the actual punctuation: (question mark ?) (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 = ); 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 () { ++$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}>)|(|)//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; @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 = 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 = ); $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 =head1 DESCRIPTION Reads in text file, writes out Morse code as audio file. Writes initially to C<*.wav> then converts. =head1 MODULES USED C C C C C =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 On Linux you may also choose C<*.ogg> if you have the C package installed or C should you have the C 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 > Bill Lanahan > =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