Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

thundergnat's scratchpad

by thundergnat (Deacon)
on Jun 09, 2005 at 00:17 UTC ( #464906=scratchpad: print w/ replies, xml ) Need Help??

#!/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+MTYHcAANAGg +nsAAGAA AAAAACH5BAAAAAAALAAAAAAMAAwAAwQfMMg5BaDYXiw178AlcJ6VhYFXoSoosm7KvrR8zf +XHRQA7' ); 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 => \&uch +ar ); 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 ', )->g +rid( -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($o +rd) && hex( $blocks{$_}[1] ) >= hex($o +rd) ) { $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 )->gri +d( -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->destro +y; } ); } 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->pointe +ry ); } ); $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->pointe +ry ); $widget->toplevel->geometry( $x . 'x' . $y ); } ); }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (11)
As of 2014-12-26 14:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (171 votes), past polls