#!perl -w
use strict;

use Data::Dumper;
use MIME::Base64;
use Date::Calc qw/Today Decode_Date_EU Delta_Days Add_Delta_Days Mktime/;

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($_->{'SUBTASKS'}) : 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->{'DIMENSIONS'}->[0]);
   $dialog->{ 'y dimension edit'}->insert('end', $options->{'DIMENSIONS'}->[1]);
   $dialog->{      'MAXBAR edit'}->insert('end', $options->{'MAXBARSIZE'});
   $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 => $options->{'COLORDEFS'}->{$_}->[0]);
      $dialog->{'colordefs list'}->itemCreate($pos, 2, -text => $options->{'COLORDEFS'}->{$_}->[1]);
      $dialog->{'colordefs list'}->itemCreate($pos, 3, -text => $options->{'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 => $options->{'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 => $options->{'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'}->get;
      $options->{'DIMENSIONS'}->[1] = $dialog->{'y dimension edit'}->get;
      $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($pos, $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 by new lines]');
   } else {
      my $struct = selectStructureRecursive(substr($current, 1), $structure);

      $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', 'end');
   $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', 'end');
   $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', 'end');
   $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'}->Text(
            -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'}->Entry(
            -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, seperate 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'}->Frame(
            -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'}->Button(
               -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'}->Button(
               -text    => 'Select Font',
               -width   => 20,
               -command => sub {
                              my $file = $dialog->{'main'}->getOpenFile(
                                 -title => 'Select Font',
                                 -filetypes => [['True Type Font', '.ttf']],
                                 -defaultextension => '.ttf',
                                 -initialdir => 'C:\\WINDOWS\\Fonts'
                              );
                              return unless $file;
                              return unless $file =~ /\.ttf$/i;
                              return unless (-e $file);
                              $dialog->{'font label'}->configure( -text => $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'}->Label(
               -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'}->Label(
               -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'}->HList(
               -header => 1,
               -columns => 4,
               -browsecmd => \&colordefSelectTk
            )->pack(
               -side => 'top'
            );

            $hash->{'colordefs list'}->header('create', 0, -text => 'Color');
            $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 frame'}->Frame(
            )->pack(
               -side => 'top',
               -pady => 5,
               -fill => 'x'
            );
               $hash->{'colordefs edit'} = $hash->{'colordefs color frame'}->Entry(
                  -width => 20
               )->pack(
                  -side => 'top',
                  -pady => 4
               );
               $hash->{'colordefs edit'}->insert('end', 'Black');
               $hash->{'colordefs label'} = $hash->{'colordefs color frame'}->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'}->chooseColor(
                                         -initialcolor => sprintf(
                                            '#%02x%02x%02x', 
                                            split /\s*,\s*/, $hash->{'colordefs label'}->cget('text')
                                         )
                                      );
                                      return unless $color;
                                      $hash->{'colordefs label'}->configure(
                                         -text => join ', ', map { hex substr($color, 1+2*$_, 2) } (0..2)
                                      );
                                  }
               )->pack(
                  -side => 'right',
                  -padx => 5
               );

            $hash->{'colordefs button frame'} = $hash->{'colordefs frame'}->Frame(
            )->pack(
               -side => 'top',
               -pady => 5
            );
               $hash->{'colordefs ok'} = $hash->{'colordefs button frame'}->Button(
                  -text    => 'OK',
                  -width   => 5,
                  -command => \&colordefOKTk
               )->pack(
                  -side => 'left',
                  -padx => 5
               );
               $hash->{'colordefs new'} = $hash->{'colordefs button frame'}->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'}->HList(
               -header  => 1,
               -columns => 2,
               -browsecmd => \&selectColorUse
            )->pack(
               -side => 'top',
               -pady => 4
            );
   
            $hash->{'coloruse list'}->header('create', 0, -text => 'Item');
            $hash->{'coloruse list'}->header('create', 1, -text => 'Color');
   
            $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'}->Frame(
         )->pack(
            -side => 'top',
            -pady => 4
         );
            $hash->{'dimensions label'} = $hash->{'image dimensions frame'}->Label(
               -text => 'Size'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'x dimension edit'} = $hash->{'image dimensions frame'}->Entry(
               -width => 10
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'x label'} = $hash->{'image dimensions frame'}->Label(
               -text => 'x'
            )->pack(
               -side => 'left',
               -padx => 5
            );
            $hash->{'y dimension edit'} = $hash->{'image dimensions frame'}->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'}->Frame(
         -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'}->Checkbutton(
            )->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'}->Checkbutton(
            )->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, $bottom, $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_Date_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 string/};
   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{height} / 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{height} / 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, $min)
      = @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 END 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]->{'GROUP'}};
      $_->[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{'COLORDEFS'}->{$_}})
         if ref $opts{'COLORDEFS'}->{$_};
   }

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

   my $layercolors = $opts{'USEDCOLORS'}->{'LAYERS'};
   push @{$layercolors}, ( $layercolors->[-1] ) x ( $numlayers - @$layercolors )
      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'}->{'DATELINES'}},
      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) * $size
   );
   
   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'}->{'GROUPLINES'}},
      properties => [ map { [ $_, $opts{'FIELDNAMES'}->{$_}] } @{$opts{'USEDFIELDS'}}],
      items      => $items,
      width      => $opts{'DIMENSIONS'}->[0],
      height     => $opts{'DIMENSIONS'}->[1]
   );
   
   return $image;
}