File: font_demo

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (32 lines) | stat: -rwxr-xr-x 1,010 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#!/usr/local/bin/perl -w
use Tk;
use Tk::X11Font;
use Tk::ROText;

my $mw   = MainWindow->new;
my $font = $mw->X11Font(space   => 'm', 
			weight  => 'medium',
			point   => 140);
my $mb    = $mw->Frame->pack(-fill => 'x');
my $text  = $mw->ROText(-font => $font)->pack(-expand => 1, -fill => 'both');
my $bfont = $font->Clone(weight =>'bold');
my $bold  = $text->Tag('bold',-font => $bfont);

print "Bold is ",scalar($bfont->Name),"\n ascent=",
       $bfont->ascent," descent=",$bfont->descent,"\n";

$mb->Optionmenu(-text => 'Font', -underline => 0,
                -options => [sort $font->Name],
                -command => [configure => $text, '-font' ])
               ->pack(-side => 'right');
$mb->Button(-text => 'Quit', -command => [destroy => $mw ])->pack(-side => 'left');;
my $file = __FILE__;
open(FILE,"<$file") || die "Cannot open $file:$!";
while (<FILE>)
 {
  $text->insert(end => $_);
 }

$text->bind('<b>',[$bold,'add',Ev('index' => 'sel.first'),Ev('index' => 'sel.last')]);
   
MainLoop;