#!/usr/bin/perl
=head1 NAME
perlTk Type Tutor - useful for learning a DVORAK layout
=head1 The KeyBoard
is based on the following map
` 1 2 3 4 5 6 7 8 9 0 - = backspace
tab q w e r t y u i o p [ ] \
caps a s d f g h j k l ; ' enter
shift z x c v b n m , . / shift
ctrl meta alt spacebar alt meta hyper ctrl
The keys are mapped from left to right, by row (top to bottom).
The following "special" keys are ignored from the above mapping,
and mapped last in the following order.
Shift_L
Shift_R
Control_L
Control_R
Meta_L
Meta_R
Alt_L
Alt_R
Hyper
CapsLock
Enter
Tab
Backspace
Spacebar
=cut
use Tk 8;
use strict;
use warnings;
use vars qw[ $theKeyboard ];
$theKeyboard = {};
my @KeyBoard;
my %QWERTY;
my %DVORAK;
$KeyBoard[ 0] = [ 0, 36, 23, 59, ];
$KeyBoard[ 1] = [ 28, 36, 51, 59, ];
$KeyBoard[ 2] = [ 56, 36, 79, 59, ];
$KeyBoard[ 3] = [ 84, 36, 107, 59, ];
$KeyBoard[ 4] = [ 112, 36, 135, 59, ];
$KeyBoard[ 5] = [ 140, 36, 163, 59, ];
$KeyBoard[ 6] = [ 168, 36, 191, 59, ];
$KeyBoard[ 7] = [ 196, 36, 219, 59, ];
$KeyBoard[ 8] = [ 224, 36, 247, 59, ];
$KeyBoard[ 9] = [ 252, 36, 275, 59, ];
$KeyBoard[10] = [ 280, 36, 303, 59, ];
$KeyBoard[11] = [ 308, 36, 331, 59, ];
$KeyBoard[12] = [ 336, 36, 359, 59, ];
$KeyBoard[13] = [ 42, 64, 65, 87, ];
$KeyBoard[14] = [ 70, 64, 93, 87, ];
$KeyBoard[15] = [ 98, 64, 121, 87, ];
$KeyBoard[16] = [ 126, 64, 149, 87, ];
$KeyBoard[17] = [ 154, 64, 177, 87, ];
$KeyBoard[18] = [ 182, 64, 205, 87, ];
$KeyBoard[19] = [ 210, 64, 233, 87, ];
$KeyBoard[20] = [ 238, 64, 261, 87, ];
$KeyBoard[21] = [ 266, 64, 289, 87, ];
$KeyBoard[22] = [ 294, 64, 317, 87, ];
$KeyBoard[23] = [ 322, 64, 345, 87, ];
$KeyBoard[24] = [ 350, 64, 373, 87, ];
$KeyBoard[25] = [ 378, 64, 401, 87, ];
$KeyBoard[26] = [ 50.4, 92, 73.4, 115, ];
$KeyBoard[27] = [ 78.4, 92, 101.4, 115, ];
$KeyBoard[28] = [ 106.4, 92, 129.4, 115, ];
$KeyBoard[29] = [ 134.4, 92, 157.4, 115, ];
$KeyBoard[30] = [ 162.4, 92, 185.4, 115, ];
$KeyBoard[31] = [ 190.4, 92, 213.4, 115, ];
$KeyBoard[32] = [ 218.4, 92, 241.4, 115, ];
$KeyBoard[33] = [ 246.4, 92, 269.4, 115, ];
$KeyBoard[34] = [ 274.4, 92, 297.4, 115, ];
$KeyBoard[35] = [ 302.4, 92, 325.4, 115, ];
$KeyBoard[36] = [ 330.4, 92, 353.4, 115, ];
$KeyBoard[37] = [ 64.4, 120, 87.4, 143, ];
$KeyBoard[38] = [ 92.4, 120, 115.4, 143, ];
$KeyBoard[39] = [ 120.4, 120, 143.4, 143, ];
$KeyBoard[40] = [ 148.4, 120, 171.4, 143, ];
$KeyBoard[41] = [ 176.4, 120, 199.4, 143, ];
$KeyBoard[42] = [ 204.4, 120, 227.4, 143, ];
$KeyBoard[43] = [ 232.4, 120, 255.4, 143, ];
$KeyBoard[44] = [ 260.4, 120, 283.4, 143, ];
$KeyBoard[45] = [ 288.4, 120, 311.4, 143, ];
$KeyBoard[46] = [ 316.4, 120, 339.4, 143, ];
$KeyBoard[47] = [ 0, 120, 59, 143, ];
$KeyBoard[48] = [ 344.4, 120, 403.4, 143, ];
$KeyBoard[49] = [ 0, 148, 37, 171, ];
$KeyBoard[50] = [ 366, 148, 403, 171, ];
$KeyBoard[51] = [ 42, 148, 79, 171, ];
$KeyBoard[52] = [ 282, 148, 319, 171, ];
$KeyBoard[53] = [ 84, 148, 121, 171, ];
$KeyBoard[54] = [ 240, 148, 277, 171, ];
$KeyBoard[55] = [ 324, 148, 361, 171, ];
$KeyBoard[56] = [ 0, 92, 45, 115, ];
$KeyBoard[57] = [ 358.4, 92, 403.4, 115, ];
$KeyBoard[58] = [ 0, 64, 37, 87, ];
$KeyBoard[59] = [ 364, 36, 401, 59, ];
$KeyBoard[60] = [ 126, 148, 235, 171, ];
$QWERTY{'?'} = $KeyBoard[46];
$QWERTY{'}'} = $KeyBoard[24];
$QWERTY{'~'} = $KeyBoard[0];
$QWERTY{'@'} = $KeyBoard[2];
$QWERTY{'['} = $KeyBoard[23];
$QWERTY{'\\'} = $KeyBoard[25];
$QWERTY{']'} = $KeyBoard[24];
$QWERTY{'^'} = $KeyBoard[6];
$QWERTY{'_'} = $KeyBoard[11];
$QWERTY{'!'} = $KeyBoard[1];
$QWERTY{'"'} = $KeyBoard[36];
$QWERTY{'`'} = $KeyBoard[0];
$QWERTY{'#'} = $KeyBoard[3];
$QWERTY{'a'} = $KeyBoard[26];
$QWERTY{'$'} = $KeyBoard[4];
$QWERTY{'b'} = $KeyBoard[41];
$QWERTY{'%'} = $KeyBoard[5];
$QWERTY{'c'} = $KeyBoard[39];
$QWERTY{'&'} = $KeyBoard[7];
$QWERTY{'d'} = $KeyBoard[28];
$QWERTY{'\''} = $KeyBoard[36];
$QWERTY{'e'} = $KeyBoard[15];
$QWERTY{'('} = $KeyBoard[9];
$QWERTY{'f'} = $KeyBoard[29];
$QWERTY{')'} = $KeyBoard[10];
$QWERTY{'g'} = $KeyBoard[30];
$QWERTY{'*'} = $KeyBoard[8];
$QWERTY{'h'} = $KeyBoard[31];
$QWERTY{'+'} = $KeyBoard[12];
$QWERTY{'i'} = $KeyBoard[20];
$QWERTY{','} = $KeyBoard[44];
$QWERTY{'j'} = $KeyBoard[32];
$QWERTY{'k'} = $KeyBoard[33];
$QWERTY{'-'} = $KeyBoard[11];
$QWERTY{'.'} = $KeyBoard[45];
$QWERTY{'l'} = $KeyBoard[34];
$QWERTY{'/'} = $KeyBoard[46];
$QWERTY{'m'} = $KeyBoard[43];
$QWERTY{'n'} = $KeyBoard[42];
$QWERTY{'0'} = $KeyBoard[10];
$QWERTY{'1'} = $KeyBoard[1];
$QWERTY{'o'} = $KeyBoard[21];
$QWERTY{'2'} = $KeyBoard[2];
$QWERTY{'p'} = $KeyBoard[22];
$QWERTY{'q'} = $KeyBoard[13];
$QWERTY{'3'} = $KeyBoard[3];
$QWERTY{'r'} = $KeyBoard[16];
$QWERTY{'4'} = $KeyBoard[4];
$QWERTY{'5'} = $KeyBoard[5];
$QWERTY{'s'} = $KeyBoard[27];
$QWERTY{'t'} = $KeyBoard[17];
$QWERTY{'6'} = $KeyBoard[6];
$QWERTY{'7'} = $KeyBoard[7];
$QWERTY{'u'} = $KeyBoard[19];
$QWERTY{'v'} = $KeyBoard[40];
$QWERTY{'8'} = $KeyBoard[8];
$QWERTY{'w'} = $KeyBoard[14];
$QWERTY{'9'} = $KeyBoard[9];
$QWERTY{':'} = $KeyBoard[35];
$QWERTY{'x'} = $KeyBoard[38];
$QWERTY{';'} = $KeyBoard[35];
$QWERTY{'y'} = $KeyBoard[18];
$QWERTY{'<'} = $KeyBoard[44];
$QWERTY{'z'} = $KeyBoard[37];
$QWERTY{'{'} = $KeyBoard[23];
$QWERTY{'='} = $KeyBoard[12];
$QWERTY{'>'} = $KeyBoard[45];
$QWERTY{'|'} = $KeyBoard[25];
$DVORAK{'`'} = $KeyBoard[0];
$DVORAK{'}'} = $KeyBoard[12];
$DVORAK{'~'} = $KeyBoard[0];
$DVORAK{'!'} = $KeyBoard[1];
$DVORAK{'"'} = $KeyBoard[13];
$DVORAK{'#'} = $KeyBoard[3];
$DVORAK{'$'} = $KeyBoard[4];
$DVORAK{'%'} = $KeyBoard[5];
$DVORAK{'&'} = $KeyBoard[7];
$DVORAK{'\''} = $KeyBoard[13];
$DVORAK{'('} = $KeyBoard[9];
$DVORAK{')'} = $KeyBoard[10];
$DVORAK{'*'} = $KeyBoard[8];
$DVORAK{'+'} = $KeyBoard[24];
$DVORAK{','} = $KeyBoard[14];
$DVORAK{'-'} = $KeyBoard[36];
$DVORAK{'.'} = $KeyBoard[15];
$DVORAK{'/'} = $KeyBoard[23];
$DVORAK{'0'} = $KeyBoard[10];
$DVORAK{'1'} = $KeyBoard[1];
$DVORAK{'2'} = $KeyBoard[2];
$DVORAK{'3'} = $KeyBoard[3];
$DVORAK{'4'} = $KeyBoard[4];
$DVORAK{'5'} = $KeyBoard[5];
$DVORAK{'6'} = $KeyBoard[6];
$DVORAK{'7'} = $KeyBoard[7];
$DVORAK{'8'} = $KeyBoard[8];
$DVORAK{'9'} = $KeyBoard[9];
$DVORAK{':'} = $KeyBoard[37];
$DVORAK{';'} = $KeyBoard[37];
$DVORAK{'<'} = $KeyBoard[14];
$DVORAK{'='} = $KeyBoard[24];
$DVORAK{'>'} = $KeyBoard[15];
$DVORAK{'?'} = $KeyBoard[23];
$DVORAK{'@'} = $KeyBoard[2];
$DVORAK{'['} = $KeyBoard[11];
$DVORAK{'\\'} = $KeyBoard[25];
$DVORAK{']'} = $KeyBoard[12];
$DVORAK{'^'} = $KeyBoard[6];
$DVORAK{'_'} = $KeyBoard[36];
$DVORAK{'a'} = $KeyBoard[26];
$DVORAK{'b'} = $KeyBoard[42];
$DVORAK{'c'} = $KeyBoard[20];
$DVORAK{'d'} = $KeyBoard[31];
$DVORAK{'e'} = $KeyBoard[28];
$DVORAK{'f'} = $KeyBoard[18];
$DVORAK{'g'} = $KeyBoard[19];
$DVORAK{'h'} = $KeyBoard[32];
$DVORAK{'i'} = $KeyBoard[30];
$DVORAK{'j'} = $KeyBoard[39];
$DVORAK{'k'} = $KeyBoard[40];
$DVORAK{'l'} = $KeyBoard[22];
$DVORAK{'m'} = $KeyBoard[43];
$DVORAK{'n'} = $KeyBoard[34];
$DVORAK{'o'} = $KeyBoard[27];
$DVORAK{'p'} = $KeyBoard[16];
$DVORAK{'q'} = $KeyBoard[38];
$DVORAK{'r'} = $KeyBoard[21];
$DVORAK{'s'} = $KeyBoard[35];
$DVORAK{'t'} = $KeyBoard[33];
$DVORAK{'u'} = $KeyBoard[29];
$DVORAK{'v'} = $KeyBoard[45];
$DVORAK{'w'} = $KeyBoard[44];
$DVORAK{'x'} = $KeyBoard[41];
$DVORAK{'y'} = $KeyBoard[17];
$DVORAK{'z'} = $KeyBoard[46];
$DVORAK{'{'} = $KeyBoard[11];
$DVORAK{'|'} = $KeyBoard[25];
{
local $theKeyboard = \%DVORAK;
$theKeyboard->{shift_l} = [47];
$theKeyboard->{shift_r} = [48];
$theKeyboard->{control_l} = [ 49];
$theKeyboard->{control_r} = [ 50];
$theKeyboard->{meta_l} = [ 51];
$theKeyboard->{91} = [ 51];
$theKeyboard->{meta_r} = [ 52];
$theKeyboard->{92} = [ 52];
$theKeyboard->{alt_l} = [ 53];
$theKeyboard->{alt_r} = [ 54];
$theKeyboard->{backspace} = [ Backspace => 59];
$theKeyboard->{return} = [ Enter => 57]; #????
$theKeyboard->{"\t"} = [ Tab => 58];
$theKeyboard->{" "} = [ Spacebar => 60];
$theKeyboard->{93} = [ Hyper => 55];
$theKeyboard->{20} = [ CapsLock => 56];
}
{
local $theKeyboard = \%QWERTY;
$theKeyboard->{shift_l} = [47];
$theKeyboard->{shift_r} = [48];
$theKeyboard->{control_l} = [ 49];
$theKeyboard->{control_r} = [ 50];
$theKeyboard->{meta_l} = [ 51];
$theKeyboard->{91} = [ 51];
$theKeyboard->{meta_r} = [ 52];
$theKeyboard->{92} = [ 52];
$theKeyboard->{alt_l} = [ 53];
$theKeyboard->{alt_r} = [ 54];
$theKeyboard->{backspace} = [ Backspace => 59];
$theKeyboard->{return} = [ Enter => 57]; #????
$theKeyboard->{"\t"} = [ Tab => 58];
$theKeyboard->{" "} = [ Spacebar => 60];
$theKeyboard->{93} = [ Hyper => 55];
$theKeyboard->{20} = [ CapsLock => 56];
}
warn DVORAK => scalar keys %DVORAK;
warn QWERTY => scalar keys %QWERTY;
my $main = MainWindow->new( # tkinit
-borderwidth => 0,
-relief => 'flat',
-width => 333,
-height => 555,
# -background => undef,
);
my $menubar = $main->Menu(-type => 'menubar');
$main->configure(-menu => $menubar);
my $f = $menubar->cascade(-label => '~Layout', -tearoff => 0);
$f->command(-label => 'QWERTY', -command => [\&SwitchLayout, \%QWER
+TY]);
$f->command(-label => 'DVORAK', -command => [\&SwitchLayout, \%DVOR
+AK]);
$main->geometry('+300+30'); # xpos ypos, you can read this from confi
+g as well
$main->withdraw(); # saw jouke do it (too tired to investigate ;)
$main->deiconify(); # not minimized
$main->raise(); # bring to top (how do i do always on top?
+ hmm, event handler?)
my $c1 = $main->Canvas(
-relief => 'solid',
-borderwidth => 0,
-highlightthickness => 0,
-height => 200,
-width => 404,
-background => 'white',
)->pack(
-anchor => 'center',
-side => 'top',
);
$main->Scrolled(
Text =>
-scrollbars => 'se'
)->pack(
-expand => 'yes',
-fill => 'both',
);
for( 0 .. 46 ) {
$c1->createRectangle(
@{$KeyBoard[$_]},
-tag => "roy$_",
-fill => 'white',
-disabledfill => 'green'
);
push @{$KeyBoard[$_]}, $_; # tag tag tag
}
{ # the homekeys (qwerty F and J)
my($x,$y, $X, $Y ) = @{$KeyBoard[29]};
$c1->createRectangle($X-5,$Y-4,$x+5,$Y-3);
($x,$y, $X, $Y ) = @{$KeyBoard[32]};
$c1->createRectangle($X-5,$Y-4,$x+5,$Y-3);
}
for( 47 .. $#KeyBoard ) {
$c1->createRectangle(
@{$KeyBoard[$_]},
-tag => "roy$_",
-fill => 'pink',
-disabledfill => 'red'
);
push @{$KeyBoard[$_]}, $_; # tag tag tag
}
## Due to limitations in Tk and/or the underlying OS,
## some of these won't work
## for example, on my machine, Shift_L and Shift_R issue the exact
## same keycode(windows' fault)
$main->bind('<KeyPress>', [ \&RockOn, Ev('k'),Ev('A'), ]);
$main->bind('<KeyRelease>', [ \&RockOff, Ev('k'),Ev('A'), ]);
$main->bind('<KeyPress-Shift_L>', [ \&RockOn, 1,'Shift_L', ]);
$main->bind('<KeyRelease-Shift_L>', [ \&RockOff, 1,'Shift_L', ]);
$main->bind('<KeyPress-Shift_R>', [ \&RockOn, 1,'Shift_R', ]);
$main->bind('<KeyRelease-Shift_R>', [ \&RockOff, 1,'Shift_R', ]);
$main->bind('<KeyPress-Control_L>', [ \&RockOn, 1,'Control_L', ]);
$main->bind('<KeyRelease-Control_L>', [ \&RockOff, 1,'Control_L', ]);
$main->bind('<KeyPress-Control_R>', [ \&RockOn, 1,'Control_R', ]);
$main->bind('<KeyRelease-Control_R>', [ \&RockOff, 1,'Control_R', ]);
$main->bind('<KeyPress-Meta_L>', [ \&RockOn, 1,'Meta_L', ]);
$main->bind('<KeyRelease-Meta_L>', [ \&RockOff, 1,'Meta_L', ]);
$main->bind('<KeyPress-Meta_R>', [ \&RockOn, 1,'Meta_R', ]);
$main->bind('<KeyRelease-Meta_R>', [ \&RockOff, 1,'Meta_R', ]);
$main->bind('<KeyPress-Alt_L>', [ \&RockOn, 1,'Alt_L', ]);
$main->bind('<KeyRelease-Alt_L>', [ \&RockOff, 1,'Alt_L', ]);
$main->bind('<KeyPress-Alt_R>', [ \&RockOn, 1,'Alt_R', ]);
$main->bind('<KeyRelease-Alt_R>', [ \&RockOff, 1,'Alt_R', ]);
$main->bind('<KeyPress-BackSpace>', [ \&RockOn, 1,'BackSpace', ]);
$main->bind('<KeyRelease-BackSpace>', [ \&RockOff, 1,'BackSpace', ]);
$main->bind('<KeyPress-Return>', [ \&RockOn, 1,'Return', ]);
$main->bind('<KeyRelease-Return>', [ \&RockOff, 1,'Return', ]);
SwitchLayout(\%DVORAK );
SwitchLayout(\%QWERTY ) if @ARGV; # cause I ain't learned yet ;D
MainLoop();
## subland
sub RockOn {
my( $m, $k, $A ) = @_;
$k = $theKeyboard->{lc $A} || $theKeyboard->{$k} || 0;
$c1->itemconfigure( "roy$$k[-1]" => -state => 'disabled') if ref $
+k;
}
sub RockOff {
my( $m, $k, $A ) = @_;
$k = $theKeyboard->{lc $A} || $theKeyboard->{$k} || 0;
$c1->itemconfigure( "roy$$k[-1]" => -state => 'normal') if ref $k
+;
}
sub SwitchLayout {
$theKeyboard = shift;
$c1->delete("letter");
for( qw[ q w e r t y u i o p a s d f g h j k l z x c v b n m ], qw
+[-] ){
my($x , $y) = @{$theKeyboard->{$_}}[0,1];
$x += 10;
$y += 10;
$c1->createText(
$x, $y,
-tag => "letter",
-font => 'courier 12',
-text => uc $_,
);
}
for( qw[ _ ] ){
my($x , $y) = @{$theKeyboard->{$_}}[0,1];
$x += 10;
$y += 10;
$c1->createText(
$x, $y,
-font => 'courier 9',
-fill => 'red',
-tag => "letter",
-text => $_,
);
}
for( qw[ . / ; ' [ ] ` 1 2 3 4 5 6 7 8 9 0 = \ ], ',' ){
my($x , $y) = @{$theKeyboard->{$_}}[0,1];
$x += 7;
$y += 14;
$c1->createText(
$x, $y,
-tag => "letter",
-font => 'courier 12',
-text => $_,
);
}
for( qw[ < > ? : { } | & * ( ) + ~ ! @ $ % ^ " ], '#' ){
my($x , $y) = @{$theKeyboard->{$_}}[0,1];
$x += 17;
$y += 6;
$c1->createText(
$x, $y,
-font => 'courier 9',
-fill => 'red',
-tag => "letter",
-text => $_,
);
}
}
=head1 AUTHOR
PodMaster - a perlmonk
=head1 THANKX
Juerd for I<inspiration> and everybody else for helping me fix this up
=cut
|