back

morse2wav.pl

This will output a .wav file of the morse code translation of a text string. The output is mono, 44.1k, 16-bit.

usage: perl morse2.wav outputfile.wav "string to be converted"
#!/usr/bin/perl --

#	convert a string into morse code and from that into a .wav file
#
# 	v1.0 - (C) d.shaw 03.09.2014
#
#	Should anyone find this code, I'll apologise now for the state of it.  It's a mashed up hack of a couple of other bits of code.
#	I'm sure that writing from scratch would've been a much bette option.  But it works for the job I need it for.

use Audio::Wav;

##	Setup variables

$dot = 0.06;						# 60 milliseconds (by convention)
$dash = $dot * 3;					# all timings are based on dots (by convention))
$d_interval = $dot;					# interval between internal elements of dots/dashes
$letter_interval = $dot * 3;		# interval between each letter
$word_interval = $dot * 5;			# interval between each word
$d_freq = 600;						# frequency that the dots/dashes should be played at

									# if i'm going to make this change-able from the shell, then $dot and $d_freq are the two that'll be needed

$outputfilename = $ARGV[0];
$inputmorsestring = $ARGV[1];

open_wave_file ( $outputfilename );
$convertedmorsestring = make_morse_string ( $inputmorsestring );
iterate_the_morse ($convertedmorsestring);
close_wave_file();

exit(0);



#######################################################################################
## subs
#######################################################################################

sub make_morse_string {
	$istring = $_[0];
	$istring_len = ( length ($istring) ) - 1;
	$ostring = "";

	$istring = lc $istring;

	for $offset (0 .. $istring_len) {
		$morsevalue = get_morse ( substr ( $istring, $offset, 1) );
		$ostring = $ostring . $morsevalue . ";";	# add on the ; character to be able to stick in letter boundary intervals
		}
	
	return $ostring;
}

###########################################################################################################################

sub get_morse {
	$letter = $_[0];
	if ($letter eq "a") { return ".-" };
	if ($letter eq "b") { return"-..." };
	if ($letter eq "c") { return "-.-." };
	if ($letter eq "d") { return "-.." };
	if ($letter eq "e") { return "." };
	if ($letter eq "f") { return "..-." };
	if ($letter eq "g") { return "--." };
	if ($letter eq "h") { return "...." };
	if ($letter eq "i") { return ".." };
	if ($letter eq "j") { return ".---" };
	if ($letter eq "k") { return "-.-" };
	if ($letter eq "l") { return ".-.." };
	if ($letter eq "m") { return "--" };
	if ($letter eq "n") { return "-." };
	if ($letter eq "o") { return "---" };
	if ($letter eq "p") { return ".--." };
	if ($letter eq "q") { return "--.-" };
	if ($letter eq "r") { return ".-." };
	if ($letter eq "s") { return "..." };
	if ($letter eq "t") { return "-" };
	if ($letter eq "u") { return "..-" };
	if ($letter eq "v") { return "...-" };
	if ($letter eq "w") { return ".--" };
	if ($letter eq "x") { return "-..-" };
	if ($letter eq "y") { return "-.--" };
	if ($letter eq "z") { return "--.." };
	if ($letter eq ".") { return ".-.-.-" };
	if ($letter eq ",") { return "--..--" };
	if ($letter eq "?") { return "..--.." };
	if ($letter eq "/") { return "-..-." };
	if ($letter eq "@") { return ".--.-." };
	if ($letter eq "1") { return ".----" };
	if ($letter eq "2") { return "..---" };
	if ($letter eq "3") { return "...--" };
	if ($letter eq "4") { return "....-" };
	if ($letter eq "5") { return "....." };
	if ($letter eq "6") { return "-...." };
	if ($letter eq "7") { return "--..." };
	if ($letter eq "8") { return "---.." };
	if ($letter eq "9") { return "----." };
	if ($letter eq "0") { return "-----" };
	if ($letter eq " ") { return " " };
	return " ";
}

###########################################################################################################################

sub open_wave_file () {
	
	$write_filename = $_[0];
	$out_wav = new Audio::Wav;

	$sample_rate = 44100;
	$bits_sample = 16;
	
	$details = {
    	'bits_sample'   => $bits_sample,
    	'sample_rate'   => $sample_rate,
    	'channels'      => 1,
    	# if you'd like this module not to use a write cache, uncomment the next line
    	#'no_cache'     => 1,

	};

	$write = $out_wav -> write( $write_filename, $details );
}

###########################################################################################################################

sub close_wave_file () {

	$write -> finish();
}

###########################################################################################################################

# argumanets are frquency in hz, time in seconds, and -1 for zero sound
sub add_sine {

    my $hz = shift;
    my $length = shift;
    my $no_sound = shift;
    my $pi = ( 22 / 7 ) * 2;
    $length *= $sample_rate;
    
    if ( $no_sound == -1 ) {
    	$max_no =  0;
    }
    else {
    	$max_no =  ( 2 ** $bits_sample ) / 2;
	}
	
	for my $pos ( 0 .. $length ) {
		$time = $pos / $sample_rate;
    	$time *= $hz;
		my $val = sin $pi * $time;
		my $samp = $val * $max_no;
        $write -> write( $samp );
	}
}

###########################################################################################################################

sub iterate_the_morse {

	$inputstring = $_[0];
	$inputstring_len = ( length ($inputstring) ) - 1;

	for $offset (0 .. $inputstring_len) {
		$what = substr ( $inputstring, $offset, 1);
		
		if ( $what eq '.' ) {
			add_sine ( $d_freq, $dot , 0);
			add_sine ( $d_freq, $d_interval, -1);
		}
	
		if ( $what eq '-' ) {
			add_sine ( $d_freq, $dash , 0);
			add_sine ( $d_freq, $d_interval, -1);
		}
		
		if ( $what eq ';' ) {
			add_sine ( $d_freq, $letter_interval , -1);
		}
		
		if ( $what eq ' ' ) {
			add_sine ( $d_freq, $word_interval , -1);
		}
		
	}

}

All this code is © 2006 - 2015, except for the noted pieces which are © to their authors as noted. Feel free to use anything you find here, I'm not that precious about it. Take it, improve it, make lots of cash with it, it's a gift.

back