#!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
In reply to morsify by crazyinsomniac
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |