Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

morsify

by crazyinsomniac (Prior)
on Dec 31, 2000 at 10:50 UTC ( [id://49070]=sourcecode: print w/replies, xml ) Need Help??
Category: Audio Related Programs
Author/Contact Info crazyinsomniac - /msg me
Description: I was talkin' w/my dad, about when he was in the army and stuff, and he got to talkin' how he was great w/radio/morse and that type stuff, so i made this script that translates between morse and text and 'sounds' it out. It has a bunch of options and pod ;)
#!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
Replies are listed 'Best First'.
(crazyinsomniac) Re: morsify
by crazyinsomniac (Prior) on Jan 02, 2001 at 03:16 UTC
    I updated this script about an hour or two after i posted it and epoptai blurted out this in the cb:
    "-.-. .-. .- --.. -.-- .. -. ... --- -- -. .. .- -.-. + +"
    after running it through morsify i realized that a -morse switch is not a waste, so i added it.

    all of this is reflected above in the #comments.
    I also updated(improved) the pod some.

    UPDATE:(January 1, 2001)
    Due to ichimunkis help, i realized that line 271( use Win32::Sound) needed to be changed to (eval("use Win32::Sound;");) since use is a compile time directive(i think that's right) and it was asking for Win32 even though he was on *nix, and i 'coded' the script to just print to /dev/dsp, so it should be fine now.
    i also added line 304(print WAVOUT "\n";) thanx to ichimunki

    UPDATE:(January 5, 2001)
    For a couple of days now the description text was also in the code field. This was caused, in my humble opinion, by me accidentaly pasting the description there, as opposed something being wrong with the pm database, but it's back now, the latest official release %-)

    UPDATE:(February 1, 2001)
    isotope pointed out that: open(WAVOUT,"$saveas") or die "can't open $saveas 4 writing: $!"; opens a file for reading. I agreed.

    "cRaZy is co01, but sometimes cRaZy is cRaZy".
                                                          - crazyinsomniac

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://49070]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2024-03-19 04:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found