scratchpad
thundergnat
<code>
#!/usr/bin/perl
require 5.008;
use strict;
use warnings;
use Tk;
use Tk::Pane;
use Tk::Text;
use Tk::BrowseEntry;
use Tk::Balloon;
use charnames();
use constant OS_Win => $^O =~ /Win/;
die "You need to upgrade to a later version of Perl/Tk.\n"
unless ( $Tk::version ge 8.4 );
my ( $fontname, $fontsize ) = ( 'Times', 16 );
my $font = "{$fontname} $fontsize";
my $activecolor = '#abcdef';
my ( $globalx, $globaly );
my $utftop;
my $top = MainWindow->new;
my $dragimg = $top->Photo(
-format => 'gif',
-data =>
'R0lGODlhDAAMALMAAISChNTSzPz+/AAAAOAAyukAwRIA4wAAd8oA0MEAe+MTYHcAANAGgnsAAGAA
AAAAACH5BAAAAAAALAAAAAAMAAwAAwQfMMg5BaDYXiw178AlcJ6VhYFXoSoosm7KvrR8zfXHRQA7'
);
my $text = $top->Scrolled(
'Text',
-exportselection => 'true',
-scrollbars => 'se',
-background => 'white',
-font => "{$fontname} 14"
)->pack(
-expand => 1,
-fill => 'both',
);
my $menu = $text->Menu( -type => 'menubar' );
$top->configure( -menu => $menu );
$menu->Button( -label => 'Unicode-Character-Search', -command => \&uchar );
drag($text);
MainLoop;
sub uchar {
if ( defined $utftop ) {
$utftop->deiconify;
$utftop->raise;
}
else {
require q(unicore/Blocks.pl);
require q(unicore/Name.pl);
my $utftop = $top->Toplevel;
$utftop->title('Find A Unicode Character');
$utftop->geometry('550x400');
my ( %blocks, $sizelabel, @textchars, @textlabels );
for ( split /\n/, do 'unicore/Blocks.pl' ) {
my @array = split /\t/, $_;
$blocks{ $array[2] } = [ @array[ 0, 1 ] ];
}
my $button_frame = $utftop->Frame->pack;
my $search_frame = $utftop->Frame->pack(
-side => 'top',
-anchor => 'n',
-pady => 4
);
my $pane = $utftop->Scrolled(
'Pane',
-background => 'white',
-scrollbars => 'se',
-sticky => 'wne',
)->pack(
-expand => 'y',
-fill => 'both',
-anchor => 'nw'
);
drag($pane);
my $fontlist = $button_frame->BrowseEntry(
-label => 'Font',
-browsecmd => sub { font_propagate( \@textchars ) },
-variable => \$fontname,
)->grid(
-row => 1,
-column => 1,
-padx => 8,
-pady => 2
);
$fontlist->insert( 'end', sort( $top->fontFamilies ) );
my $bigger = $button_frame->Button(
-activebackground => $activecolor,
-text => 'Bigger',
-command => sub {
$fontsize++;
font_propagate( \@textchars );
$sizelabel->configure( -text => $fontsize );
},
)->grid(
-row => 1,
-column => 2,
-padx => 2,
-pady => 2
);
$sizelabel = $button_frame->Label( -textvariable => \$fontsize )->grid(
-row => 1,
-column => 3,
-padx => 2,
-pady => 2
);
my $smaller = $button_frame->Button(
-activebackground => $activecolor,
-text => 'Smaller',
-command => sub {
$fontsize--;
font_propagate( \@textchars );
$sizelabel->configure( -text => $fontsize );
},
)->grid(
-row => 1,
-column => 4,
-padx => 2,
-pady => 2
);
$search_frame->Label( -text => 'Search Characteristics ', )->grid(
-row => 1,
-column => 1
);
my $characteristics = $search_frame->Entry(
-width => 40,
-background => 'white'
)->grid(
-row => 1,
-column => 2
);
my $doit = $search_frame->Button(
-text => 'Search',
-command => sub {
for ( @textchars, @textlabels ) {
$_->destroy;
}
my $row = 0;
@textlabels = @textchars = ();
my @searches = split /\s+/, uc( $characteristics->get );
my @lines = split /\n/, do 'unicore/Name.pl';
while (@lines) {
my @char_info = split /\t+/, shift @lines;
my ( $ord, $name ) = ( $char_info[0], $char_info[-1] );
last if ( hex $ord > 65535 );
my $count = 0;
for my $search (@searches) {
$count++;
last unless $name =~ /\b$search\b/;
if ( @searches == $count ) {
my $block = '';
for ( keys %blocks ) {
if ( hex( $blocks{$_}[0] ) <= hex($ord)
&& hex( $blocks{$_}[1] ) >= hex($ord) )
{
$block = $_;
last;
}
}
$textchars[$row] = $pane->Label(
-text => chr( hex $ord ),
-font => $font,
-background => 'white',
)->grid(
-row => $row,
-column => 0,
-padx => 4,
);
$textlabels[$row] = $pane->Label(
-text => "$name - Ordinal $ord - $block",
-background => 'white',
)->grid(
-row => $row,
-column => 1,
-sticky => 'w'
);
utfchar_bind( $textchars[$row] );
utflabel_bind(
$textlabels[$row], $block,
$blocks{$block}[0], $blocks{$block}[1]
);
$row++;
$utftop->update;
}
}
}
},
)->grid(
-row => 1,
-column => 3
);
$characteristics->bind( '<Return>' => sub { $doit->invoke } );
}
}
sub utflabel_bind {
my ( $widget, $block, $start, $end ) = @_;
$widget->bind( '<Enter>',
sub { $widget->configure( -background => $activecolor ); } );
$widget->bind( '<Leave>',
sub { $widget->configure( -background => 'white' ); } );
$widget->bind(
'<ButtonPress-1>',
sub {
$widget->toplevel->Busy( -recurse => 1 );
utfpopup( $block, $start, $end );
$widget->toplevel->Unbusy( -recurse => 1 );
}
);
}
sub utfchar_bind {
my $widget = shift;
$widget->bind( '<Enter>',
sub { $widget->configure( -background => $activecolor ); } );
$widget->bind( '<Leave>',
sub { $widget->configure( -background => 'white' ) } );
$widget->bind(
'<ButtonPress-3>',
sub {
$widget->clipboardClear;
$widget->clipboardAppend( $widget->cget('-text') );
$widget->configure( -relief => 'sunken' );
}
);
$widget->bind(
'<ButtonRelease-3>',
sub {
$widget->configure( -relief => 'flat' );
}
);
$widget->bind(
'<ButtonPress-1>',
sub {
$widget->configure( -relief => 'sunken' );
$text->insert( 'insert', $widget->cget('-text') );
}
);
$widget->bind(
'<ButtonRelease-1>',
sub {
$widget->configure( -relief => 'flat' );
}
);
}
sub utfpopup {
my ( $block, $start, $end ) = @_;
my ( $sizelabel, @buttons );
my $rows = ( ( hex $end ) - ( hex $start ) + 1 ) / 16 - 1;
my $utfpop = $top->Toplevel();
$utfpop->geometry('600x300+10+10');
$utfpop->title( $block . ': ' . $start . ' - ' . $end );
my $balloon = $utfpop->Balloon( -initwait => 750 );
my $top_frame = $utfpop->Frame->pack;
my $fontlist = $top_frame->BrowseEntry(
-label => 'Font',
-browsecmd => sub { font_propagate( \@buttons ) },
-variable => \$fontname,
)->grid(
-row => 1,
-column => 1,
-padx => 8,
-pady => 2
);
my $bigger = $top_frame->Button(
-activebackground => $activecolor,
-text => 'Bigger',
-command => sub {
$fontsize++;
font_propagate( \@buttons );
$sizelabel->configure( -text => $fontsize );
},
)->grid(
-row => 1,
-column => 2,
-padx => 2,
-pady => 2
);
$sizelabel = $top_frame->Label( -textvariable => \$fontsize )->grid(
-row => 1,
-column => 3,
-padx => 2,
-pady => 2
);
my $smaller = $top_frame->Button(
-activebackground => $activecolor,
-text => 'Smaller',
-command => sub {
$fontsize--;
font_propagate( \@buttons );
$sizelabel->configure( -text => $fontsize );
},
)->grid(
-row => 1,
-column => 4,
-padx => 2,
-pady => 2
);
$fontlist->insert( 'end', sort( $top->fontFamilies ) );
my $pane = $utfpop->Scrolled(
'Pane',
-background => 'white',
-scrollbars => 'se',
-sticky => 'nswe'
)->pack(
-expand => 'y',
-fill => 'both'
);
drag($pane);
for my $y ( 0 .. $rows ) {
for my $x ( 0 .. 15 ) {
my $name = hex($start) + ( $y * 16 ) + $x;
my $hex = uc sprintf "%04x", $name;
my $msg = "Dec. $name, Hex. $hex";
my $cname = charnames::viacode($name);
$msg .= ", $cname" if $cname;
$name = 0 unless $cname;
$buttons[ ( $y * 16 ) + $x ] = $pane->Button(
-activebackground => $activecolor,
-text => chr($name),
-font => $font,
-relief => 'flat',
-borderwidth => 0,
-background => 'white',
-command => [ \&pututf, $utfpop ],
-highlightthickness => 0,
)->grid(
-row => $y,
-column => $x
);
$buttons[ ( $y * 16 ) + $x ]->bind(
'<ButtonPress-3>',
sub {
$text->clipboardClear;
$text->clipboardAppend(
$buttons[ ( $y * 16 ) + $x ]->cget('-text') );
}
);
$balloon->attach( $buttons[ ( $y * 16 ) + $x ],
-balloonmsg => $msg, );
$utfpop->update;
}
}
$utfpop->protocol(
'WM_DELETE_WINDOW' => sub { $balloon->destroy; $utfpop->destroy; } );
}
sub pututf {
my $container = shift;
my @xy = $container->pointerxy;
my $widget = $container->containing(@xy);
my $letter = $widget->cget( -text );
return unless $letter;
my @ranges = $text->tagRanges('sel');
$text->delete(@ranges) if @ranges;
$text->insert( 'insert', $letter );
$text->focus;
}
sub font_propagate {
my $array = shift;
$font = "{$fontname} $fontsize";
for (@$array) {
$_->configure( -font => $font );
}
}
sub drag {
my $widget = shift;
my $corner;
if ( defined $widget->Subwidget('corner') ) {
$corner = $widget->Subwidget('corner');
}
else {
$corner = $widget->Frame->pack( -side => 'bottom', -anchor => 'se' );
}
my $corner_label =
$corner->Label( -image => $dragimg )
->pack( -side => 'right', -anchor => 'se' );
$corner_label->bind(
'<Enter>',
sub {
if (OS_Win) {
$corner->configure( -cursor => 'size_nw_se' );
}
else {
$corner->configure( -cursor => 'sizing' );
}
}
);
$corner_label->bind( '<Leave>',
sub { $corner->configure( -cursor => 'arrow' ) } );
$corner_label->bind(
'<1>',
sub {
( $globalx, $globaly ) =
( $widget->toplevel->pointerx, $widget->toplevel->pointery );
}
);
$corner_label->bind(
'<B1-Motion>',
sub {
my $x =
$widget->toplevel->width - $globalx + $widget->toplevel->pointerx;
my $y = $widget->toplevel->height - $globaly +
$widget->toplevel->pointery;
( $globalx, $globaly ) =
( $widget->toplevel->pointerx, $widget->toplevel->pointery );
$widget->toplevel->geometry( $x . 'x' . $y );
}
);
}
</code>