Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

CHARACTER MAP

by Babu (Initiate)
on Apr 14, 2012 at 13:00 UTC ( [id://965062]=perlquestion: print w/replies, xml ) Need Help??

Babu has asked for the wisdom of the Perl Monks concerning the following question:

This node falls below the community's threshold of quality. You may see it by logging in.

Replies are listed 'Best First'.
Re: CHARACTER MAP
by zentara (Archbishop) on Apr 14, 2012 at 16:29 UTC

      Thanks for your reply. I would like to build a script which would take the font name as argument and displays the utf8 characters that are supported by that font as like charmap application.

        I would like to build a script which would take the font name as argument and displays the utf8 characters that are supported by that font

        I showed you how to display the unicode characters in the Font viewer above. All you need to do is gather information on font you have on your commandline, and use a module to extract all the characters. This isn't a code writing service.

        Look at TrueType font gallery and the various CPAN Font related modules at Font to see how you can examine a Font file and extract the code points and names. The Tk module has in it's /examples directory the following script which is named unicode and attempts to display all the code pages on your system. It looks like Unicode::Unihan is easily used.

        You probably should look at Gucharmap if you want a nice charmap program, it's gtk2-c, not Perl, but you could convert it to Perl if you wanted.

        #!/usr/bin/perl -w use strict; use Tk; use Unicode::UCD qw(charinfo charblock); use Tk::widgets qw(TixGrid ItemStyle Font); use Carp; #$SIG{__WARN__} = \&Carp::confess; eval { require Unicode::Unihan }; my $unihan; my %info = %{charinfo(ord(' '))}; if (defined $Unicode::Unihan::VERSION) { $unihan = Unicode::Unihan->new; $info{Definition} = ''; } my $mw = MainWindow->new; my $page = 0; my $pagehex = '0x00'; my $tp = $mw->Frame->pack(-fill => 'x'); my $l = $tp->Label(-text => 'Page:',-justify => 'right',-anchor => 'e' +); my $s = $tp->Spinbox(-width => 4, -to => 255, -from => 0, -format => " +%3.0f", -textvariable => \$page,-justify => 'left'); my $h = $tp->Label(-width => 4, -textvariable => \$pagehex, -justify = +> 'left'); Tk::grid($l,$s,$h,-sticky => 'ew'); $s->configure(-command =>\&set_page); my $uf = $mw->fontCreate(-family => 'lucida sans', -size => 16); my $lf = $mw->fontCreate(-family => 'courier', -size => 12); print join(' ',$mw->fontActual($uf)),"\n"; my $grid = $mw->Scrolled( TixGrid => -width => 17, -height => 17, -scrollbars => 'w', -browsecmd => \&browse, -formatcmd => \&doFormat, -leftmargin => 1, -topmargin => 1, -selectunit => 'cell', -itemtype => 'text') ->pack(-fill => 'both', -expand => 1); my $bt = $mw->Frame->pack(-fill => 'x'); my @foot; my $row = 0; my $col = 0; foreach my $key (sort keys %info) { my $l = $bt->Label(-text => $key, -justify => 'right', -anchor => 'e +'); my $v = $bt->Label(-textvariable => \$info{$key}, -justify => 'left' +, -anchor => 'w'); Tk::grid($l,-row =>$row,-column => $col,-sticky => 'w'); Tk::grid($v,-row =>$row,-column => $col+1,-sticky => 'ew'); $bt->gridColumnconfigure($col+1,-weight => 1); $col += 2; if ($col >= 6) { $row++; $col = 0; } } my $header = $grid->ItemStyle('text', -font => $lf); my $uni = $grid->ItemStyle('text', -font => $uf, -justify => 'cente +r'); $grid->sizeRow('default',-size => 'auto',-pad0 => 0, -pad1 => 0); $grid->sizeColumn('default',-size => 'auto',-pad0 => 0, -pad1 => 0); for my $i (0x0..0xf) { $grid->set($i+1,0,-itemtype => 'text', -style => $header, -text => sprintf("0x%04X",$i)); } my @page; $row = 1; for (my $base = 0; $base < 0x10000; $base += 16) { $grid->set(0,$row++,-itemtype => 'text', -style => $header, -text => sprintf("0x%04X",$base)); } $mw->update; $mw->packPropagate(0); MainLoop; sub fill_row { my ($row) = @_; my $base = ($row-1) << 4; my $seen = 0; my $block = charblock($base); return 0 if !defined($block) || $block =~ /Surrogate/i; for my $i (0x0..0xf) { my $u = $base + $i; my $info = charinfo($u); if (keys(%$info)) { $seen++; my $c = chr($u); $grid->set($i+1,$row,-style => $uni, -text => $c); } } if ($seen) { if (!defined($block)) { warn "$base has no block but saw $seen\n"; } } return $seen; } my @filled; sub doFormat { my ($area,$x1,$y1,$x2,$y2) = @_; if ($area =~ /([xys])_margin/) { # s = The top corner, x = left margin, y = top margin ? my $rel = ($1 eq 's') ? 'flat' : 'sunken'; $grid->formatBorder($x1,$y1,$x2,$y2,-relief => $rel, -bd => 2); } elsif ($area eq 'main') { for my $row ($y1..$y2) { unless ($filled[$row]++) { fill_row($row); } } $grid->formatGrid($x1,$y1,$x2,$y2,-relief => 'raised', -bd => 2); } else { print "format @_\n"; } } sub browse { my ($row,$col) = @_; my $c = eval { $grid->entrycget($row,$col,'-text') }; if (defined $c) { my $u = ord($c); my $h = charinfo($u); foreach my $k (keys %$h) { $info{$k} = $h->{$k}; } $info{Definition} = $unihan->Definition($c) if $unihan; } } sub set_page { my ($e) = @_; $pagehex = sprintf("0x%02X",$page); $grid->see(0,($page << 4)+1); }

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
Re: CHARACTER MAP
by NetWallah (Canon) on Apr 14, 2012 at 13:53 UTC
    The chr() function will be useful in this endeavor..

                 All great truths begin as blasphemies.
                       ― George Bernard Shaw, writer, Nobel laureate (1856-1950)

Re: CHARACTER MAP
by repellent (Priest) on Apr 14, 2012 at 19:29 UTC
Re: CHARACTER MAP
by JavaFan (Canon) on Apr 14, 2012 at 13:06 UTC
    I give you the first couple of lines:
    #!/usr/bin/perl use strict; use warnings;
    Feel free to drop by again after you've tried something yourself, and have more specific questions.
Re: CHARACTER MAP
by planetscape (Chancellor) on Apr 16, 2012 at 12:38 UTC
Re: CHARACTER MAP
by Anonymous Monk on Apr 14, 2012 at 23:34 UTC
    Why? every operating system already comes with a charmap application?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://965062]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-03-29 01:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found