File: canvas_ps

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 (75 lines) | stat: -rwxr-xr-x 2,333 bytes parent folder | download | duplicates (5)
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;