http://qs321.pair.com?node_id=11112759


in reply to Morse input from keyboard

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; }