Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Project Timeline Generator

by CombatSquirrel (Hermit)
on Dec 13, 2003 at 22:16 UTC ( [id://314563]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info /msg CombatSquirrel
Description:

This code is a "quick" (6 hours or so) hack to generate a project timeline.

It supports six descriptive elements for every task (task, description, start, end, coordinator, group) and its output is largely customizeable. Settings as well as project trees can be saved and loaded, project trees can be loaded by drag'n'drop.

Known bugs/weaknesses: Only supports five different colors for task lines on different levels, lacks user message boxes ('File could not be saved', 'File not saved yet, do you really want to open file "foo"?', ...), task order cannot be changed without deleting tasks after they are created (however, the generated files are Data::Dumper files {yes, I know, XML is a lot better -- go on and implement it and then /msg me ;-)} and can be easily modified by hand), and it is not really 'user friendly'.

Update: I should have mentioned that dates are in standard European dd.mm.yyyy format. On the other hand, that's kind of obvious from the code and you can set everything on the nice Tk::DateEntry widgets anyways.

 
#!perl -w
use strict;

use Data::Dumper;
use MIME::Base64;
use Date::Calc qw/Today Decode_Date_EU Delta_Days Add_Delta_Days Mktim
+e/;

use GD;

use Tk;
use Tk::HList;
use Tk::Button;
use Tk::DateEntry;
use Tk::Dialog;
use Tk::Photo;
use Tk::JPEG;
use Tk::DropSite;
use Tk::JComboBox;

#############################################
#                                           #
#                Prototypes                 #
#                                           #
#############################################

   ###            Variables           ###

my $GUI;
my $dialog;
my $preview;
my $options;
my $structure;
my $current;
my $previewDims;

   ###        Standard Functions      ###

sub min;
sub max;
sub earlier_date;
sub later_date;
sub date_in_range;
sub scale_from_to;
sub max_depth;
sub deep_copy;

   ###          GUI Functions         ###

sub buildGUI;
sub buildDialog;
sub buildPreview;
sub refreshGUILabels;
sub loadDataTk;
sub saveDataTk;
sub loadOptionsTk;
sub saveOptionsTk;
sub savePicTk;
sub onFileDrop;
sub optionsTk;
sub previewPicTk;
sub populateTreeRecursive;
sub redrawTreeTk;
sub selectStructureRecursive;
sub treeSelectTk;
sub okButtonTk;
sub deleteStructureRecursive;
sub deleteStructure;
sub deleteButtonTk;
sub newButtonTk;
sub selectColorComboTk;
sub updateColorComboTk;
sub colordefSelectTk;
sub colordefOKTk;
sub colordefNewTk;
sub colordefDeleteTk;

   ###          Drawing Functions      ###

sub drawTimeline;
sub getBarHandle;
sub getDatedTimeline;
sub timelineBackground;
sub getTextDimensions;
sub getText;
sub sizeText;
sub labelTimeline;
sub unfoldRecursive;
sub preprocessStructure;
sub generateTimeline;

#############################################
#                                           #
#           The Real Stuff (TM)             #
#                                           #
#############################################

$structure = [];

$options = {
   DIMENSIONS => [ 640, 480 ],
   START      => sprintf( '%02d.%02d.%4d', (localtime(time))[3],
                                           (localtime(time))[4] + 1,
                                           (localtime(time))[5] + 1900
                         ),
   END        => sprintf( '%02d.%02d.%4d', (localtime(time))[3],
                                           (localtime(time))[4] + 1,
                                           (localtime(time))[5] + 1900
                         ),
   FIELDNAMES => {
                     TASK        => 'Task Name',
                     DESCRIPTION => 'Description',
                     COORDINATOR => 'Coordinator',
                     START       => 'Begin',
                     END         => 'End',
                     GROUP       => 'Group Members'
                 },
   USEDFIELDS => [ qw/ TASK COORDINATOR / ],
   COLORDEFS  => {
                     White => [ 255, 255, 255 ],
                     Black => [   0,   0,   0 ],
                     Red   => [ 255,   0,   0 ],
                     Blue  => [   0,   0, 255 ]
                 },
   MAXBARSIZE => 20,
   FONT       => {
                     LOCATION => 'C:/WINDOWS/Fonts/times.ttf',
                     MAXSIZE  => 100,
                     MINSIZE  =>   8
                 },
   USEDCOLORS => {
                     BACKGROUND => 'White',
                     DATELINES  => 'Blue',
                     DATES      => 'Red',
                     GROUPLINES => 'Black',
                     GROUPS     => 'Black',
                     LAYERS     => [ qw/ Red Blue Black Black Black/ ]
                 }
};

$previewDims = [ 640, 480 ];

$GUI     = buildGUI;
$dialog  = buildDialog;
$preview = buildPreview;

$current = '§';
redrawTreeTk;
refreshGUILabels;

MainLoop;

exit;

#############################################
#                                           #
#                   Subs                    #
#                                           #
#############################################

   ###        Standard Functions      ###

sub min {
   return 0 unless @_;
   my $i = shift;
   for (@_) {
   $i = $_
      if ($_ < $i);
   }
   return $i;
}

sub max {
   return 0 unless @_;
   my $i = shift;
   for (@_) {
   $i = $_
      if ($_ > $i);
   }
   return $i;
}

sub earlier_date {
   return ( sort { $a->[0] <=> $b->[0] } map { [ Mktime(Decode_Date_EU
+($_), 0, 0, 0), $_ ] } @_ )[0]->[1];
}

sub later_date {
   return ( sort { $a->[0] <=> $b->[0] } map { [ Mktime(Decode_Date_EU
+($_), 0, 0, 0), $_ ] } @_ )[-1]->[1];
}

sub date_in_range {
   my @first  = Decode_Date_EU shift;
   my @second = Decode_Date_EU shift;
   my @middle = Decode_Date_EU shift;
   return undef if Delta_Days(@first,  @middle) < 0;
   return undef if Delta_Days(@middle, @second) < 0;
   return 'yes';
}

sub scale_from_to {
   Delta_Days( Decode_Date_EU($_[0]), Decode_Date_EU($_[2]) ) /
   Delta_Days( Decode_Date_EU($_[0]), Decode_Date_EU($_[1]) );
}

sub max_depth {
   my $tree = shift;
   return 0 unless 'array' eq lc ref $tree;
   return 1 + max(map { defined $_->{'SUBTASKS'} ? max_depth($_->{'SUB
+TASKS'}) : 0 } @$tree);
}

sub deep_copy {
   my $struc = shift;
   my $type = lc ref $struc;
   my $own;
   if ($type eq 'hash') {
      for (keys %$struc) {
         $own->{$_} = deep_copy($struc->{$_});
      }
   } elsif ($type eq 'array') {
      for (@$struc) {
         push @$own, deep_copy($_);
      }
   } else {
      $own = $struc;
   }
   return $own;
}

   ###          GUI Functions         ###

sub loadDataTk {
   my ($file, $VAR1);
   $file = $GUI->{'main'}->getOpenFile(
      -title => 'Open Data File',
      -filetypes => [
         ['Time Line Data', '.tld'],
         ['Text files',     '.txt'],
         ['All Files',      '*'   ]
       ],
      -defaultextension => '.tld'
   );
   if ( ($file or '') and ($file ne '') ) {
      open INFILE, '<', $file or last;
      eval do { local $/ = undef; <INFILE> };
      close INFILE;
      if ($VAR1 or '') {
         $GUI->{'tree view'}->delete('all');
         $structure = $VAR1;
         &redrawTreeTk;
         $current = '§';
         $GUI->{'tree view'}->selectionClear;
         $GUI->{'tree view'}->selectionSet('§');
      }
   }
}

sub saveDataTk {
   my $file = $GUI->{'main'}->getSaveFile(
      -title => 'Save Data',
      -filetypes => [
         ['Time Line Data', '.tld'],
         ['Text files',     '.txt'],
         ['All Files',      '*'   ]
       ],
      -defaultextension => '.tld'
   );
   return unless $file;
   open OUTFILE, '>', $file or return;
   print OUTFILE Dumper $structure;
   close OUTFILE;
}

sub loadOptionsTk {
   my ($file, $VAR1);
   $file = $GUI->{'main'}->getOpenFile(
      -title => 'Open Options File',
      -filetypes => [
         ['Time Line Options', '.tlo'],
         ['Text files',        '.txt'],
         ['All Files',         '*'   ]
       ],
      -defaultextension => '.tlo'
   );
   if ( ($file or '') and ($file ne '') ) {
      open INFILE, '<', $file or last;
      eval do { local $/ = undef; <INFILE> };
      close INFILE;
      if ($VAR1 or '') {
         $options = $VAR1;
         refreshGUILabels;
      }
   }
}

sub saveOptionsTk {
   my $file = $GUI->{'main'}->getSaveFile(
      -title => 'Save Options',
      -filetypes => [
         ['Time Line Options', '.tlo'],
         ['Text files',        '.txt'],
         ['All Files',         '*'   ]
       ],
      -defaultextension => '.tlo'
   );
   return unless $file;
   open OUTFILE, '>', $file or return;
   print OUTFILE Dumper $options;
   close OUTFILE;
}

sub savePicTk {
   my $file = $GUI->{'main'}->getSaveFile(
      -filetypes=> [
         ['PNG Graphics File',  '.png'],
         ['JPEG Graphics File', '.jpg'],
         ['GD Graphics File',   '.gd'],
         ['WBMP Graphics File', '.wbmp'],
       ],
      -defaultextension => '.png'
   );
   return unless $file;
   my ($ext) = $file =~ /\.([^.]+)/;
   $ext = lc $ext;
   $ext =~ s/jpg/jpeg/;
   my $image = generateTimeline(
      %{&deep_copy($options)},
      DATA => $structure
   );
   my $data;
   {
      no strict 'refs';
      eval { $data = $image->$ext } or return;
   }
   open OUTFILE, '>', $file or return;
   binmode OUTFILE;
   print OUTFILE $data;
   close OUTFILE;
   undef $image;
   undef $data;
}

sub onFileDrop {
   my ($widget, $selection) = @_;
   my ($file, $VAR1);
   eval {
      $file = $widget->SelectionGet(
         -selection => $selection,
         $^O eq 'MSWin32' ? 'STRING' : 'FILE_NAME'
      );
   };
   if ( ($file or '') and ($file ne '') ) {
      open INFILE, '<', $file or last;
      eval do { local $/ = undef; <INFILE> };
      close INFILE;
      if ($VAR1 or '') {
         $GUI->{'tree view'}->delete('all');
         $structure = $VAR1;
         &redrawTreeTk;
         $current = '§';
         $GUI->{'tree view'}->selectionClear;
         $GUI->{'tree view'}->selectionSet('§');
      }
   }
}

sub optionsTk {

   ### Empty fields ###
   
   $dialog->{     'minfont edit'}->delete(0,     'end');
   $dialog->{     'maxfont edit'}->delete(0,     'end');
   $dialog->{ 'x dimension edit'}->delete(0,     'end');
   $dialog->{ 'y dimension edit'}->delete(0,     'end');
   $dialog->{      'MAXBAR edit'}->delete(0,     'end');
   $dialog->{        'from date'}->delete(0,     'end');
   $dialog->{          'to date'}->delete(0,     'end');
   $dialog->{       'TASK check'}->{'Value'} = 0;
   $dialog->{        'TASK edit'}->delete(0,     'end');
   $dialog->{'DESCRIPTION check'}->{'Value'} = 0;
   $dialog->{ 'DESCRIPTION edit'}->delete(0,     'end');
   $dialog->{      'START check'}->{'Value'} = 0;
   $dialog->{       'START edit'}->delete(0,     'end');
   $dialog->{        'END check'}->{'Value'} = 0;
   $dialog->{         'END edit'}->delete(0,     'end');
   $dialog->{'COORDINATOR check'}->{'Value'} = 0;
   $dialog->{ 'COORDINATOR edit'}->delete(0,     'end');
   $dialog->{      'GROUP check'}->{'Value'} = 0;
   $dialog->{       'GROUP edit'}->delete(0,     'end');

   $dialog->{'colordefs list'}->delete('all');
   $dialog->{'coloruse list'}->delete('all');

   ### Fill fields ###
   
   $dialog->{       'font label'}->configure(-text => $options->{'FONT
+'}->{'LOCATION'});
   $dialog->{     'minfont edit'}->insert('end', $options->{'FONT'}->{
+'MINSIZE'});
   $dialog->{     'maxfont edit'}->insert('end', $options->{'FONT'}->{
+'MAXSIZE'});
   $dialog->{ 'x dimension edit'}->insert('end', $options->{'DIMENSION
+S'}->[0]);
   $dialog->{ 'y dimension edit'}->insert('end', $options->{'DIMENSION
+S'}->[1]);
   $dialog->{      'MAXBAR edit'}->insert('end', $options->{'MAXBARSIZ
+E'});
   $dialog->{        'from date'}->insert('end', $options->{'START'});
   $dialog->{          'to date'}->insert('end', $options->{'END'});

   for (qw/TASK DESCRIPTION START END COORDINATOR GROUP/) {
      $dialog->{"$_ edit"}->insert('end', $options->{'FIELDNAMES'}->{$
+_});
   }

   for (@{$options->{'USEDFIELDS'}}) {
      $dialog->{"$_ check"}->{'Value'} = 1;
   }
   
   my $pos = 0;

   for (keys %{$options->{'COLORDEFS'}}) {
      $dialog->{'colordefs list'}->add($pos);
      $dialog->{'colordefs list'}->itemCreate($pos, 0, -text => $_);
      $dialog->{'colordefs list'}->itemCreate($pos, 1, -text => $optio
+ns->{'COLORDEFS'}->{$_}->[0]);
      $dialog->{'colordefs list'}->itemCreate($pos, 2, -text => $optio
+ns->{'COLORDEFS'}->{$_}->[1]);
      $dialog->{'colordefs list'}->itemCreate($pos, 3, -text => $optio
+ns->{'COLORDEFS'}->{$_}->[2]);
      $pos++;
   }

   $pos = 0;

   for (qw/BACKGROUND DATELINES DATES GROUPLINES GROUPS/) {
      $dialog->{'coloruse list'}->add($pos);
      $dialog->{'coloruse list'}->itemCreate($pos, 0, -text => $_);
      $dialog->{'coloruse list'}->itemCreate($pos, 1, -text => $option
+s->{'USEDCOLORS'}->{$_});
      $pos++;
   }

   for (1..4) {
      $dialog->{'coloruse list'}->add($pos);
      $dialog->{'coloruse list'}->itemCreate($pos, 0, -text => "LAYER 
+$_");
      $dialog->{'coloruse list'}->itemCreate($pos, 1, -text => $option
+s->{'USEDCOLORS'}->{'LAYERS'}->[$_ - 1]);
      $pos++;
   }

   $dialog->{'coloruse list'}->add($pos);
   $dialog->{'coloruse list'}->itemCreate($pos, 0, -text => "LAYERS 5+
+");
   $dialog->{'coloruse list'}->itemCreate($pos, 1, -text => $options->
+{'USEDCOLORS'}->{'LAYERS'}->[4]);
   
   updateColorComboTk;

   ### Get fields ###

   $dialog->{'Colors'} = $options->{'COLORDEFS'};
   if ('OK' eq $dialog->{'main'}->Show) {

      $options->{'FONT'}->{'LOCATION'} = $dialog->{'font label'}->cget
+('-text');
      $options->{'FONT'}->{'MINSIZE'} = $dialog->{'minfont edit'}->get
+;
      $options->{'FONT'}->{'MAXSIZE'} = $dialog->{'maxfont edit'}->get
+;
      $options->{'DIMENSIONS'}->[0] = $dialog->{'x dimension edit'}->g
+et;
      $options->{'DIMENSIONS'}->[1] = $dialog->{'y dimension edit'}->g
+et;
      $options->{'MAXBARSIZE'} = $dialog->{'MAXBAR edit'}->get;
      $options->{'START'} = $dialog->{'from date'}->get;
      $options->{'END'} = $dialog->{'to date'}->get;

      $options->{'USEDFIELDS'} = [];
      for (qw/TASK DESCRIPTION START END COORDINATOR GROUP/) {
         $options->{'FIELDNAMES'}->{$_} = $dialog->{"$_ edit"}->get;
         push @{$options->{'USEDFIELDS'}}, $_ 
            if $dialog->{"$_ check"}->{'Value'} == 1;
      }

      # get number of defined colors
      my $num = 0;
      ++$num while $dialog->{'colordefs list'}->info('exists', $num);
      
      # delete previous colors
      $options->{'COLORDEFS'} = {};

      # get colors
      my $i;
      for ($i = 0; $i < $num; ++$i) {
         my ($colname, $r, $g, $b) = (
            $dialog->{'colordefs list'}->itemCget($i, 0, 'text'),
            $dialog->{'colordefs list'}->itemCget($i, 1, 'text'),
            $dialog->{'colordefs list'}->itemCget($i, 2, 'text'),
            $dialog->{'colordefs list'}->itemCget($i, 3, 'text')
         );
         $options->{'COLORDEFS'}->{$colname} = [ $r, $g, $b ];
      }

      # get fields' colors
      $i = 0;
   
      for (qw/BACKGROUND DATELINES DATES GROUPLINES GROUPS/) {
         $options->{'USEDCOLORS'}->{$_} =
            $dialog->{'coloruse list'}->itemCget($i, 1, 'text');
         $i++;
      }
   
      for (1..4) {
         $options->{'USEDCOLORS'}->{'LAYERS'}->[$_ - 1] =
            $dialog->{'coloruse list'}->itemCget($i, 1, 'text');
         $i++;
      }
   
      $options->{'USEDCOLORS'}->{'LAYERS'}->[4] =
         $dialog->{'coloruse list'}->itemCget($i, 1, 'text');
   
      refreshGUILabels;
   }
}

sub previewPicTk {
   my $resize = min(
      $previewDims->[0] / $options->{'DIMENSIONS'}->[0],
      $previewDims->[1] / $options->{'DIMENSIONS'}->[1]
   );

   my $privopts = deep_copy($options);

   $privopts->{'DIMENSIONS'}->[0]   *= $resize;
   $privopts->{'DIMENSIONS'}->[1]   *= $resize;
   $privopts->{'MAXBARSIZE'}        *= $resize;
   $privopts->{'FONT'}->{'MAXSIZE'} *= $resize;
   $privopts->{'FONT'}->{'MINSIZE'} *= $resize;

   my $image = generateTimeline(
      %$privopts,
      DATA => $structure
   );

   $preview->{'container'}->configure(
       -data => encode_base64($image->jpeg)
   );

   $preview->{'canvas'}->configure(
      -width  => $preview->{'container'}->width,
      -height => $preview->{'container'}->height,
   );

   $preview->{'canvas'}->createImage(
      0, 0,
      -image => $preview->{'container'},
      -anchor => 'nw'
   );

   undef $image;

   $preview->{'main'}->Show;
}

sub populateTreeRecursive {
   my ($tree, $head) = @_;
   return unless 'array' eq lc ref $tree;
   my $thead;
   for (@{$tree}) {
      $thead = $head . '§' . $_->{'TASK'};
      $GUI->{'tree view'}->add($thead, -text => $_->{'TASK'});
      next unless exists $_->{'SUBTASKS'};
      populateTreeRecursive($_->{'SUBTASKS'}, $thead);
   }
}

sub redrawTreeTk {
   $GUI->{'tree view'}->delete('all');
   $GUI->{'tree view'}->add('§', -text => 'Top Level');
   populateTreeRecursive($structure, '')
}

sub selectStructureRecursive {
   my ($pos, $head) = @_;
   return undef unless $pos;
   my $point;
   if ($pos =~ /§/) {
      $pos =~ s/([^§]*)§//;
      my $cur = $1;
      for (@$head) {
         ($point = $_) and last if ($_->{'TASK'} eq $cur);
      }
      return (($point->{'TASK'} eq $cur) ? selectStructureRecursive($p
+os, $point->{'SUBTASKS'}) : undef);
   } else {
      for $point (@$head) {
         return $point if ($point->{'TASK'} eq $pos);
      }
      return undef;
   }
}

sub treeSelectTk {
   $current = $_[0];

   $GUI->{       'name edit'}->delete(0,     'end');
   $GUI->{'description edit'}->delete('0.0', 'end');
   $GUI->{       'from date'}->delete(0,     'end');
   $GUI->{         'to date'}->delete(0,     'end');
   $GUI->{'coordinator edit'}->delete(0,     'end');
   $GUI->{    'members edit'}->delete('0.0', 'end');

   if ($current eq '§') {
      $GUI->{'name edit'}->insert('end', '[TASK NAME]');
      $GUI->{'description edit'}->insert('end', '[TASK DESCRIPTION]');
      $GUI->{'from date'}->insert(
         'end',
         sprintf '%02d.%02d.%4d', (localtime(time))[3],
                                  (localtime(time))[4] + 1,
                                  (localtime(time))[5] + 1900
      );
      $GUI->{'to date'}->insert(
         'end',
         sprintf '%02d.%02d.%4d', (localtime(time))[3],
                                  (localtime(time))[4] + 1,
                                  (localtime(time))[5] + 1900
      );
      $GUI->{'coordinator edit'}->insert('end', '[TASK COORDINATOR]');
      $GUI->{'members edit'}->insert('end', '[TASK MEMBERS, seperate b
+y new lines]');
   } else {
      my $struct = selectStructureRecursive(substr($current, 1), $stru
+cture);

      $GUI->{       'name edit'}->insert('end', $struct->{'TASK'});
      $GUI->{'description edit'}->insert('end', $struct->{'DESCRIPTION
+'});
      $GUI->{       'from date'}->insert('end', $struct->{'START'});
      $GUI->{         'to date'}->insert('end', $struct->{'END'});
      $GUI->{'coordinator edit'}->insert('end', $struct->{'COORDINATOR
+'});
      if (exists $struct->{'GROUP'}) {
         $GUI->{'members edit'}->insert('end', join "\n", @{$struct->{
+'GROUP'}});
      }
   }
}

sub okButtonTk {
   return if $current eq '§';
   my $lastname = $current;
   $lastname =~ s/§[^§]*//g;
   my $item = selectStructureRecursive(substr($current, 1), $structure
+);
   my $newname            = $GUI->{       'name edit'}->get;
   $item->{       'TASK'} = $newname;
   $item->{'DESCRIPTION'} = $GUI->{'description edit'}->get('0.0', 'en
+d');
   $item->{      'START'} = $GUI->{       'from date'}->get;
   $item->{        'END'} = $GUI->{         'to date'}->get;
   $item->{'COORDINATOR'} = $GUI->{'coordinator edit'}->get;
   my @lines = sort split /[\n\r]+/, 
                            $GUI->{    'members edit'}->get('0.0', 'en
+d');
   $item->{      'GROUP'} = [ @lines ];
   $GUI->{'members edit'}->delete('0.0', 'end');
   $GUI->{'members edit'}->insert('end', join "\n", @lines);
   unless ($lastname eq $newname) {
      $current =~ s/§[^§]*$/§$newname/;
      redrawTreeTk;
   }
}

sub deleteStructureRecursive {
   my $struct = shift;
   if ('array' eq ref $struct) {
      for (0 .. $#{$struct}) {
         deleteStructureRecursive($struct->[$_]);
         delete $struct->[$_];
      }
   } elsif ('hash' eq ref $struct) {
      for (keys %$struct) {
         deleteStructureRecursive($struct->{$_});
         delete $struct->{$_};
      }
   }
}

sub deleteStructure {
   my $name = shift;
   substr($name, 0, 1) = '';
   return unless $name;
   $name =~ s/§([^§]*)$//;
   my $item = $1;
   my $head;
   if ($item) {
      $head = selectStructureRecursive($name, $structure)->{'SUBTASKS'
+};
   } else {
      $item = $name;
      $head = $structure;
   }
   for (0 .. $#{$head}) {
      if ($head->[$_]->{'TASK'} eq $item) {
         deleteStructureRecursive $head->[$_];
         splice @$head, $_, 1;
         last;
      }
   }
}

sub deleteButtonTk {
   deleteStructure $current;
   $current =~ s/§[^§]*$//;
   redrawTreeTk;
}

sub newButtonTk {
   my $newpos = substr $current, 1;
   my $siblings;
   my $name = $GUI->{'name edit'}->get;
   if ($newpos) {
      $siblings = selectStructureRecursive($newpos, $structure);
      unless (exists $siblings->{'SUBTASKS'}) {
         $siblings->{'SUBTASKS'} = [];
      }
      $siblings = $siblings->{'SUBTASKS'};
   } else {
      $siblings = $structure;
   }
   for (@$siblings) {
      return if $_->{'TASK'} eq $name;
   }
   push @$siblings, { TASK => $name };
   for (@$siblings) {
      if ($_->{'TASK'} eq $name) {
         $siblings = $_;
         last;
      }
   }
   $siblings->{'DESCRIPTION'} = $GUI->{'description edit'}->get('0.0',
+ 'end');
   $siblings->{      'START'} = $GUI->{       'from date'}->get;
   $siblings->{        'END'} = $GUI->{         'to date'}->get;
   $siblings->{'COORDINATOR'} = $GUI->{'coordinator edit'}->get;
   my @lines = sort split /[\n\r]+/,
                            $GUI->{    'members edit'}->get('0.0', 'en
+d');
   $siblings->{      'GROUP'} = [ @lines ];
   $GUI->{'members edit'}->delete('0.0', 'end');
   $GUI->{'members edit'}->insert('end', join "\n", @lines);
   $current = "$current§$name";
   redrawTreeTk;
}

sub selectColorUse {
   my $index = shift;
   $dialog->{'coloruse combo box'}->setSelected(
      $dialog->{'coloruse list'}->itemCget($index, 1, 'text')
   );
}

sub selectColorComboTk {
   my ($index, $value) = @_;
   $index = $value;
   return unless exists $dialog->{'coloruse list'};
   return unless defined $dialog->{'coloruse list'}->info('selection')
+;
   $value = $dialog->{'coloruse combo box'}->getItemNameAt($index);
   $dialog->{'coloruse list'}->itemConfigure(
      $dialog->{'coloruse list'}->info('selection'), 1,
      -text => $value
   );
}

sub updateColorComboTk {
   $dialog->{'coloruse combo box'}->removeAllItems;
   my ($num, $i) = (0);
   ++$num while $dialog->{'colordefs list'}->info('exists', $num);
   for ($i = 0; $i < $num; ++$i) {
      $dialog->{'coloruse combo box'}->addItem(
         $dialog->{'colordefs list'}->itemCget($i, 0, 'text')
      );
   }
   return unless defined $dialog->{'coloruse list'}->info('selection')
+;
   my $name = $dialog->{'coloruse list'}->itemCget(
      $dialog->{'coloruse list'}->info('selection'), 0,
      'text'
   );
   $i = $dialog->{'coloruse combo box'}->getItemIndex($name);
   $dialog->{'coloruse combo box'}->setSelectedIndex($i)
      if defined $i;
}

sub colordefSelectTk {
  my $index = shift;
  $dialog->{'colordefs edit'}->delete(0, 'end');
  $dialog->{'colordefs edit'}->insert(
     'end',
     $dialog->{'colordefs list'}->itemCget($index, 0, 'text')
  );
  $dialog->{'colordefs label'}->configure(
     -text => join ', ', map { 
        $dialog->{'colordefs list'}->itemCget($index, 1 + $_, 'text')
                              } (0..2)
  );
}

sub colordefOKTk {
   my ($selindex, $name, $colors, $itemindex);
   $selindex = $dialog->{'colordefs list'}->info('selection');
   $name     = $dialog->{'colordefs edit'}->get;
   $colors   = $dialog->{'colordefs label'}->cget('text');
   return unless defined $selindex;
   my ($num, $i) = (0);
   ++$num while $dialog->{'colordefs list'}->info('exists', $num);
   for ($i = 0; $i < $num; ++$i) {
      if ($name eq $dialog->{'colordefs list'}->itemCget($i, 0, 'text'
+)) {
         $itemindex = $i;
         last;
      }
   }
   return if ((defined $itemindex) and ($itemindex != $selindex));
   $colors = [ split(/\s*,\s*/, $colors) ];
   $dialog->{'colordefs list'}->itemConfigure(
      $selindex, 0,
      -text => $name
   );
   $dialog->{'colordefs list'}->itemConfigure(
      $selindex, 1 + $_,
      -text => $colors->[$_]
   ) for (0..2);
   updateColorComboTk;
}

sub colordefNewTk {
   my $name     = $dialog->{'colordefs edit'}->get;
   my $colors   = $dialog->{'colordefs label'}->cget('text');
   my $num = 0;
   ++$num while $dialog->{'colordefs list'}->info('exists', $num);
   $colors = [ split(/\s*,\s*/, $colors) ];
   unshift @$colors, $name;
   $dialog->{'colordefs list'}->add($num);
   $dialog->{'colordefs list'}->itemCreate(
      $num, $_, -text => $colors->[$_]
   ) for (0..3);
   updateColorComboTk;
}

sub colordefDeleteTk {
   my $selindex = $dialog->{'colordefs list'}->info('selection');
   return unless defined $selindex;
   my ($num, $i, @temp) = (0);
   ++$num while $dialog->{'colordefs list'}->info('exists', $num);
   for ($i = 0; $i < $num; ++$i) {
      push @{$temp[$i]}, $dialog->{'colordefs list'}->itemCget($i, $_,
+ 'text')
         for (0..3);
   }
   $temp[$selindex] = undef;
   $dialog->{'colordefs list'}->delete('all');
   $i = 0;
   for my $t (@temp) {
      next unless defined $t;
      $dialog->{'colordefs list'}->add($i);
      $dialog->{'colordefs list'}->itemCreate(
         $i, $_, -text => $t->[$_]
      ) for (0..3);
      ++$i;
   }
   updateColorComboTk;
}

sub buildGUI {
   my $hash;

   $hash->{'main'} = new MainWindow;
   $hash->{'main'}->minsize(qw/550 350/);

   $hash->{'menubar'} = $hash->{'main'}->Menu;
      $hash->{'menubar'}->command(
         -label   => 'E~xit',
         -command => \&exit
      );
      $hash->{'options menu'} = $hash->{'menubar'}->cascade(
         -label   => '~Options',
         -tearoff => 0
      );
         $hash->{'options menu'}->command(
            -label   => '~Load ...',
            -command => \&loadOptionsTk
         );
         $hash->{'options menu'}->command(
            -label   => '~Save ...',
            -command => \&saveOptionsTk
         );
      $hash->{'data menu'} = $hash->{'menubar'}->cascade(
         -label   => '~Data',
         -tearoff => 0
      );
         $hash->{'data menu'}->command(
            -label   => '~Load ...',
            -command => \&loadDataTk
         );
         $hash->{'data menu'}->command(
            -label   => '~Save ...',
            -command => \&saveDataTk
         );
      $hash->{'menubar'}->command(
         -label   => 'Save ~Image ...',
         -command => \&savePicTk
      );
      $hash->{'menubar'}->command(
         -label   => 'O~ptions ...',
         -command => \&optionsTk
      );
      $hash->{'menubar'}->command(
         -label   => '~Preview ...',
         -command => \&previewPicTk
      );
   $hash->{'main'}->configure(
      -menu => $hash->{'menubar'}
   );

   $hash->{'tree view frame'} = $hash->{'main'}->Frame(
      -borderwidth => 3
   )->pack(
      -side => 'left',
      -fill => 'x'
   );
      $hash->{'tree view'} = $hash->{'tree view frame'}->HList(
         -width      => 30,
         -height     => 25,
         -itemtype   => 'text',
         -separator  => '§',
         -selectmode => 'single',
         -browsecmd  => \&treeSelectTk
      )->pack;
      
      $hash->{'tree view drop'} = $hash->{'tree view'}->DropSite(
         -dropcommand => [ \&onFileDrop, $hash->{'tree view'}],
         -droptypes   => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND',
+ 'Sun'])
      );

   $hash->{'edit frame'} = $hash->{'main'}->Frame(
      -borderwidth => 3
   )->pack(
      -side => 'right',
      -fill => 'x'
   );
      $hash->{'name frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x'
      );
         $hash->{'name label'} = $hash->{'name frame'}->Label(
            -text => 'Task Name:',
            -pady => 4
         )->pack(
            -side   => 'left'
         );
         $hash->{'name edit'} = $hash->{'name frame'}->Entry(
            -width => 35
         )->pack(
            -side => 'right',
            -pady => 4,
            -fill => 'x'
         );
         $hash->{'name edit'}->insert('end', '[TASK NAME]');
      $hash->{'description frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x'
      );
         $hash->{'description label'} = $hash->{'description frame'}->
+Label(
            -text => 'Task Description:',
            -pady => 4
         )->pack(
            -side   => 'left'
         );
         $hash->{'description edit'} = $hash->{'description frame'}->T
+ext(
            -height => 4,
            -width  => 30
         )->pack(
            -side => 'right',
            -pady => 4,
            -fill => 'x'
         );
         $hash->{'description edit'}->insert('end', '[TASK DESCRIPTION
+]');
      $hash->{'from frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x'
      );
         $hash->{'from label'} = $hash->{'from frame'}->Label(
            -text => 'Task Start:',
            -pady => 4
         )->pack(
            -side   => 'left'
         );
         $hash->{'from date'} = $hash->{'from frame'}->DateEntry(
            -width     => 32,
            -weekstart => 1,
            -daynames  => [ qw/So Mo Di Mi Do Fr Sa/ ],
            -parsecmd  => sub {
               my ($d, $m, $y) = ($_[0] =~ m/(\d+)\.(\d+)\.(\d+)/);
               return ($y, $m, $d);
            },
            -formatcmd => sub {
               sprintf ("%02d.%02d.%4d", $_[2], $_[1], $_[0]);
            }
         )->pack(
            -side => 'right',
            -pady => 4,
            -fill => 'x'
         );
         $hash->{'from date'}->insert(
            'end', 
            sprintf '%02d.%02d.%4d', (localtime(time))[3], 
                                     (localtime(time))[4] + 1, 
                                     (localtime(time))[5] + 1900
         );
      $hash->{'to frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x'
      );
         $hash->{'to label'} = $hash->{'to frame'}->Label(
            -text => 'Task End:',
            -pady => 4
         )->pack(
            -side   => 'left'
         );
         $hash->{'to date'} = $hash->{'to frame'}->DateEntry(
            -width     => 32,
            -weekstart => 1,
            -daynames  => [ qw/So Mo Di Mi Do Fr Sa/ ],
            -parsecmd  => sub {
               my ($d, $m, $y) = ($_[0] =~ m/(\d+)\.(\d+)\.(\d+)/);
               return ($y, $m, $d);
            },
            -formatcmd => sub {
               sprintf ("%02d.%02d.%4d", $_[2], $_[1], $_[0]);
            }
         )->pack(
            -side => 'right',
            -pady => 4,
            -fill => 'x'
         );
         $hash->{'to date'}->insert(
            'end',
            sprintf '%02d.%02d.%4d', (localtime(time))[3],
                                     (localtime(time))[4] + 1, 
                                     (localtime(time))[5] + 1900
         );
      $hash->{'coordinator frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x'
      );
         $hash->{'coordinator label'} = $hash->{'coordinator frame'}->
+Label(
            -text => 'Task Coordinator:',
            -pady => 4
         )->pack(
            -side   => 'left'
         );
         $hash->{'coordinator edit'} = $hash->{'coordinator frame'}->E
+ntry(
            -width => 35
         )->pack(
            -side => 'right',
            -pady => 4,
            -fill => 'x'
         );
         $hash->{'coordinator edit'}->insert('end', '[TASK COORDINATOR
+]');
      $hash->{'members frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x'
      );
         $hash->{'members label'} = $hash->{'members frame'}->Label(
            -text => 'Task Members:',
            -pady => 4
         )->pack(
            -side   => 'left'
         );
         $hash->{'members edit'} = $hash->{'members frame'}->Text(
            -height =>  4,
            -width  => 30
         )->pack(
            -side => 'right',
            -pady => 4,
            -fill => 'x'
         );
         $hash->{'members edit'}->insert('end', '[TASK MEMBERS, sepera
+te by new lines]');

      $hash->{'buttons frame'} = $hash->{'edit frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'bottom',
         -fill => 'x'
      );
         $hash->{'ok button frame'} = $hash->{'buttons frame'}->Frame(
            -borderwidth => 3
         )->pack(
            -side => 'left',
            -fill => 'x'
         );
            $hash->{'ok button'} = $hash->{'ok button frame'}->Button(
               -text      => 'OK',
               -width     => 15,
               -command   => \&okButtonTk
            )->pack();
         $hash->{'delete button frame'} = $hash->{'buttons frame'}->Fr
+ame(
            -borderwidth => 3
         )->pack(
            -side => 'left',
            -fill => 'x'
         );
            $hash->{'delete button'} = $hash->{'delete button frame'}-
+>Button(
               -text      => 'Delete',
               -width     => 15,
               -command   => \&deleteButtonTk
            )->pack();
         $hash->{'new button frame'} = $hash->{'buttons frame'}->Frame
+(
            -borderwidth => 3
         )->pack(
            -side => 'right',
            -fill => 'x'
         );
            $hash->{'new button'} = $hash->{'new button frame'}->Butto
+n(
               -text      => 'New',
               -width     => 15,
               -command   => \&newButtonTk
            )->pack();

   return $hash;
}

sub buildDialog {
   my $hash;

   $hash->{'main'} = $GUI->{'main'}->Dialog(
      -title          => 'Options',
      -buttons        => [ qw/OK Cancel/ ],
      -default_button => 'Cancel'
   );
   
   $hash->{'image options frame'} = $hash->{'main'}->Frame(
      -borderwidth => 3
   )->pack(
      -side => 'left',
      -padx => 5
   );
      $hash->{'font frame'} = $hash->{'image options frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x',
         -pady => 4
      );
         $hash->{'font type frame'} = $hash->{'font frame'}->Frame(
         )->pack(
            -side => 'top'
         );
            $hash->{'font label'} = $hash->{'font type frame'}->Label(
               -text  => 'C:\\WINDOWS\\Fonts\\times.ttf'
            )->pack(
               -side   => 'left',
               -pady  => 4
            );
            $hash->{'font button'} = $hash->{'font type frame'}->Butto
+n(
               -text    => 'Select Font',
               -width   => 20,
               -command => sub {
                              my $file = $dialog->{'main'}->getOpenFil
+e(
                                 -title => 'Select Font',
                                 -filetypes => [['True Type Font', '.t
+tf']],
                                 -defaultextension => '.ttf',
                                 -initialdir => 'C:\\WINDOWS\\Fonts'
                              );
                              return unless $file;
                              return unless $file =~ /\.ttf$/i;
                              return unless (-e $file);
                              $dialog->{'font label'}->configure( -tex
+t => $file );
                           }
            )->pack(
               -padx    => 15,
               -side    => 'right'
            );
         $hash->{'font min frame'} = $hash->{'font frame'}->Frame(
            -width => 30
         )->pack(
            -side => 'top',
            -pady => 4
         );
            $hash->{'minfont label'} = $hash->{'font min frame'}->Labe
+l(
               -text => 'Minimal Size:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'minfont edit'} = $hash->{'font min frame'}->Entry
+(
               -width => 15
            )->pack(
               -side => 'right',
               -padx => 5
            );
         $hash->{'font max frame'} = $hash->{'font frame'}->Frame(
            -width => 30
         )->pack(
            -side => 'top',
            -pady => 4
         );
            $hash->{'maxfont label'} = $hash->{'font max frame'}->Labe
+l(
               -text => 'Maximal Size:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'maxfont edit'} = $hash->{'font max frame'}->Entry
+(
               -width => 15
            )->pack(
               -side => 'right',
               -padx => 5
            );
   
      $hash->{'color frame'} = $hash->{'image options frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x',
         -pady => 4
      );
         $hash->{'colordefs frame'} = $hash->{'color frame'}->Frame(
         )->pack(
            -side => 'left',
            -padx => 5,
            -fill => 'y'
         );
            $hash->{'colordefs list'} = $hash->{'colordefs frame'}->HL
+ist(
               -header => 1,
               -columns => 4,
               -browsecmd => \&colordefSelectTk
            )->pack(
               -side => 'top'
            );

            $hash->{'colordefs list'}->header('create', 0, -text => 'C
+olor');
            $hash->{'colordefs list'}->header('create', 1, -text => 'R
+');
            $hash->{'colordefs list'}->header('create', 2, -text => 'G
+');
            $hash->{'colordefs list'}->header('create', 3, -text => 'B
+');
            
            $hash->{'colordefs color frame'} = $hash->{'colordefs fram
+e'}->Frame(
            )->pack(
               -side => 'top',
               -pady => 5,
               -fill => 'x'
            );
               $hash->{'colordefs edit'} = $hash->{'colordefs color fr
+ame'}->Entry(
                  -width => 20
               )->pack(
                  -side => 'top',
                  -pady => 4
               );
               $hash->{'colordefs edit'}->insert('end', 'Black');
               $hash->{'colordefs label'} = $hash->{'colordefs color f
+rame'}->Label(
                  -text => '0, 0, 0'
               )->pack(
                  -side => 'left',
                  -padx => 5
               );
               $hash->{'colordefs select'} = $hash->{'colordefs color 
+frame'}->Button(
                  -text    => 'Select',
                  -width   => 5,
                  -command => sub {
                                      my $color = $dialog->{'main'}->c
+hooseColor(
                                         -initialcolor => sprintf(
                                            '#%02x%02x%02x', 
                                            split /\s*,\s*/, $hash->{'
+colordefs label'}->cget('text')
                                         )
                                      );
                                      return unless $color;
                                      $hash->{'colordefs label'}->conf
+igure(
                                         -text => join ', ', map { hex
+ substr($color, 1+2*$_, 2) } (0..2)
                                      );
                                  }
               )->pack(
                  -side => 'right',
                  -padx => 5
               );

            $hash->{'colordefs button frame'} = $hash->{'colordefs fra
+me'}->Frame(
            )->pack(
               -side => 'top',
               -pady => 5
            );
               $hash->{'colordefs ok'} = $hash->{'colordefs button fra
+me'}->Button(
                  -text    => 'OK',
                  -width   => 5,
                  -command => \&colordefOKTk
               )->pack(
                  -side => 'left',
                  -padx => 5
               );
               $hash->{'colordefs new'} = $hash->{'colordefs button fr
+ame'}->Button(
                  -text    => 'New',
                  -width   => 5,
                  -command => \&colordefNewTk
               )->pack(
                  -side => 'left',
                  -padx => 5
               );
               $hash->{'colordefs delete'} = $hash->{'colordefs button
+ frame'}->Button(
                  -text    => 'Delete',
                  -width   => 5,
                  -command => \&colordefDeleteTk
               )->pack(
                  -side => 'left',
                  -padx => 5
               );

         $hash->{'coloruse frame'} = $hash->{'color frame'}->Frame(
         )->pack(
            -side => 'right',
            -padx => 5,
            -fill => 'y'
         );
            $hash->{'coloruse list'} = $hash->{'coloruse frame'}->HLis
+t(
               -header  => 1,
               -columns => 2,
               -browsecmd => \&selectColorUse
            )->pack(
               -side => 'top',
               -pady => 4
            );
   
            $hash->{'coloruse list'}->header('create', 0, -text => 'It
+em');
            $hash->{'coloruse list'}->header('create', 1, -text => 'Co
+lor');
   
            $hash->{'coloruse combo box'} = $hash->{'coloruse frame'}-
+>JComboBox(
               -relief             => 'groove',
               -popuprelief        => 'groove',
               -highlightthickness => 0,
               -choices            => [qw/White Black Blue Red/],
               -selectcommand      => \&selectColorComboTk
            )->pack(
               -side => 'top',
               -pady => 6
            );
            $hash->{'coloruse combo box'}->setSelectedIndex(0);
   
      $hash->{'image frame'} = $hash->{'image options frame'}->Frame(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x',
         -pady => 4
      );
         $hash->{'image dimensions frame'} = $hash->{'image frame'}->F
+rame(
         )->pack(
            -side => 'top',
            -pady => 4
         );
            $hash->{'dimensions label'} = $hash->{'image dimensions fr
+ame'}->Label(
               -text => 'Size'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'x dimension edit'} = $hash->{'image dimensions fr
+ame'}->Entry(
               -width => 10
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'x label'} = $hash->{'image dimensions frame'}->La
+bel(
               -text => 'x'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'y dimension edit'} = $hash->{'image dimensions fr
+ame'}->Entry(
               -width => 10
            )->pack(
               -side => 'left',
               -padx => 5
            );
         $hash->{'MAXBAR frame'} = $hash->{'image frame'}->Frame(
         )->pack(
            -side => 'top',
            -pady => 4
         );
            $hash->{'MAXBAR label'} = $hash->{'MAXBAR frame'}->Label(
               -text => 'Maximal Bar Thickness:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'MAXBAR edit'} = $hash->{'MAXBAR frame'}->Entry(
               -width => 10
            )->pack(
               -side => 'right',
               -padx => 5
            );
   
   $hash->{'display options frame'} = $hash->{'main'}->Frame(
      -borderwidth => 3
   )->pack(
      -side => 'right',
      -padx => 5
   );
      $hash->{'dates frame'} = $hash->{'display options frame'}->Frame
+(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x',
         -pady => 4
      );
         $hash->{'from frame'} = $hash->{'dates frame'}->Frame(
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'from label'} = $hash->{'from frame'}->Label(
               -text => 'Plan Start:',
               -pady => 4
            )->pack(
               -side   => 'left'
            );
            $hash->{'from date'} = $hash->{'from frame'}->DateEntry(
               -width     => 32,
               -weekstart => 1,
               -daynames  => [ qw/So Mo Di Mi Do Fr Sa/ ],
               -parsecmd  => sub {
                  my ($d, $m, $y) = ($_[0] =~ m/(\d+)\.(\d+)\.(\d+)/);
                  return ($y, $m, $d);
               },
               -formatcmd => sub {
                  sprintf ("%02d.%02d.%4d", $_[2], $_[1], $_[0]);
               }
            )->pack(
               -side => 'right',
               -pady => 4,
               -fill => 'x'
            );
            $hash->{'from date'}->insert(
               'end', 
               sprintf '%02d.%02d.%4d', (localtime(time))[3],
                                        (localtime(time))[4] + 1, 
                                        (localtime(time))[5] + 1900
            );
         $hash->{'to frame'} = $hash->{'dates frame'}->Frame(
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'to label'} = $hash->{'to frame'}->Label(
               -text => 'Plan End:',
               -pady => 4
            )->pack(
               -side   => 'left'
            );
            $hash->{'to date'} = $hash->{'to frame'}->DateEntry(
               -width     => 32,
               -weekstart => 1,
               -daynames  => [ qw/So Mo Di Mi Do Fr Sa/ ],
               -parsecmd  => sub {
                  my ($d, $m, $y) = ($_[0] =~ m/(\d+)\.(\d+)\.(\d+)/);
                  return ($y, $m, $d);
               },
               -formatcmd => sub {
                  sprintf ("%02d.%02d.%4d", $_[2], $_[1], $_[0]);
               }
            )->pack(
               -side => 'right',
               -pady => 4,
               -fill => 'x'
            );
            $hash->{'to date'}->insert(
               'end',
               sprintf '%02d.%02d.%4d', (localtime(time))[3],
                                        (localtime(time))[4] + 1,
                                        (localtime(time))[5] + 1900
            );
   
      $hash->{'fields frame'} = $hash->{'display options frame'}->Fram
+e(
         -borderwidth => 3
      )->pack(
         -side => 'top',
         -fill => 'x',
         -pady => 4
      );
         $hash->{'TASK frame'} = $hash->{'fields frame'}->Frame (
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'TASK check'} = $hash->{'TASK frame'}->Checkbutton
+(
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'TASK label'} = $hash->{'TASK frame'}->Label(
               -text => 'TASK:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'TASK edit'} = $hash->{'TASK frame'}->Entry(
               -width => 25
            )->pack(
               -side => 'right',
               -padx => 5
            );
         $hash->{'DESCRIPTION frame'} = $hash->{'fields frame'}->Frame
+ (
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'DESCRIPTION check'} = $hash->{'DESCRIPTION frame'
+}->Checkbutton(
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'DESCRIPTION label'} = $hash->{'DESCRIPTION frame'
+}->Label(
               -text => 'DESCRIPTION:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'DESCRIPTION edit'} = $hash->{'DESCRIPTION frame'}
+->Entry(
               -width => 25
            )->pack(
               -side => 'right',
               -padx => 5
            );
         $hash->{'START frame'} = $hash->{'fields frame'}->Frame (
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'START check'} = $hash->{'START frame'}->Checkbutt
+on(
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'START label'} = $hash->{'START frame'}->Label(
               -text => 'START:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'START edit'} = $hash->{'START frame'}->Entry(
               -width => 25
            )->pack(
               -side => 'right',
               -padx => 5
            );
         $hash->{'END frame'} = $hash->{'fields frame'}->Frame (
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'END check'} = $hash->{'END frame'}->Checkbutton(
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'END label'} = $hash->{'END frame'}->Label(
               -text => 'END:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'END edit'} = $hash->{'END frame'}->Entry(
               -width => 25
            )->pack(
               -side => 'right',
               -padx => 5
            );
         $hash->{'COORDINATOR frame'} = $hash->{'fields frame'}->Frame
+ (
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'COORDINATOR check'} = $hash->{'COORDINATOR frame'
+}->Checkbutton(
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'COORDINATOR label'} = $hash->{'COORDINATOR frame'
+}->Label(
               -text => 'COORDINATOR:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'COORDINATOR edit'} = $hash->{'COORDINATOR frame'}
+->Entry(
               -width => 25
            )->pack(
               -side => 'right',
               -padx => 5
            );
         $hash->{'GROUP frame'} = $hash->{'fields frame'}->Frame (
            -borderwidth => 3
         )->pack(
            -side => 'top',
            -fill => 'x'
         );
            $hash->{'GROUP check'} = $hash->{'GROUP frame'}->Checkbutt
+on(
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'GROUP label'} = $hash->{'GROUP frame'}->Label(
               -text => 'GROUP:'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'GROUP edit'} = $hash->{'GROUP frame'}->Entry(
               -width => 25
            )->pack(
               -side => 'right',
               -padx => 5
            );
   
   return $hash;
}

sub buildPreview {
   my $hash;
   $hash->{'main'} = $GUI->{'main'}->Dialog(
      -title          => 'Preview',
      -buttons        => [ qw/OK/ ],
      -default_button => 'OK'
   );

   $hash->{'container'} = $hash->{'main'}->Photo(
      '-format' => 'jpeg'
   );

   $hash->{'canvas'} = $hash->{'main'}->Canvas()->pack( -side => 'top'
+ );

   return $hash;
}

sub refreshGUILabels {
   $GUI->{       'name label'}->configure(
      -text => $options->{'FIELDNAMES'}->{'TASK'} . ':'
   );
   $GUI->{'description label'}->configure(
      -text => $options->{'FIELDNAMES'}->{'DESCRIPTION'} . ':'
   );
   $GUI->{       'from label'}->configure(
      -text => $options->{'FIELDNAMES'}->{'START'} . ':'
   );
   $GUI->{         'to label'}->configure(
      -text => $options->{'FIELDNAMES'}->{'END'} . ':'
   );
   $GUI->{'coordinator label'}->configure(
      -text => $options->{'FIELDNAMES'}->{'COORDINATOR'} . ':'
   );
   $GUI->{    'members label'}->configure(
      -text => $options->{'FIELDNAMES'}->{'GROUP'} . ':'
   );
}

   ###          Drawing Functions      ###

sub drawTimeline {
   my %options = @_;

   return 'No image defined' unless $options{'image'};
   unless (defined $options{'color'}) {
      $options{'color'} = $options{'image'}->colorAllocate(0, 0, 0); #
+ black
   }

   $options{'line'} += $options{'top'};
   $options{'triangle'}->{'height'} += $options{'line'};
   $options{'image'}->filledRectangle(
      $options{'from'}, $options{'top'},
      $options{'to'},   $options{'line'},
      $options{'color'}
   );

   my $triangle = new GD::Polygon;


   if ($options{triangle}->{beginning}) {
      $triangle->addPt(
         $options{'from'},
         $options{'line'}
      );
      $triangle->addPt(
         $options{'from'} + $options{'triangle'}->{'width'} / 2,
         $options{'triangle'}->{'height'}
      );
      $triangle->addPt(
         $options{'from'} + $options{'triangle'}->{'width'},
         $options{'line'}
      );
   
      $options{'image'}->filledPolygon( $triangle, $options{'color'} )
+;
   }

   if ($options{triangle}->{end}) {
      $triangle->addPt(
         $options{'to'},
         $options{'line'}
      );
      $triangle->addPt(
         $options{'to'} - $options{'triangle'}->{'width'} / 2,
         $options{'triangle'}->{'height'}
      );
      $triangle->addPt(
         $options{'to'} - $options{'triangle'}->{'width'},
         $options{'line'}
      );
   
      $options{'image'}->filledPolygon( $triangle, $options{'color'} )
+;
   }

   $options{'triangle'}->{'height'} -= $options{'line'};
   $options{'line'} -= $options{'top'};

   return undef;
}

sub getBarHandle {
   my %args = @_;
   return sub {
      my %ops = %args;
      @ops{qw/from to/} = (
         $ops{from} + $_[0] * ($ops{to} - $ops{from}) - $ops{triangle}
+->{width} / 2,
         $ops{from} + $_[1] * ($ops{to} - $ops{from}) + $ops{triangle}
+->{width} / 2
      );
      $ops{triangle}->{beginning} = $_[4];
      $ops{triangle}->{end} = $_[5];
      $ops{'color'} = $_[2];
      $ops{'top'}   = $_[3];

      drawTimeline %ops;
   }
}

sub getDatedTimeline {
   my %args = @_;
   my ($from, $to) = @args{qw/start end/};
   my $barhandle = getBarHandle %args;
   return sub {
      $barhandle->(
         scale_from_to($from, $to, later_date(  $_[0], $from)),
         scale_from_to($from, $to, earlier_date($_[1], $to)),
         $_[2],
         $_[3],
         date_in_range($from, $to, $_[0]),
         date_in_range($from, $to, $_[1])
      );
   }
}

sub timelineBackground {
   my %vals = @_;
   my ($image, $lines, $font, $size, $fontloc, $from, $to, $top, $bott
+om, $fbot, $space, $width)
   = @vals{qw/image linecol fontcol fontsize font start end top bottom
+ fontbottom left width/};
   my $alpha = -.5 * atan2(1, 0);
   $size *= sqrt(2) / 10;
   my $offset = 2 * $size;
   my $i = 0;
   my $last = -1;
   my $delta = Delta_Days(Decode_Date_EU($from), Decode_Date_EU($to));
   for ($i = 0; $i <= $delta; ++$i) {
      $image->line(
         $space + $width * $i / $delta, $top,
         $space + $width * $i / $delta, $bottom,
         $lines
      );
      if (int($width * $i / ($delta * $offset)) > $last) {
         $last = int($width * $i / ($delta * $offset));
         $image->stringFT(
            $font, $fontloc, $size, $alpha,
            $space + $width * $i / $delta, $fbot + $size,
            sprintf('%02d.%02d.%04d', reverse Add_Delta_Days(Decode_Da
+te_EU($from), $i)),
            { charmap => 'Unicode' }
         );
      }
   }
}

sub getTextDimensions {
   my %vals = (
      font    => 'C:/WINDOWS/Fonts/times.ttf',
      size    => 12,
      spacing => 1,
      @_
   );
   my ($font, $size, $spacing, $string) = @vals{qw/font size spacing s
+tring/};
   my @dims;
   my %res;
   my ($x, $y, $xo, $yo) = (1, 1, 0, 0);
   my $image = new GD::Image($x, $y);
   $image->colorAllocate(0, 0, 0);
   @dims = $image->stringFT(
      0, $font, $size, 0,
      $xo, $yo, $string,
      {
         charmap     => 'Unicode',
         linespacing => $spacing
      }
   );
   @res{qw/xo yo width height/}
   = ($xo - $dims[0], $yo - $dims[7], $dims[2] - $dims[0], $dims[1] - 
+$dims[7]);
   return %res;
}

sub getText {
   my %options = @_;
   my ($props, $items, $img, $left, $center, $font, $color, $size) =
   @options{qw/properties items image left center font color size/};
   my $text1 = join "\n\r", map { $_->[1] . ": " } @$props;
   my $text2 = join "\n\r", map { $items->{$_->[0]} } @$props;
   my %text1prs = getTextDimensions(
      font    => $font,
      size    => $size,
      spacing => 1,
      string  => $text1
   );
   my %text2prs = getTextDimensions(
      font    => $font,
      size    => $size,
      spacing => 1,
      string  => $text2
   );
   my $larger = $text1prs{height} > $text2prs{height} ? 1 : 2;
   if ($larger == 1) {
      $img->stringFT(
         $color, $font, $size, 0,
         $left + $text1prs{xo}, $center + $text1prs{yo} - $text1prs{he
+ight} / 2, $text1,
         {
            charmap     => 'Unicode',
            linespacing => 1
         }
      );
      $img->stringFT(
         $color, $font, $size, 0,
         $left + $text1prs{xo} + $text1prs{width}, $center + $text1prs
+{yo} - $text1prs{height} / 2, $text2,
         {
            charmap     => 'Unicode',
            linespacing => 1
         }
      );
   } else {
      $img->stringFT(
         $color, $font, $size, 0,
         $left + $text1prs{xo}, $center + $text1prs{yo} - $text2prs{he
+ight} / 2, $text1,
         {
            charmap     => 'Unicode',
            linespacing => 1
         }
      );
      $img->stringFT(
         $color, $font, $size, 0,
         $left + $text1prs{xo} + $text1prs{width}, $center + $text1prs
+{yo} - $text2prs{height} / 2, $text2,
         {
            charmap     => 'Unicode',
            linespacing => 1
         }
      );
   }
}

sub sizeText {
   my %args = @_;
   my ($width, $height, $props, $items, $font, $max, $min)
   = @args{qw/width height properties items font max min/};
   my $first  = join "\n\r", map { $_->[1] . ": " } @$props;
   my @second = map { my $item = $_; join "\n\r", map { $item->{$_->[0
+]} } @$props } @$items;
   my $size = $max;
   my (%text1prs, %text2prs, $nw);
   OUTER: while ($size > $min) {
      %text1prs = getTextDimensions(
         font    => $font,
         size    => $size,
         spacing => 1,
         string  => $first
      );
      next OUTER if $text1prs{height} > $height;
      $nw = $width - $text1prs{width};
      for (@second) {
         %text2prs = getTextDimensions(
            font    => $font,
            size    => $size,
            spacing => 1,
            string  => $_
         );
         next OUTER if $text2prs{height} > $height;
         next OUTER if $text2prs{width}  > $nw;
      }
      last OUTER;
   } continue { --$size }
   return $size;
}

sub labelTimeline {
   my %args = @_;
   my ($image, $font, $text, $lines, $props, $items, $width, $max, $mi
+n)
      = @args{qw/image font text lines properties items width max min/
+}; # and height
   my $size = $args{'height'} / (@{$args{'items'}} * 2 + 3);
   my $space = 4 * $size / (7 * sqrt(3));
   my $textsize = sizeText(
      width      => 4 * $size - 2 * $space,
      height     => 2 * $size - 2 * $space,
      properties => $props,
      items      => [ map { $_->[3] } @$items ],
      font       => $font,
      max        => $max,
      min        => $min
   );

   $image->setThickness(5);
   $image->line(
      $size, 1.5 * $size,
      $width - $size, 1.5 * $size,
      $lines
   );
   my $i = 0;
   for my $item (@$items) {
      ++$i;
      $image->line(
         $size, (1.5 + 2 * $i) * $size,
         $width - $size, (1.5 + 2 * $i) * $size,
         $lines
      );
      getText(
         properties => $props,
         items      => $item->[3],
         image      => $image,
         left       => $item->[2] * $size + $space,
         center     => (2 * $i + 0.5) * $size,
         font       => $font,
         color      => $text,
         size       => $textsize
      );
   }
}

sub unfoldRecursive {
   my ($tree, $layer) = @_;
   my $result;
   my $return;
   return [] unless 'array' eq lc ref $tree;
   for my $node (@$tree) {
      push @$result, [
                         $node->{'START'},
                         $node->{'END'},
                         $layer,
                         { 
                            map { $_, $node->{$_} }
                               qw/TASK DESCRIPTION COORDINATOR START E
+ND GROUP/
                         }
                     ];
      $return = unfoldRecursive($node->{'SUBTASKS'}, $layer + 1);
      next unless $return;
      push @$result, @$return;
   }
   return $result;
}

sub preprocessStructure {
   my $struct = shift;
   my $result = unfoldRecursive($struct, 1);
   for (@$result) {
      $_->[3]->{'GROUP'}
         = join ",\n\r", 
              map { join ' ', reverse split /, /, $_ } @{$_->[3]->{'GR
+OUP'}};
      $_->[3]->{'DESCRIPTION'} =~ s/[\n\r]+/\n\r/g;
   }
   return $result;
}

sub generateTimeline {
   # DIMENSIONS, START, END, FIELDNAMES, USEDFIELDS,
   # COLORDEFS, MAXBARSIZE, FONT, USEDCOLORS, DATA

   my %opts = @_;

   my $image = new GD::Image @{$opts{'DIMENSIONS'}};

   $opts{'COLORDEFS'}->{$opts{'USEDCOLORS'}->{'BACKGROUND'}}
      = $image->colorAllocate(@{$opts{'COLORDEFS'}->{$opts{'USEDCOLORS
+'}->{'BACKGROUND'}}});
   for (keys %{$opts{'COLORDEFS'}}) {
      $opts{'COLORDEFS'}->{$_} = $image->colorAllocate(@{$opts{'COLORD
+EFS'}->{$_}})
         if ref $opts{'COLORDEFS'}->{$_};
   }

   my $numlayers = max_depth($opts{'DATA'});

   my $layercolors = $opts{'USEDCOLORS'}->{'LAYERS'};
   push @{$layercolors}, ( $layercolors->[-1] ) x ( $numlayers - @$lay
+ercolors )
      if @$layercolors < max_depth($opts{'DATA'});

   my $items = preprocessStructure $opts{'DATA'};

   my $size = $opts{'DIMENSIONS'}->[1] / ( @{$items} * 2 + 3 );

   timelineBackground(
      image      => $image,
      linecol    => $opts{'COLORDEFS'}->{$opts{'USEDCOLORS'}->{'DATELI
+NES'}},
      fontcol    => $opts{'COLORDEFS'}->{$opts{'USEDCOLORS'}->{'DATES'
+}},
      fontsize   => $size,
      font       => $opts{'FONT'}->{'LOCATION'},
      start      => $opts{'START'},
      end        => $opts{'END'},
      top        => 1.5 * $size,
      bottom     => $opts{'DIMENSIONS'}->[1] - 1.5 * $size,
      fontbottom => $opts{'DIMENSIONS'}->[1] - $size,
      left       => (4 + $numlayers) * $size,
      width      => $opts{'DIMENSIONS'}->[0] - (5 + $numlayers) * $siz
+e
   );
   
   my $line = 3 * $size / 7;
   $line = $opts{'MAXBARSIZE'}
      if $opts{'MAXBARSIZE'} < $line;
   $line /= 3;

   my $timefunc = getDatedTimeline(
      start     => $opts{'START'},
      end       => $opts{'END'},
      from      => (4 + $numlayers) * $size,
      to        => $opts{'DIMENSIONS'}->[0] - $size,
      top       => $size,
      totheight => $opts{'DIMENSIONS'}->[1] - 2 * $size,
      line      => 3 * $line,
      triangle  => { height => 4 * $line, width => 8 * $line / sqrt(3)
+ },
      image     => $image
   );

   my $i = 2;

   for (@{$items}) {
      $timefunc->(
         $_->[0], $_->[1],
         $opts{'COLORDEFS'}->{$opts{'USEDCOLORS'}->{'LAYERS'}->[$_->[2
+] - 1]},
         $i * $size
      );
      $i += 2;
   }
   
   labelTimeline(
      image      => $image,
      font       => $opts{'FONT'}->{'LOCATION'},
      max        => $opts{'FONT'}->{'MAXSIZE'},
      min        => $opts{'FONT'}->{'MINSIZE'},
      text       => $opts{'COLORDEFS'}->{$opts{'USEDCOLORS'}->{'GROUPS
+'}},
      lines      => $opts{'COLORDEFS'}->{$opts{'USEDCOLORS'}->{'GROUPL
+INES'}},
      properties => [ map { [ $_, $opts{'FIELDNAMES'}->{$_}] } @{$opts
+{'USEDFIELDS'}}],
      items      => $items,
      width      => $opts{'DIMENSIONS'}->[0],
      height     => $opts{'DIMENSIONS'}->[1]
   );
   
   return $image;
}
Replies are listed 'Best First'.
Re: Project Timeline Generator
by Anonymous Monk on Dec 14, 2003 at 00:09 UTC
    Well I have installed several more Tk modules, the GD module, and libgd 2.0.15 to get this working, and it still doesn't. That's enough messing around for me for one day, anyhow. Yes, there is a down side to having hundereds of independently created modules available. Anyhow, here is where I gave up: 
    GD.xs: In function `newDynamicCtx': (and numerous other functions)
GD.xs:430: structure has no member named `gd_free'
[reply]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://314563]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-04-24 18:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found