#!/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;
    }
}