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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
#!/usr/local/bin/perl -w
use Tk;
%Tk::FontMap = ();
sub Tk::Font
{
my ($w,%args) = @_;
$args{'family'} = 'times' unless (exists $args{'family'});
$args{'weight'} = 'medium' unless (exists $args{'weight'});
$args{'slant'} = 'r' unless (exists $args{'slant'});
$args{'size'} = 140 unless (exists $args{'size'});
$args{'spacing'} = '*' unless (exists $args{'spacing'});
$args{'foundry'} = '*' unless (exists $args{'foundry'});
$args{'slant'} = substr($args{'slant'},0,1);
my $name = "-$args{'foundry'}-$args{'family'}-$args{'weight'}-$args{'slant'}-*-*-*-$args{'size'}-*-*-$args{'spacing'}-*-iso8859-1";
unless (exists $Tk::FontMap{$name})
{
my $fam = "\u\L$args{'family'}";
my $w = "\u\L$args{'weight'}";
my $sz = $args{'size'}/10;
my $sl = "\L$args{'slant'}";
my $an = "";
$w .= "Italic" if ($sl eq 'i');
$w .= "Oblique" if ($sl eq 'o');
$Tk::FontMap{$name} = [ "$fam-$w", $sz ];
print "$fam-$w","\n";
}
return $name;
}
%colormap = ();
sub plot
{
my ($c) = @_;
my $ps = $c->postscript('-x' => 0, '-y' => 0, -width => $c->Width, -height => $c->Height,
-fontmap => \%Tk::FontMap, -colormap => \%colormap);
open(PS,">$0.ps") || die "Cannot open $0.ps:$!";
print PS $ps,"\n";
close(PS);
}
$top = MainWindow->new();
$c = $top->Canvas();
$c->pack(-expand => 1, -fill => 'both');
$b = $top->Button(-text => 'Quit', -command => [ 'destroy', $top ]);
$b->pack;
$b = $top->Button(-text => 'Plot', -command => [ \&plot, $c ]);
$b->pack;
$f1 = $c->Font(family => 'courier', weight => 'bold', size => 120);
$c->create('text', 20, 20, -font => $f1, -anchor => 'nw', -fill => 'red',
-justify => 'left',
-text => 'This is a piece of "courier" Text');
$colormap{'red'} = '0.2 setgray';
$f2 = $c->Font(family => 'times', slant => 'italic', weight => 'bold', size => 140);
$c->create('text', 20, 80, -font => $f2, -anchor => 'nw', -fill => 'green',
-justify => 'left',
-text => 'This is a piece of "times" Text');
$c->create('text', 20, 120,
-font => $c->Font(family => 'times', weight => 'bold', size => 240),
-anchor => 'nw',
-justify => 'left',
-text => 'This is a piece of "times" Text');
$colormap{'green'} = '0.5 setgray';
MainLoop;
|
