#!/usr/bin/perl -w # Copyright 1998-2008 "Nosey" Nick Waterman, Ward Cunningham and Jim Wilson # Distributed under the GNU GPL V2 license. # See http://noseynick.net/va3nnw/cw/ and http://c2.com/morse # # This file is part of the Nilex Morse Tutor. # # The Nilex Morse Tutor is free software; you can redistribute it # and/or modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 of # the License, or (at your option) any later version. # # The Nilex Morse Tutor is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied warranty # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License along # with the Nilex Morse Tutor: http://noseynick.net/va3nnw/cw/license.txt # If not, write to the Free Software Foundation, Inc., 59 Temple # Place, Suite 330, Boston, MA 02111-1307 USA use bytes; # we're dealing with unsigned 8-bit bytes, not unicode chars. # takes input and converts it to morse, in the form of raw PCM audio # data for a given letter or phrase, or can be run as a CGI, in which # case it also feeds itself through LAME for mp3 output. # samples/sec for the raw output. my $samp = 16000; ###################################################################### # PLEASE UPDATE THIS IF THE SCRIPT CHANGES SIGNIFICANTLY ###################################################################### # date '+my $last_modified = "%a, %d %b %Y %X GMT";' --utc my $last_modified = "Sun, 18 Oct 2009 23:00:00 GMT"; # -s matches $samp above, and must be 8/11.025/12/16/22.05/24/32/44.1/48 # -m mode (mono) my $lame = "/usr/bin/lame" . " -s 16 --bitwidth 8 --unsigned -m m --preset phone"; my $usage ="usage: $0 freq is tone frequency in Hz wpm is morse speed in words per minute text is the letter or text to send. produces raw mono 16kHz 8-bit PCM output EG: $0 500 30 CQ CQ CQ DE VA3NNW | $lame -r - cq.mp3 "; $lame .= " --nohist --quiet"; # alphabet: my %morse = ( "0"=>"-----", "1"=>".----", "2"=>"..---", "3"=>"...--", "4"=>"....-", "5"=>".....", "6"=>"-....", "7"=>"--...", "8"=>"---..", "9"=>"----.", "A"=>".-", "B"=>"-...", "C"=>"-.-.", "D"=>"-..", "E"=>".", "F"=>"..-.", "G"=>"--.", "H"=>"....", "I"=>"..", "J"=>".---", "K"=>"-.-", "L"=>".-..", "M"=>"--", "N"=>"-.", "O"=>"---", "P"=>".--.", "Q"=>"--.-", "R"=>".-.", "S"=>"...", "T"=>"-", "U"=>"..-", "V"=>"...-", "W"=>".--", "X"=>"-..-", "Y"=>"-.--", "Z"=>"--..", " "=> "/", "APOS"=>".----.", "'"=>".----.", "AT"=>".--.-.", '@'=>".--.-.", "COLON"=>"---...", ":"=>"---...", "COMMA"=>"--..--", ","=>"--..--", "EQUAL"=>"-...-", "="=>"-...-", "MINUS"=>"-....-", "-"=>"-....-", "PLUS"=>".-.-.", "+"=>".-.-.", "QUOTE"=>".-..-.", '"'=>".-..-.", "SEMI"=>"-.-.-.", ";"=>"-.-.-.", "SLASH"=>"-..-.", "/"=>"-..-.", "STOP"=>".-.-.-", "."=>".-.-.-", "BR"=>"-.--.", "("=>"-.--.", "RB"=>"-.--.-", ")"=>"-.--.-", "DOLLAR"=>"...-.-", '$'=>"...-.-", "QUESTION"=>"..--..", "?"=>"..--..", "UNDERSCORE"=>"..--.-", "_"=>"..--.-", ); my %syms = ( "APOS"=>"'", "AT"=>'@', "COLON"=>":", "COMMA"=>",", "EQUAL"=>"=", "MINUS"=>"-", "PLUS"=>"+", "QUOTE"=>'"', "SEMI"=>";", "SLASH"=>"/", "STOP"=>".", "BR"=>"(", "RB"=>")", "DOLLAR"=>'$', "QUESTION"=>"?", "UNDERSCORE"=>"_", ); sub cgidie { my $status = shift; print "Status: $status\n", "Content-Type: text/plain\n\n", "ERROR: @_\n"; exit 0; } if ($ENV{GATEWAY_INTERFACE}) { cgidie(400, "No PATH_INFO") unless $ENV{PATH_INFO}; cgidie(400, "Bad PATH_INFO") unless $ENV{PATH_INFO} =~ m|^/?(\d+)hz/(\d+)wpm/(\w+).mp3$|; my ($freq, $wpm, $msg) = ($1, $2, $3); cgidie(400, "zero hz") unless $freq; cgidie(400, "zero wpm") unless $wpm; $msg = $syms{uc $msg} if $syms{uc $msg}; my $tmpfile = "/tmp/cw-cgi.$$.raw"; open(OUT, ">$tmpfile") or cgidie(500, "can't write tmp raw"); print OUT gen_raw($freq, $wpm, $msg); close OUT; unless (open(IN, "$lame $tmpfile $tmpfile.mp3 |")) { unlink $tmpfile, "$tmpfile.mp3"; cgidie(500, "Can't run LAME"); } while () {} # discard any LAME output close IN; unlink $tmpfile; unless (open(IN, "$tmpfile.mp3")) { unlink "$tmpfile.mp3"; cgidie "500, Can't read LAME output"; } print "Last-Modified: ", $last_modified, "\n", "Content-Length: ", (-s "$tmpfile.mp3"), "\n", "Content-Type: audio/mpeg\n\n"; while () { print $_ } close IN; unlink "$tmpfile.mp3"; exit 0; } else { my $freq = shift || die $usage; my $wpm = shift || die $usage; print gen_raw($freq, $wpm, join(" ", @ARGV)); } sub gen_raw { my ($freq, $wpm, $msg) = @_; # X WPM = X * "PARIS" / min # PARIS = 50 dits total (inc spaces), so X WPM = X*50 DPM # X*50 dits = 60 secs # X dits = 1.2 secs, so: # 1 dit = 1.2 secs / X WPM my $wave = ""; my $up = ""; my $dn = ""; my $wavelen = 100; if ($freq > 0) { # samples per wavelength $wavelen = int($samp / $freq); # make one sine wave: my $twopi = 8 * atan2(1,1); $twopi = $twopi / $wavelen; for (0 .. $wavelen-1) { $wave .= chr((100 * sin($twopi * $_))+128); } # for a nicer keying envelope: # Make a rising 4-wave sample, and a falling 4-wave sample # sin^2(x) gives gausian rise in pi/2 # we want to get from 0 to pi/2 in 4 wavelens... # ... equiv of 0 to 2pi in 16 wavelengths my $risetime = $twopi / 16; for (0 .. ($wavelen*4)-1) { my $sqrtamp = sin($risetime * $_); $up .= chr((100 * sin($twopi * $_) * $sqrtamp * $sqrtamp)+128); $sqrtamp = cos($risetime * $_); $dn .= chr((100 * sin($twopi * $_) * $sqrtamp * $sqrtamp)+128); } } else { # dummy 0hz "wave" $wave = chr(128) x $wavelen; } unless ($wpm > 0) { # dummy 0wpm actually means we whould output a 5s continuous tone # and ignore $msg return $wave x (($samp * 5) / $wavelen); } # wavelengths per dit / dah. Trim by 4 for the up/down envelope shapes my $ditlen = int(($samp * 1.2 / $wpm / $wavelen) + .5) - 4; my $dahlen = int(($samp * 3.6 / $wpm / $wavelen) + .5) - 4; # make one dit, one dah, one inter-char gap: my $shh = chr(128) x ($wavelen * $ditlen); my $dit = $up . ($wave x $ditlen) . $dn . $shh; my $dah = $up . ($wave x $dahlen) . $dn . $shh; # I know you think spaces are 3 dits long, but the previous symbol # already ended with 1 dit of silence, so we need to add 2 more: $shh = chr(128) x ($samp * 2.4 / $wpm); # convert args into -.-. my $syms = join " ", map {$morse{$_} || "?"} split //, uc $msg; # and -.-. into actual tones (ignore '/' or other) my %sym2cw = ("." => $dit, "-" => $dah, " " => $shh); return join "", map {$sym2cw{$_}||""} split //, $syms; }