File: tkfontsel

package info (click to toggle)
perl-tk 1%3A804.036%2Bdfsg1-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 35,284 kB
  • sloc: ansic: 349,560; perl: 52,292; sh: 12,678; makefile: 5,700; asm: 3,565; ada: 1,681; pascal: 1,082; cpp: 1,006; yacc: 883; cs: 879
file content (55 lines) | stat: -rw-r--r-- 1,584 bytes parent folder | download | duplicates (10)
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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
#!/usr/local/bin/perl -w
use strict;
use Tk;
use Tk::Font;
use Tk::widgets qw(BrowseEntry Text Spinbox);
my %fopt = (-family => 'fixed', -weight => 'medium',
            -slant => 'roman', -size => 12);
my $mw   = MainWindow->new();
my $font = $mw->Font(%fopt);
my $family  = $mw->BrowseEntry(-variable => \$fopt{-family},
                           -options => [sort $mw->fontFamilies()],
                           -command => [\&SetFont,$font,\%fopt]);
my $size = $mw->Spinbox(-width => 3, -textvariable => \$fopt{-size},
                        -from => 6, -to => 72,
                        -command => [\&SetFont,$font,\%fopt]);
my $weight = $mw->Optionmenu(-width => 3, -variable => \$fopt{-weight},
                        -options => [qw(medium bold)],
                        -command => [\&SetFont,$font,\%fopt]);

Tk::grid($mw->Label(-text => 'Family:',-justify => 'right'), $family,
         $mw->Label(-text => 'Size:',-justify => 'right'), $size,
         $mw->Label(-text => 'Weight:',-justify => 'right'), $weight,
         -sticky => 'ew',
        );

my $text = $mw->Scrolled(Text => -font => $font, -width => 40, -height => 20)->grid(-sticky => 'nsew', -columnspan => 6);

my $l = '';
for my $ch (0x20..0x7E,0xa0..0xff)
 {
  $l .= chr($ch);
  if (length($l) == 16)
   {
    $text->insert(end => "$l\n");
    $l = '';
   }
 }

#$text->insert('end',<<"END");
#Example Text - list
#\x{20ac}40 Only.
#END

MainLoop;

sub SetFont
{
 my ($font,$fopt) = @_;
 my @opt = %$fopt;
 print "@opt\n";
 $font->configure(%$fopt);
 @opt = $font->actual;
 print "$$font @opt\n";
}