Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Morse::Code

by crazyinsomniac (Prior)
on Apr 16, 2001 at 05:15 UTC ( #72728=CUFP: print w/replies, xml ) Need Help??

Hello,
A couple of months ago i wrote morsify, and now comes the first edition of morsify gone the way of the module. You can download a tarball at http://www.crazyinsomniac.f2s.com/perl/(or http://crazyinsomniac.perlmonk.org/perl/) complete with Makefile.pl, a readme, manifest, etc.

Anyway, I am somewhat proud of this, and would really like your suggestions/comments/criticism as always, whether it be stylical or whatever. Pretty soon, when i complete Morse::Sound and Morse::Fancy, I'll upload this to cpan, at which time my real name might be revealed.(I'm not sure if they'll let me upload with just my initials).

The module itself works in Object and Objectless mode, as is noted in the pod. Please read the pod. Initially I was gonna post this in Craft, but didn't like the automatic formatting, and didn't feel this was quite complete for the Code Catacombs, so it's here, in CUFP

Here goes:

#!perl -w # Morse::Code # # Provides for translating between text and morsecode. # Author: crazyinsomniac at perlmonks.org(10277) aka crazyinsomniac @ +yahoo.com # $Id: Morse::Code.pm,v 0.1 2001/04/14 07:28:35 crazyinsomniac Exp $ # the above $Id statement i emulated from zzamboni at perlmonks.org package Morse::Code; require 5; # modified to work without the keyword our use strict; use warnings; BEGIN # why in a begin block, I saw it in perlmod { require Exporter; my ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); # set the version for version checking $VERSION = 0.01; # if using RCS/CVS, this may be preferred $VERSION = do { my @r = (q$Revision: 0.01 $ =~ /\d+/g); sprintf "% +d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker @ISA = qw(Exporter); # need to inherit from Exporter # This allows declaration use Morse::Code ':all'; # If you do not need this, moving things directly into @EXPORT or +@EXPORT_OK # will save memory. %EXPORT_TAGS = ('all'=>[ qw(&debug &morsify &toMorse &toText $DEFAULTS &resetDefaults) ]); @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); } # our @EXPORT_OK; # i don't remember why i had to include this after BEGIN, so i'm not a +nymore
##### exported package globals go here # # the default settings hash reference, the only exprted global variabl +e my ($DEFAULTS) = {}; ##### non-exported package globals go here # # the default morse set my %ORG_CHARS =( # international morsecode 'chart' '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' => + '-----', ',' => '--..--', '.' => '.-.-.-', '?' => '..--..', '!' => '.-.--.', # apparently same as q(') so i'll re-define it as + '.-.--.' # i am quite uncertain about the validity of this + 'hack' # as accepted international morse code, but hey, +when in perl ';' => '-.-.-', ':' => '---...', '/' => '-..-.', '-' => + '-....-', "'" => '.----.', '(' => '-.--.-', ')' => '-.--.-', '_' => + '..--.-', '' => '.--.-', #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 %ORG_CHARS; my %REVERSE_CHARS = reverse(%ORG_CHARS); # the default settings hash gets more stuff $DEFAULTS->{CHARS_HASH_REF}= \%ORG_CHARS; $DEFAULTS->{REVERSE_CHARS_HASH_REF}= \%REVERSE_CHARS; $DEFAULTS->{MIN_PER_CENT}=50; # only the above should be set by user, the below only by subs $DEFAULTS->{ORIGINAL_INPUT}=''; # if you wanna figure out how these ar +e set $DEFAULTS->{INPUT_AS_TEXT}=''; # just take a look at toText and/or to +Morse $DEFAULTS->{INPUT_AS_MORSE}=''; # it's pretty obvious from there my ($GODLY_DEFAULTS) = {%{$DEFAULTS}}; # the untouchable hardcoded defaults, that you might wanna revert to s +ometime # and that the OOP uses by default, not DEFAULTS ##### non-explicitly exported subroutines # # the constructor for Object Oriented Morse::Code, # aka the only non-explicitly exported sub sub new { my $class_aka_package_type = $_[0]; my $self; if(ref $_[1]) { $self = bless {}, $class_aka_package_type; # bless an anonymous hash into $self, which is of type $class_aka_pa +ckage_type my $pref = $_[1]; foreach my $key ( keys %{$GODLY_DEFAULTS} ) { if(defined $pref->{$key}) { $self->{$key} = $pref->{$key}; } else { $self->{$key} = $GODLY_DEFAULTS->{$key}; } } } else # set the settings to the defaults { $self = bless $GODLY_DEFAULTS, $class_aka_package_type; } return $self; #i don't like magic, so i'm doing an explicit return }# endof sub new # aka the constructor # ##### endof non-explicitly exported subroutines ########### private sub's # private functions, i wonder what they're hiding # # neat little titled hr, that does a < 80 chars since int rounds down my $_titled_hr= sub { my $string= join('', @_); my $oy = int (80 -(length $string) )/ 2; return "\n","-" x $oy, $string, "-" x $oy,"\n"; }; # prints out $key = $value pairs for %:: aka %Morse::Code:: my $_dump_hash = sub{ my $reference = shift; print $_titled_hr->(" Data::Dumper "); eval(q( use Data::Dumper; print Dumper($reference); )); }; # #### endof private sub's #### explicitly exported subs - Morse::Code qw(:all); # # prints out the anon hash for the calling object and/or the package sub debug { my $self = shift; if(ref $self) { print $_titled_hr->($self); $_dump_hash->($self); my $do_package_hash=shift || 0; if($do_package_hash) { $_dump_hash->(\%::); } } else { print "you can only see the package %:: \n"; $_dump_hash->(\%::); } }# endof debug # decides whether to call toText or toMorse based on the % of morse pa +ssed sub morsify { my ($self,$min_per_cent); # tried using _ as _cent but perl complained if(ref($_[0])) { $self=shift; $min_per_cent=$self->{MIN_PER_CENT}; }# the first arg is always a reference to the object when -> else { $min_per_cent=$DEFAULTS->{MIN_PER_CENT}; } my $dis = shift; my $count = 0; # figure out the number of valid text characters in $dis while ($dis=~ /[^ .-]/g) # ie chars other than ' ', '.', or '-' { $count++; } # the g makes it faster? my $per_cent_of_text = int $count/(length $dis)*100; # what % of the string passed was text(ie not ' ', '.', or '-') if($per_cent_of_text > $min_per_cent) { return ( ($self)?$self->toMorse($dis):&toMorse($dis) ); } else { return ( ($self)?$self->toText($dis):&toText($dis) ); } }# endof morsify # like the name says sub resetDefaults { if(ref $_[0]) { my $self=shift; $self = $GODLY_DEFAULTS; return $self; } else { $DEFAULTS = $GODLY_DEFAULTS; } } # translates text to - . -..- - sub toMorse { my ($self,$dis,$temp_chars_hash_ref); if(ref($_[0])) { $self=shift; $temp_chars_hash_ref=$self->{CHARS_HASH_REF}; $dis = shift; $self->{ORIGINAL_INPUT}=$dis; $self->{INPUT_AS_TEXT}=$dis; }# the first arg is always a reference to the object when -> else { $dis = shift; $temp_chars_hash_ref = $DEFAULTS->{CHARS_HASH_REF}; # set the globals to what they should be $DEFAULTS->{ORIGINAL_INPUT} = $dis; $DEFAULTS->{INPUT_AS_TEXT} = $dis; } $dis =~ tr/[a-z]/[A-Z]/; # upper case with a regex, why? i don' +t know my @dis = split('',$dis); my $abc=""; for(0..$#dis) { if(defined $temp_chars_hash_ref->{$dis[$_]}) { $dis = $temp_chars_hash_ref->{$dis[$_]}; } else { $dis = $dis[$_]; } $abc .= $dis . " "; } # YAG $DEFAULTS->{INPUT_AS_MORSE} = $abc; $self->{INPUT_AS_MORSE}=$DEFAULTS->{INPUT_AS_MORSE}; return "$abc"; }# endof toMorse # translates - . -..- - to text sub toText { my ($self,$dis,$temp_reverse_chars_hash_ref); if(ref($_[0])) { $self=shift; $dis = shift; $temp_reverse_chars_hash_ref=$self->{REVERSE_CHARS_HASH_REF}; $self->{ORIGINAL_INPUT}=$dis; $self->{INPUT_AS_MORSE}=$dis; }# the first arg is always a reference to the object when -> else { $dis = shift; $temp_reverse_chars_hash_ref = $DEFAULTS->{REVERSE_CHARS_HASH_ +REF}; # set the globals to what they should be $DEFAULTS->{ORIGINAL_INPUT} = $dis; $DEFAULTS->{INPUT_AS_MORSE} = $dis; } my @words = split(' ',"$dis"); my $braces; my $abc=""; for(0..$#words) { my @letters = split(' ',$words[$_]); for my $op(0..$#letters) { if(defined $temp_reverse_chars_hash_ref->{$letters[$op]}) { $dis = $temp_reverse_chars_hash_ref->{$letters[$op]}; } else { $dis = $letters[$op]; } if($dis eq '(') { if(defined $braces) # try and figure out nested braces { undef $braces; $dis=')'; # doesn't work too well. it turns (()) into ()() } else { $braces=1; } } $abc .= $dis; } $abc .= " "; } # yet another global $DEFAULTS->{INPUT_AS_TEXT}= $abc; $self->{INPUT_AS_TEXT}=$DEFAULTS->{INPUT_AS_TEXT}; return $abc; }# endof toText 1 # where's the ; you ask? ask dominus at perlmonks.org and perl.plove +r.com __END__ # Below is stub documentation for your module. You better edit it! =head1 NAME Morse::Code - translate between Morse Code and text =head1 SYNOPSIS =begin text use Morse::Code qw(:all); print &toMorse("oy"); print &toText(&toMorse("oy")); my %CHARS = (O=>'--',Y='-0'); # O and Y are uppercase on purpose, cause toMorse assumes they are # calling &morsify("vey"); would result in "ve -0"; my $defaults_href = { CHARS_HASH_REF => \%CHARS, # a reference to the custom chars hash REVERSE_CHARS_HASH_REF => { reverse( %CHARS) }, # a reference to the reverse custom hash # the above two go as a pair, try not to omit one as y +ou # will get unwanted results, and feel like an arse MIN_PER_CENT => 70 # the comparison value for morsify, in deciding what t +o call }; $Morse::Code::DEFAULTS = $defaults_href; print &morsify("oy"); &resetDefaults(); # resets $Morse::Code::DEFAULTS to GODLY_DEFAULTS, a private variabl +e print &morsify("oy, vey!"); my $ojb = new Morse::Code(); print $ojb->morsify("oy"); my $obj2 = new Morse::Code($defaults_href); print $ojb->morsify("oy"); # with a little help from data dumper, see what you have &debug(); # same as &debug(1) $obj2->debug(1); # same as $obj2->debug(); combined with &debug(); =end text =head1 DESCRIPTION Morse::Code a module to translate to/from Morse code with the option t +o specify customized Morse code sets. ** As vroom is my witness i will tye up all lose ends. =head2 EXPORT None by default. Use qw(:all) to use package in objectless fashion, like &morsify("oy") +; When using qw(:all) and you wan't to override default settings, mess with $Morse::Code::DEFAULTS =head1 AUTHOR =begin html H.D.(crazyinsomniac), <crazyinsomniac@yahoo.com> http://www.crazyinsomniac.f2s.com/ I<usually at> http://www.perlmonks.org/index.pl?node=crazyinsomniac =end html =head1 SEE ALSO perldata, perlref. =cut

 
___crazyinsomniac_______________________________________
Disclaimer: Don't blame. It came from inside the void

perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

Replies are listed 'Best First'.
Re: Morse::Code
by dws (Chancellor) on Apr 16, 2001 at 09:30 UTC
    <tangent>
    Ever notice how the allocation of dots and dashes to characters resembles a Hufmann encoding?
    . - E T / \ / \ .. .- -. -- I A N M / \ / \ / \ / \ ... ..- .-. .-- -.. -.- --. --- S U R W D K G O
    Kinda makes sense, if you think about it for a moment. Morse code is an encoding designed to optimize bandwidth.
    </tangent>

      This visualization actually might simplify the coding of a morse code converter (i.e. Perl Golf?). I read about it in "Code" (Microsoft Press, but perhaps out of print) and found it to be an intriguing way to visualize Morse code. It enables you to write a simple state machine instead of a more complex pattern matcher.

      BTW, tr doesn't require set brackets, but including them would just harmlessly convert them to same, right?     tr/[a-z]/[A-Z]/
      Is theoretically equivalent to:     tr/[]a-z/[]A-Z/
      Which is much like:     tr/[]/[]/; tr/a-z/A-Z/
      Right? Although you would probably use uc instead.
Re (tilly) 1: Morse::Code
by tilly (Archbishop) on Apr 16, 2001 at 07:35 UTC
    On the BEGIN block issue. tye and I disagree quite emphatically on that, see the discussion starting at Re (tilly) 1: Supersplit for details. Suffice it to say that I would drop that block, and move strict to after the initial declarations.

    On a more important note, my does not do what vars does. Things like @ISA, @EXPORT_OK, etc need to be global, not lexical. Either move strict to after them, or else declare with vars. my simply will not work.

    Thirdly your method/no method code has a lot of repeated logic in it. I would recommend replacing it by something that looks like this:

    my $self = ref($_[0]) ? shift : $default_self;
    This also allows you to move the my declarations to the first use of the variables. Stylistically I prefer this for lexicals.

    For more of my philosophy on scoping see RE (tilly) 3: redeclaring variables with 'my'.

Re: Morse::Code
by diskcrash (Hermit) on Apr 16, 2001 at 09:08 UTC
    Dear CrazyInsomniac-

    What a noble mission. I took a look through about five ref books I have on morse code and did some surfing, but found no definitive code for the "!" either. Never thought about it. Most CW heads are relatively unexcitable... If I locate an alternative I'll send it along.

    -diskcrash AKA AC6OA --... ...-- -.-

(jeffa) Re: Morse::Code
by jeffa (Bishop) on Apr 16, 2001 at 19:14 UTC
    --. --- --- -.. .--- --- -... -.-. .-. .- --.. -.--

    Jeff

    R-R-R--R-R-R--R-R-R--R-R-R--R-R-R--
    L-L--L-L--L-L--L-L--L-L--L-L--L-L--
    

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://72728]
Approved by root
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2018-07-23 02:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (459 votes). Check out past polls.

    Notices?