Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Morse input from keyboard

by pierrot (Novice)
on Feb 10, 2020 at 23:44 UTC ( [id://11112751]=perlquestion: print w/replies, xml ) Need Help??

pierrot has asked for the wisdom of the Perl Monks concerning the following question:

I'd like to write a Perl script to do something similar to this website. The idea is that you press a single key and depending on how long you press it, that stroke is interpreted as a dot or a dash. I searched for a CLI o GUI program to do this task and found none so I'd like to write my own in Perl. Any ideas/suggestions?

Replies are listed 'Best First'.
Re: Morse input from keyboard
by tybalt89 (Monsignor) on Feb 11, 2020 at 06:13 UTC

    Keys can be a problem because of autorepeat, but here's one that uses the left mouse button for the keyer.

    #!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11112751 use warnings; use Time::HiRes qw( time ); use Tk; my $morse = ''; my $text = ''; my $down = 0; my $lasttime = time; my $interval = shift // 0.1; # seconds for timing my $maxlength = 30; my $mw = new MainWindow; $mw->geometry('+500+500'); $mw->Label(-text => "Use left mouse button in green window.\n" . "Tweek \$interval to your coding speed")->pack; my $t = $mw->Label(-textvariable => \$morse, -width => $maxlength, -bg => 'lightgreen', -font => 'courierbold 36', )->pack; $mw->Label(-textvariable => \$text, -width => $maxlength, -font => 'courierbold 36', )->pack; $mw->Button(-text => 'Clear', -command => sub { $morse = $text = '' }, )->pack; $mw->Button(-text => 'Exit', -command => sub {$mw->destroy})->pack; $t->bind('<1>' => \&press ); $t->bind('<ButtonRelease-1>' => \&release ); MainLoop; sub morse { $_[0] =~ tr/.-/01/r =~ s/\S+/ my $pos = oct 'b1' . $&; $pos > 30 and $pos = 30; substr '__etianmsurwdkgohvf_l_pjbxcyzq?', $pos, 1 /ger =~ s/ *\K //gr; } sub press { if( time > $lasttime + 6 * $interval ) { $morse .= ' '; } elsif( time > $lasttime + 2 * $interval ) { $morse .= ' '; } length $morse > $maxlength and substr $morse, 0, length($morse) - $maxlength, ''; $lasttime = time; } sub release { if( time < $lasttime + 2 * $interval ) { $morse .= '.'; } else { $morse .= '-'; } length $morse > $maxlength and substr $morse, 0, length($morse) - $maxlength, ''; $text = morse($morse); $lasttime = time; }
      Keys can be a problem because of autorepeat

      There are generally several keys that are not subject to autorepeat. On A PC, both Shift keys, both Alt keys (right Alt = AltGr on international keyboards), both Ctrl keys, both Logo keys, Menu key, Shift/Caps Lock key, Scroll Lock key, Num Lock key, Pause key. Pause could be a little bit problematic because it can behave different from all other keys at the hardware level.

      Polling the Shft, Ctrl, and Alt keys should be easy even through driver, operating system and toolkit layers.

      Some systems may treat repeated key presses as shortcut for accessibility functions. Pressing shift five times makes Windows 7 (and others?) switch on "Sticky keys", keeping Num Lock pressed down for five seconds may enable "Toggle keys", keeping right shift pressed down for eight seconds enables "Filter keys". So you may want to use Ctrl or Alt on Windows instead, to prevent that from happening without reconfiguring Windows.

      Alexander

      --
      Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
      This is much more than I expected. Thank you very much.
Re: Morse input from keyboard
by kcott (Archbishop) on Feb 11, 2020 at 07:21 UTC

    G'day pierrot,

    "The idea is that you press a single key and depending on how long you press it, that stroke is interpreted as a dot or a dash."

    Here's a very basic implementation that does that using Tk.

    The Tk::Button widget invokes its callback (the -command code) when the button is released, so that implements "depending on how long you press it"; although, quickly pressing and releasing the button, then varying the time between presses, produces the same effect.

    The website you linked has a lot of other features, such as translating input into actual characters and accomodating multiple users. You didn't ask for that and, if you want one or more of those features, I'd suggest giving it a bash yourself — it'd be a good learning exercise if nothing else. I did retain the [key] label that's used there.

    Also note that I just used the time function; take a look at Time::HiRes core module which provides higher resolution time functions.

    #!/usr/bin/env perl use strict; use warnings; use Tk; use constant { DOT => '.', DASH => '-', BREAK => ' ', DEAD => '', DOT_MIN => 1, DASH_MIN => 2, }; my $mw = MainWindow::->new(); my $press = $mw->Button( -text => '[key]', -command => sub { print _get_char() }, )->pack(); MainLoop; { my $last_time; INIT { $last_time = time } sub _get_interval { my $now = time; my $interval = $now - $last_time; $last_time = $now; return $interval; } } { my $last_char; INIT { $last_char = DEAD } sub _get_char { my $interval = _get_interval(); my $char = $interval <= DOT_MIN ? DOT : $interval <= DASH_MIN ? DASH : BREAK; $char = DEAD if $char eq BREAK && ($last_char eq BREAK || $last_char eq DEAD); return $last_char = $char; } }

    — Ken

      Also note that I just used the time function; take a look at Time::HiRes core module which provides higher resolution time functions.

      Tk provides already as  $Tk::event->t

      $mw->Button(-text => 'Exit', -command => sub {$mw->destroy})->pack;

      no need for closures

      -command => sub { $Tk::widget->toplevel->destroy }

      -command => 'exit'
Re: Morse input from keyboard
by afoken (Chancellor) on Feb 11, 2020 at 20:53 UTC

    Some other ways of reading a single key

    Legacy and USB RS232 serial ports

    See Hardwarebook DB-9 / Hardwarebook DB-25 for pinout.

    This is a very generic solution. Most operating systems provide some way to read at least one of the status bits of the serial port. You can read back at least one of (D)CD, DSR, CTS, and RI. You can usually set DTR and/or RTS. Often, DTR and/or RTS are already set by the operating system. In idle, DTR and RTS are negative relative to GND, and unconnected inputs are treated like negative inputs. Opening the serial port usually sets DTR and/or RTS to positive, if not, do so manually. Connect a button between DTR or RTS and one of the inputs (DCD, DSR, CTS, RI). When the button is pressed, the respective input reads as positive.

    In the unlikely case that only bare read and write are available, you can still use the serial port. Connect the button between TxD and RxD, disable receive buffering as much as possible, and send out any data at the highest possible speed. As long as the button is pressed, you will see incoming data. The trick here is that humans need several milliseconds to press and release a button, during that time, several bytes travel from TxD to RxD.

    This trick should work with all serial RS232 ports found on a PC, either build-in or USB.

    Legacy PC joystick input

    See Hardwarebook for pinout, for details.

    Connect a button between GND and one of the four button inputs. When running DOS, you simply read port 0x0201 and look at bits 4 to 7 to read the button inputs. Windows should support that interface, too, but I have no idea how to read it. I'm guessing that there is some device-independant DirectX API. Linux shold support that interface, too, using the event system (I guess).

    USB adapter for legacy PC joystick

    The same idea, but a different Windows driver. No DOS support. Windows and maybe also Linux should treat it like a legacy joystick interface.

    Legacy Parallel port

    See Hardwarebook for pinout, https://wiki.osdev.org/Parallel_port for details. There are five handshake / status lines (/ACK, BUSY, PAPEREND, SELECT, /ERROR) that accept a button connected to GND.

    You probably need to get port-level access on Windows and Linux to read the status bits.

    USB parallel port adapters may be even harder to work with.

    Raspberry Pi

    If you use a Raspi, have a look at the work of stevieb, especially RPi::Pin, and https://pinout.xyz/. Just connect the button between GND and a unused GPIO line, then configure the pin as input with a pull-up. The pin will read as 0 while the button is pressed, else 1.

    Alexander

    --
    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
Re: Morse input from keyboard
by LanX (Saint) on Feb 11, 2020 at 00:19 UTC
    > Any ideas/suggestions?

    As far as I understand your requirements, you'll need an API which allows to bind callbacks to key-up , -down , -press or similar events and measure elapsed time .

    If I were you I'd search CPAN for similar "keywords" (no pun intended ;)

    Then I'd take a closer look into Tk and similar GUI packages and/or OS automation stuff.

    I don't think Perl is offering this without extra XS modules, otherwise we'd have %SIG handlers for such keyboard events.

    And that should also turn out to be very OS dependent.

    HTH

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

      Concerning Tk I found key-press and key-release bindings

      Maybe take example code in this thread for a start.

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Re: Morse input from keyboard
by pierrot (Novice) on Feb 11, 2020 at 20:31 UTC

    Thank you all. Now I have a very good start.

    Regards,

    Pablo
Re: Morse input from keyboard
by karlgoethebier (Abbot) on Feb 11, 2020 at 16:24 UTC

    Hardware might be the real thing.

    «The Crux of the Biscuit is the Apostrophe»

    perl -MCrypt::CBC -E 'say Crypt::CBC->new(-key=>'kgb',-cipher=>"Blowfish")->decrypt_hex($ENV{KARL});'Help

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11112751]
Approved by LanX
Front-paged by LanX
help
Chatterbox?
and the web crawler heard nothing...

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

    No recent polls found