#!/usr/bin/perl use strict; use warnings; use Tk; my $mw = tkinit( -title => 'timeline' ); my $c = $mw->Scrolled( Canvas => -scrollbars => 'soe', -width => 500, -height => 400, -background => 'white', )->pack( -fill => 'both', -expand => 1, )->Subwidget('scrolled'); my @data = ( time - 60 * 60 * 24 * 7 * 4, [ 'Anfang' ], time - 60 * 60 * 24 * 7 * 3, [ 'Termin', 'Termin 2' ], time - 60 * 60 * 24 * 7 * 2, [ 'Mitte' ], time - 60 * 60 * 24 * 7 * 1, [ 'Termin 3', 'Termin 4' ], time - 60 * 60 * 24 * 7 * 0, [ 'Ende' ], ); my $scrltop = $c->createTimeline( 0, 400, 500, 400, \@data, ); $c->configure( -scrollregion => [ -100, $scrltop-15, 600, 415 ] ); MainLoop; sub Tk::Canvas::createTimeline { my( $self, $x0, $y0, $x1, $y1, $data ) = @_; my $xstep = @$data > 2 ? ($x1 - $x0) / ($data->[-2] - $data->[0]) : die "Timeline: Not enough data specified!\n"; # create x-axe: $self->createLine( $x0, $y0, $x1, $y1, -fill => 'black', -arrow => 'last', ); my $scrltop = $y0; # plot data: for ( my $i = 0; $i < @$data; $i += 2 ) { my( $x, $y ) = @{$data}[$i,$i+1]; my $xpos = ($x - $data->[0]) * $xstep; # create x-axe-label: $self->createLine( $xpos, $y1, $xpos, $y1+3, -fill => 'black', ); $self->createText( $xpos, $y1+15 + ($i/2 % 2 ? 0 : 15), -anchor => 'center', -text => scalar localtime $x, -fill => 'black', ); # plot events: for ( my $j = 0; $j < @$y; $j++ ) { $self->createText( $xpos, $y1 - $j * 24 - ($i/2 % 2 ? 24 : 12), -anchor => 'center', -text => $y->[$j], -fill => 'black', ); } # for # update $scrltop: my $yh = $y1 - $#{$y} * 24 - ($i/2 % 2 ? 24 : 12); $scrltop = $yh if $yh < $scrltop; } # for # return top-coordinate: return $scrltop; } # Tk::Canva::createTimeline