in reply to Re^2: How to display point labels in the plot itself for Tk::PlotDataset
in thread How to display point labels in the plot itself for Tk::PlotDataset
Rotations are handled cleanly in the Goo::Canvas. See Goo::Canvas Graphing demo for example. It would be easy to plot your points, then have rotated text associated with each.
Making rotated text is arduous on Tk, but you may find it easier with Tk::Zinc. But here is eserte's attempt.
#!/usr/bin/perl -w # -*- *perl* -*- package main; use vars qw($x11); package Tk::RotX11Font; # $Id: RotX11Font.pm,v 1.13 1999/01/22 00:38:27 eserte Exp eserte $ # Author: Slaven Rezic # # Copyright (C) 1998, 1999 Slaven Rezic. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as *Perl* itself. # # Mail: ese... #</groups/unlock?msg=a8e2ebe3c5c85dc4&_done=/group/comp.lang.perl.tk/b +rowse_thread/thread/a128e86f32629886/a8e2ebe3c5c85dc4%3Flnk%3Dst%26q% +3DX11%253A%253AProtocol%2BPerl%26rnum%3D2>@cs.tu-berlin.de # WWW: http://user.cs.tu-berlin.de/~eserte/ use Tk; use Tk::Font; use strict; use vars qw(%font_cache); sub new { my($pkg, $text, $f_sub, $size, $rad) = @_; my $self = {}; ($self->{Font}, $self->{'Xadd'}, $self->{'Yadd'}) = get_font_attrib($text, $f_sub, $size, $rad); $self->{Text} = $text; bless $self, $pkg; } sub writeCanvas { my($rotfont, $c, $x, $y, $tags, $text) = @_; my $xadd_ref = $rotfont->{Xadd}; my $yadd_ref = $rotfont->{Yadd}; $text = $rotfont->{Text} if !defined $text; for(split(//, $text)) { my $item = $c->createText ($x, $y, -text => $_, -font => $rotfont->{Font}, -anchor => 'w', (defined $tags ? (-tags => $tags) : ())); $x+=$xadd_ref->[ord($_)]; $y+=$yadd_ref->[ord($_)]; } ($x, $y); } # Arguments: # $c - canvas # $x, $y - start coordinates # $f_sub - template for font as a sub reference, something like: # sub { "-adobe-helvetica-medium-r-normal--0-" . $_[0] ."-0-0 +-p-0-iso8859-1" } # $size - point- (or pixel?)size # $rad - angle in radians # $text - text for output # $tags - (optional) tags # # Returns coordinate ($x, $y) of the position of textcursor after draw +ing. sub writeRot { my($c, $x, $y, $f_sub, $size, $rad, $text, $tags) = @_; my($f, $xadd_ref, $yadd_ref) = get_font_attrib($text, $f_sub, $siz +e, $rad); for(split(//, $text)) { my $item = $c->createText($x, $y, -text => $_, -font => $f, -anchor => 'w', (defined $tags ? (-tags => $tags) : +())); $x+=$xadd_ref->[ord($_)]; $y+=$yadd_ref->[ord($_)]; } ($x, $y); } # Returns an array with the generated X11 font name, and references # to the per-character X-Add- and Y-Add-arrays sub get_font_attrib { my($text, $f_sub, $size, $rad) = @_; my($mat) = get_matrix($size, $rad); my %chars_used = map { (ord($_), 1) } split(//, $text); my $chars_used = join(" ", sort {$a <=> $b } keys %chars_used); # X11R6- oder *X11::Protocol*-Bug? Font-Struktur muĂŸ mehr al +s ein # Zeichen enthalten! if (scalar keys %chars_used == 1) { $chars_used .= " " . ((keys(%chars_used))[0] == 32 ? 33 : 32); } my $f = $f_sub->($mat); $f .= "[$chars_used]"; my($xadd_ref, $yadd_ref) = get_x11font_resources($f, \%chars_used) +; ($f, $xadd_ref, $yadd_ref); } sub get_matrix { my($size, $r) = @_; my($mat); foreach ($size*cos($r), $size*sin($r), $size*-sin($r), $size*cos($ +r)) { s/-/~/g; if ($mat) { $mat .= " " } $mat .= $_; } "[" . $mat . "]"; } sub x_y_extent { my($rotfont, $text) = @_; my $x = 0; my $y = 0; my $xadd_ref = $rotfont->{Xadd}; my $yadd_ref = $rotfont->{Yadd}; $text = $rotfont->{Text} if !defined $text; foreach (split(//, $text)) { $x += $xadd_ref->[ord($_)]; $y += $yadd_ref->[ord($_)]; } ($x, $y); } sub get_x_y_extent { my($text, $f_sub, $size, $rad) = @_; my($f, $xadd_ref, $yadd_ref) = get_font_attrib($text, $f_sub, $siz +e, $rad); my $x = 0; my $y = 0; foreach (split(//, $text)) { $x += $xadd_ref->[ord($_)]; $y += $yadd_ref->[ord($_)]; } ($x, $y); } sub get_x11font_resources { my $font = shift; my $chars_used_ref = shift; my $fid = $main::x11->new_rsrc; $main::x11->OpenFont($fid, $font); my(%res) = $main::x11->QueryFont($fid); my @x; foreach (keys %{$res{'properties'}}) { if ($main::x11->atom_name($_) eq 'FONT') { my $realfont; $realfont = $main::x11->atom_name($res{'properties'}->{$_} +); my(@f) = split(/-/, $realfont); @x = split(/\s/, substr($f[7], 1, length($f[7])-2)); foreach (@x) { s/~/-/g } last; } } my(@font_xadd); my(@font_yadd); $#font_xadd = 255; $#font_yadd = 255; foreach (keys %$chars_used_ref) { my $attr = $res{'char_infos'}->[$_-$res{'min_char_or_byte2'}]- +>[5]; my($x, $y) = ($attr/1000*$x[0], -$attr/1000*$x[1]); $font_xadd[$_] = $x; $font_yadd[$_] = $y; } $main::x11->CloseFont($fid); $font_cache{$font} = [\@font_xadd, \@font_yadd]; # XXX create dup? (\@font_xadd, \@font_yadd); } return 1 if caller(); package main; use Tk; use X11::Protocol; MAIN: { my $top = new MainWindow; $x11 = X11::Protocol->new(); my $font = shift || "adobe-helvetica"; my $size = shift || 24; my $f_sub = sub { "-$font-medium-r-normal--0-" . $_[0] . "-0-0-p-0 +-iso8859-1" }; my $c = $top->Canvas(-width => 500, -height => 500, -bg => 'white', )->pack; my $start = time; for(my $deg = -180; $deg <= 180; $deg+=15) { my $d = $deg; my $r = _deg2rad($d); my $text = " Some Rotated Text"; # my $rotfont = new Tk::RotX11Font $text, $f_sub, $size, $r; # $rotfont->writeCanvas($c, 250, 250); Tk::RotX11Font::writeRot($c, 250, 250, $f_sub, $size, $r, $tex +t); printf STDERR "(x/y) at %4d° = (" . join("/", Tk::RotX11Font::get_x_y_extent($text, $f_sub, $siz +e,$r)) . ")\n", $d; } warn "Time: " . (time-$start) . " seconds\n"; MainLoop; } sub _deg2rad { $_[0]/180*3.141592653; } __END__
|
|---|