in reply to How to display point labels in the plot itself for Tk::PlotDataset

Or..is it anyway possible to display the Tk::ballons for all the points at a time without mouse overing them..

Why would you want to do it that way? Why even use balloons, if they are to be displayed like labels? Your best bet is to use the Canvas, plot your points and add text objects for each point. Here is a simple example. 

#!/usr/bin/perl
use Tk;
use strict;
my $w=20;
my $x=0;
my $y=0;

my %nums = (
   0 => ['black','yellow'], 
   1 => ['yellow','black'], 
   2 => ['white','green'],    
   3 => ['green','white'], 
   4 => ['grey','red'], 
   5 => ['red','grey'], 
   6 => ['blue','white'], 
   7 => ['white','blue'], 
   8 => ['orange','grey45'], 
   9 => ['grey45','orange'], 
);


my $mw=tkinit;
my $c = $mw->Canvas->pack;

for (0..9) {
 my $item=$c->createRectangle($x,$y,$x+20,$y+20,
             -fill=> ${$nums{$_}}[0],
             -tags => ['rect']
      );

my $text = $c->createText($x+10,$y+10,
           -anchor=>'center',
       -fill => ${$nums{$_}}[1],
       -text => $_,
           -tags => ['num','upper-left-corner']    
      );
      
      $x+=20;
}

$mw->Button(
    -text    => "Hide Text",
    -command => sub {
            $c->lower('num','rect');
             })->pack;

$mw->Button(
    -text    => "Show Text",
    -command => sub {
            $c->raise('num','rect');
             })->pack;
  
MainLoop;

[download]
I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh
  • Comment on Re: How to display point labels in the plot itself for Tk::PlotDataset
  • Download Code

Replies are listed 'Best First'.
Re^2: How to display point labels in the plot itself for Tk::PlotDataset
by Anonymous Monk on Feb 03, 2012 at 09:25 UTC
    Thank you very much for the reply...but actually there are many points in my plot out of which for some of them I want to display their labels (which may be sometimes big) probably vertically and in some way so that they superimpose the least (of course without changing the point coordinates).Is there any module that can do this or can I use the canvas to show points with labels vertically (as my points would be on the outer edge of a circle and I want the labels for the points on the circle to be displayed in the graph)..
[reply]
      Is there any module that can do this or can I use the canvas to show points with labels vertically (as my points would be on the outer edge of a circle

      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Ă&#159; 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__

      [download]
      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]

In Section Seekers of Perl Wisdom