#!perl -w
#!/usr/bin/perl -w
use strict;
# winzode users need Win32::Sound;
# Please test it on other platforms blah blah
# i didn't use Audio::DSP;
# just because it's possible to write raw data directly to /dev/dsp
# It took me about a whole day(24h) to finish this, mainly because of
+the pod
# and because i kept adding on to the thing, so i ended up changing it
+ quite
# a bit. What really had me at one point is determening what to do wi
+th the
# input(translate to or from morse) mainly because i am a regex loser,
+ but
# luckily Petruchio came to the rescue with ($string =~ /[^ .-]/)
# and i never messed with any -switch stuff so that required some thin
+king/modi.
# added -morse switch because of epoptai 12/31/2000
# also pondered adding -case : adds |b4C ~b4c but it would only have v
+alue for
# but decided not to, for now, since morse code doesn't distinguish be
+tween case
# also updated the documentation some
# Got the clean bill of health from podchecker (no warnings & i got po
+d ;)
# This version has all the 'development' variables, and i don't feel l
+ike
# changing it anytime soon, maybe sometime in the future, but not like
+ly
# i also pondered where to post this, cool uses for perl or craft, and
+ decided
# to put it in the code catacombs under audio related programs
# whether or not it will be useful to anyone else, radio amateurs mayb
+e
# *explore* and enjoy ;)
my $pitch = .21;
my $volume = '100';
my $duration = .1; #of a $second
my $soundoff; # you really shouldn't modify any vars on this line and
+below
my $saveas;
my $this;
my $vol1;
my $arger = 'if(!defined$ARGV[0]){print "you need to enter a message";
+exit;}';
my $mango;
my $doozle;
my $dazzle;
my $drazle;
my %SW=('-?' =>q( eval("$SW{'-help'}") ),
'-dur' =>'if(defined $ARGV[0]){$duration=shift;if($duration
+=~ /[-+'.
']?\d+/){if(!($duration>0)){print "you need to ente
+r a numb'.
'er > 0";exit;}}else{print "not a number\n";exit;}}
+else{pri'.
'nt "missing number\n";exit;}',
'-fukc' =>'while(<DATA>){if(/__END__/){select(undef,undef,und
+ef,0'.
'.5);exit;}print $_;}',
'-help' => q(print "\n".'-dur real > 0 : specifies the durati
+on of a ).
q(dot (see NOTES for more detail)'."\n \n".'-pitch
+ 0 > rea).
q(l < 2 : specifies the pitch of the tone used'."\
+n \n".'-).
q(help : displays a brief description of all the s
+witches').
q(."\n \n".'-man : displays the pod for morsify '.
+"\n \n".).
q('-save $filename(.wav) : saves the sound as $fil
+ename.wa).
q(v'."\n \n".'-sound : turns sound off [ie. the me
+ssage is).
q( only translated]'."\n \n".'-text : forces morsi
+fy to tr).
q(anslate .-. into, as opposed from, morsecode'."\
+n \n".'-).
q(vol real > 0 : set the volume to num (default 10
+0%) of t).
q(he wav mixer setting'."\n";exit;),
'-man' =>'system("perldoc $0");exit;',
'-morse' =>'$dazzle=1;undef $drazle;',
'-pitch' =>'if(defined $ARGV[0]){$pitch =shift;if (!($pitch =~
+ /[-'.
'+]?\d+/)){print"$pitch in -pitch != numb";exit;}if
+(!(($pit'.
'ch > 0) && ($pitch < 2))){print "the pitch must be
+ betwee'.
'n 0 and 2";exit;}}else{print "you need to enter a
+0 < pit'.
'ch < 2";exit;}',
'-save' =>'if(defined $ARGV[0]){$saveas=shift;if(lc(substr($s
+aveas'.
',-4)) ne q(.wav)){$saveas.=".wav";}if(!($saveas=~
+/(\w)/))'.
'{print "warning, filename seems funky, may not sa
+ve \n'.
'";}}else{print "missing filename and\n";}',
'-sound' =>'$soundoff = 1;',
'-text' =>'$dazzle=1;$drazle=1;',
'-thank' =>'for(0..8){print " "x($_*$_)."carrots n p-funk!\n";
+}exit;',
'-vol' =>'if(defined $ARGV[0]){$volume =shift;if($volume =~
+/(\D)/)'.
'{print"$volume in -vol != number";exit;}if($'.
'volume < 1){print "the volume must be > 1";exit;}}
+else'.
'{print "you need to enter a volume";exit;}$vol1=66
+6;',
);
if(defined @ARGV)
{
while(exists($SW{$ARGV[0]}))
{
$mango = shift @ARGV;
eval("$SW{$mango}");
eval("$arger");
}
$this = (defined @ARGV) ? join(' ',@ARGV): '~`><#@$%^&*\"[]';
if($this =~ /[^ .-]/)#P: decide whether it's morse or not
{ $doozle = 1; }
if(defined $dazzle)
{$doozle = $drazle;}# if -text was passed defines $doozle
if(defined $doozle)
{
$this = &morse(1,$this);
print $this;
&morsesound($this);
}
else
{
&morsesound($this);
print &morse(0,$this);
}
}
else
{
print"syntaxt: $0 -[?,dur,help,man,morse,pitch,save,sound,text] mo
+rseORtxt";
exit;
}
sub morse
{
my %chars=(
'A' => '.-', 'B' => '-...', 'C' => '-.-.', 'D' =>
+ '-..',
'E' => '.', 'F' => '..-.', 'G' => '--.', 'H' =>
+ '....',
'I' => '..', 'J' => '.---', 'K' => '-.-', 'L' =>
+ '.-..',
'M' => '--', 'N' => '-.', 'O' => '---', 'P' =>
+ '.--.',
'Q' => '--.-', 'R' => '.-.', 'S' => '...', 'T' =>
+ '-',
'U' => '..-', 'V' => '...-', 'W' => '.--', 'X' =>
+ '-..-',
'Y' => '-.--', 'Z' => '--..', '1' => '.----', '2' =>
+ '..---',
'3' => '...--', '4' => '....-', '5' => '.....', '6' =>
+ '-....',
'7' => '--...', '8' => '---..', '9' => '----.', '0' =>
+ '-----',
',' => '--..--', '.' => '.-.-.-', '?' => '..--..', '!' =>
+ '.----.',
';' => '-.-.-', ':' => '---...', '/' => '-..-.', '-' =>
+ '-....-',
"'" => '.----.', '(' => '-.--.-', ')' => '-.--.-', '_' =>
+ '..--.-',
'Á' => '.--.-', #A w/a accent
'Å' => '.--.-', #A w/a circle
'Ä' => '.-.-', #A w/2 dots
'É' => '..-..', #E w/a accent
'Ñ' => '--.--', #N w/a tilde
'Ö' => '---.', #O w/2 dots (umlaut)
'Ü' => '..--', #U w/2 dots (umlaut)
);# endof %chars
my $abc = "";
if($_[0]==1)
{
my $dis = $_[1];
$dis =~ tr/[a-z]/[A-Z]/;
my @dis = split('',$dis);
for(0..$#dis)
{
if(defined $chars{$dis[$_]})
{ $dis = $chars{$dis[$_]}; }
else
{ $dis = $dis[$_]; }
$abc .= $dis . " ";
}
}
else
{
my %inverse_chars = reverse(%chars);
my $dis = $_[1];
my @words = split(' ',"$dis");
for(0..$#words)
{
my @letters = split(' ',$words[$_]);
for my $op(0..$#letters)
{
if(defined $inverse_chars{$letters[$op]})
{ $dis = $inverse_chars{$letters[$op]}; }
else
{ $dis = $letters[$op]; }
$abc .= $dis;
}
$abc .= " ";
}
}
return $abc;
}
sub morsesound
{
my $increment = 440/44100;# 440 / num of samples that add up to 1
+sec
my $dit = "";
my $counter = 0;
my $v;
my $silence = "";
my $daw = "";
if((!defined $soundoff)or(defined $saveas))
{# if da person doesn't want to hear it, or save it, don't generat
+e it
for (1..($duration*44100))
{
# Calculate the pitch
# (range 0..255 for 8 bits)
$v = sin($counter/$pitch*3.14) * 128 + 128;
# "pack" it twice for left and right
$dit .= pack("cc", $v, $v);
$counter += $increment;
}
$counter=0;
for (1..(44100*$duration*3))
{# not really silence, but pitch so low it practically is
# Calculate the pitch
# (range 0..255 for 8 bits)
$v = sin($counter/$pitch*3.14) * 128 + 128;
# "pack" it twice for left and right
$daw .= pack("cc", $v, $v);
$counter += $increment;
}
$counter=0;
for (1..(44100*$duration))
{# not really silence, but pitch so low it practically is
# Calculate the pitch
# (range 0..255 for 8 bits)
$v = sin($counter/999999*3.14) * 128 + 128;
# "pack" it twice for left and right
$silence .= pack("cc", $v, $v);
$counter += $increment;
}
}
my $stringmorse = shift; # get the string passed
my $soundmorse = ""; # to be played (the wav)
my @msg = split('',"$stringmorse");
for(my $ix=0;$ix<(@msg);$ix++)
{
if($msg[$ix] eq '.')
{
$soundmorse .= "$dit$silence";
}
elsif($msg[$ix] eq '-')
{
$soundmorse .= "$daw$silence";
}
elsif($msg[$ix] eq ' ')
{
$soundmorse .= "$silence"x3;
if(($ix >= 1) && ($msg[$ix-1] eq ' '))
{#if there are 2 spaces in a row, it indicates a word, and
+ words
$soundmorse .= "$silence"x4; # are separated by 7 sp
+aces
}
}
}
if($^O =~ /MSWin32/i)
{
eval("use Win32::Sound;"); # put in eval thanx to ichimunki
if(defined $vol1)
{ Win32::Sound::Volume($volume.'%') or die "Can't get volume:
+ $!"; }
my $WAV = new Win32::Sound::WaveOut(44100, 8, 2);# rate|format
+|channel
if(!defined $soundoff)
{
$WAV->Load("$soundmorse"); # get it
$WAV->Write(); # hear it
1 until $WAV->Status(); # wait for completion
}
if(defined $saveas)
{
$WAV->Save("$saveas","$soundmorse"); # write to disk
}
$WAV->Unload(); # drop it
}
else
{
if(!defined $soundoff)
{# printing directly to /dev/dsp should work
$| = q/flush it out right away/;
open(NIXSOUND,'>/dev/dsp') or die "can't open /dev/dsp 4 w
+: $!";
print NIXSOUND $soundmorse;
close(NIXSOUND);
}
if(defined $saveas)
{
open(WAVOUT,">$saveas") or die "can't open $saveas 4 writi
+ng: $!";
print WAVOUT $soundmorse;
print WAVOUT "\n";# added cause of, or thanx to ichimunki
close(WAVOUT);
} # write to disk
}
}
close(STDOUT);
__DATA__
i like java
i like jikes.org
you may shoot me now, if you wish, you ignorant perlophile
"-.-. .-. .- --.. -.-- .-.. .. -.- . .- ..-. --- -..- .----."
".--- ..- ... -
.- -. --- - .... . .-.
.--. . .-. .-..
.-- .... .- -.-. -.- . .-."
__END__
=pod
=head1 NAME
morsify - Translate standard input into morse/text code and sound it o
+ut
=head1 SYNOPSIS
=over 4
=item SWITCHES
=back
=over 6
=item -?
=begin text
see -help
=end text
=item -dur real E<gt> 0
=begin text
specifies the duration of a dot (see NOTES for more detail)
=end text
=item -help
=begin text
displays a brief description of all the switches
=end text
=item -man
=begin text
displays this 'man' page (POD!)
=end text
=item -morse
=begin text
forces morsify to translate as much morse into text as possible
=end text
=item -pitch 0 E<gt> real E<lt> 2
=begin text
specifies the pitch of the tone used
=end text
=item -save $filename(.wav)
=begin text
saves the 'sound msg' as $filename(.wav) if it doesn't end in .wav
=end text
=item -sound
=begin text
turns sound off (ie. the message is only translated)
=end text
=item -text
=begin text
forces morsify to translate as much text into morse as possible
=end text
=item -vol real E<gt> 0
=begin text
set the volume to num (default 100%) of the wav mixer setting
at some point(on my system 650+) it toppels over and starts from zero
=end text
=back
=begin text
*> perl morsify.pl morsify n sound
*> -- --- .-. ... .. ..-. -.-- -. ... --- ..- -. -..
=end text
=over 4
=item oE<72>
=back
=begin text
*> perl morsify.pl "morsify n sound"
*> -- --- .-. ... .. ..-. -.-- -. ... --- ..- -. -..
=end text
=over 4
=item OR
=back
=begin text
*> perl morsify -- --- .-. ... .. ..-. -.-- -. ... --- ..- -.
+-..
*> MORSIFYNSOUND
=end text
=over 4
=item or
=back
=begin text
*> perl morsify "-- --- .-. ... .. ..-. -.-- -. ... --- ..- -.
+ -.."
*> MORSIFY N SOUND
=end text
=head1 DESCRIPTION
I<morsify> takes standard input and translates it into morse code.
Unkown characters are ignored.
=head1 ENVIRONMENT
I<morsify> is not affected by any environment variables.
=head1 COMPATIBILITY
Should run on all Win9x/NT/2000 with Win32::Sound; as well as all *nix
+ which
have /dev/dsp
Only these characters: a..z|0..9|.|?|!|'| |/|:|;|-|Á|Ä|É|Ñ|Ö|Ü :are t
+ranslated
but these and others: | ~ ` E<gt> E<lt> # @ $% ^ & * \ " [ ] :are jus
+t ignored.
=head1 NOTES
*> perl morsify -this
results in
*> -....- - .... .. ...
and not an invalid switch warning
If the duration of a dot is taken to be one unit then that of a dash i
+s three
units. The space between the components of one character is one unit,
+between
characters is three units and between words seven units. To indicate t
+hat a
mistake has been made and for the receiver to delete the last word s
+end
........ (eight dots).
characters translated into morse are separeated by a single space, whi
+le words
are separated by two (ie: "e ee" results in ". . .")
=head1 BUGS
I<morsify> has no known bugs.
=head1 AUTHOR
This Perl version of I<morsify> was written by DH
I<crazyinsomniac@yahoo.com> who might wish to reveal his
real sometime in the future.
=head1 COPYRIGHT and LICENSE
This program is copyright (c) DH I<crazyinsomniac@yahoo.com> 2001.
This program is free and open source. You may use, modify, and distri
+bute,
but not sell, this program (and any modified variants) in any way you
+wish,
provided you do not restrict others from doing the same, and you give
+B<I<ample>>
credit to me %:-)
=cut
|