in reply to Re^2: Creating Pie chart based graph network
in thread Creating Pie chart based graph network
Here's a working script that produces pie charts. See the notes at the end (which will probably make more sense after you've read the code and run the script).
#!/usr/bin/env perl use strict; use warnings; use Tk; use List::Util 'sum'; my $pie_slice_colours = [ map { '#' . $_ } qw{ff0000 ffff00 00ff00 00ffff 0000ff ff00ff} + ]; my @pie_data = ( { centre_x => 50, centre_y => 150, radius => 40, values => [ 1, 2, 5, 3 ], fills => $pie_slice_colours, }, { centre_x => 220, centre_y => 105, radius => 100, values => [ 1, 8, 16, 4, 2 ], fills => $pie_slice_colours, }, { centre_x => 420, centre_y => 75, radius => 75, values => [ 1, 1, 2, 3, 5, 8 ], fills => $pie_slice_colours, }, { centre_x => 60, centre_y => 40, radius => 50, values => [ 32, 16, 8, 4, 2, 1 ], fills => $pie_slice_colours, }, ); my $mw = MainWindow->new; my $ctrl_F = $mw->Frame->pack(-side => 'bottom'); $ctrl_F->Button(-text => 'Quit', -command => sub { exit })->pack; my $canv_F = $mw->Frame->pack(-side => 'top', -fill => 'both', -expand + => 1); my $sc = $canv_F->Scrolled(Canvas => -scrollbars => 'osoe', -bg => '#ffffff', -width => 500, -height => 220, -scrollregion => [0, 0, 500, 220], ); $sc->pack(-fill => 'both', -expand => 1); my $canvas = $sc->Subwidget('canvas'); draw_pie(\$canvas, $_) for @pie_data; MainLoop; sub draw_pie { my ($c_ref, $data) = @_; my @coords = @{_get_pie_coords($c_ref, $data)}; $$c_ref->createArc(@coords, %$_) for @{_get_pie_slices($data)}; return; } sub _get_pie_coords { my ($c_ref, $data) = @_; my ($x, $y, $r) = @$data{qw{centre_x centre_y radius}}; my $h = $$c_ref->cget('-height'); return [$x - $r, $h - $y + $r, $x + $r, $h - $y - $r]; } sub _get_pie_slices { my $data = shift; my @values = @{$data->{values}}; my @fills = @{$data->{fills}}; my $total_values = sum @values; my $start = 90; return [ map { my $extent = 360 * $values[$_] / $total_values; $start -= $extent; +{ -extent => $extent, -start => $start, -fill => $fills[$ +_] } } 0 .. $#values ]; }
Notes:
- The Tk::Canvas coordinate system is an upside-down version of Cartesian coordinates. I personally don't like this: mainly because I find it counter-intuitive (x increases along the x-axis but y decreases along the y-axis). _get_pie_coords() takes (x,y) Cartesian coordinates for the centre of the pie chart, as well as the radius for the pie chart, and returns the coordinates required by createArc(). Feel free to revert to the Tk::Canvas coordinate system; however, you'll still need a function like this unless you're happy to specify (x1, y1, x2, y2) for every pie chart (and note those coordinates are outside the pie chart).
- The placement of the pie slices is also somewhat counter-intuitive (at least, in my opinion). If you take the defaults, -start is called 0° (but, on a compass, it would be east, i.e. 90°); and -extent (whose default value is 90°) increases in an anticlockwise direction such that adding 90° to east results in north (on a compass, that would be south). Anyway, _get_pie_slices() works all that out for you: the first slice starts at 0° (north) and extends proportionally in a clockwise fashion; subsequent slices continue to be added in the same manner.
- Unless you have a particular reason not to, you probably want (at least optional) scrollbars. Note that Scrolled(Canvas => ...) is actually a composite widget and the Tk::Canvas widget is a component of this accessed with Subwidget('canvas').
- I've added six colours ($pie_slice_colours) and reused them for each pie chart. You may need more colours. You may not want the same colours for every chart: set the value of the fills key how you want it.
- Everything else should either be fairly straightforward Perl or documented via links already supplied.
-- Ken
|
---|
In Section
Seekers of Perl Wisdom