#!/usr/local/bin/perl -w

use Tk;
use Tk::TableMatrix;
require Tk::JBrowseEntry;
require Tk::DragDrop;
require Tk::DropSite;
use strict;

my $tm_array = {};
my $t;
my @drag = ();
my @drop = ();

sub switch_cells
 {
  if ($drag[0] == $drop[0]) # Selbe Zeile
   {
    if ($drag[1] >= 0) # Kein Titel
     { 
      my $drag_coords = $drag[0].','.$drag[1];
      my $drop_coords = $drop[0].','.$drop[1];
      my $drag_val = $tm_array->{$drag_coords};
      my $drop_val = $tm_array->{$drop_coords};

      $t->set($drop_coords, $drag_val);
      $tm_array->{$drop_coords} = $drag_val;

      $t->set($drag_coords, $drop_val);
      $tm_array->{$drag_coords} = $drop_val;
     }
   }
 }

my $start_row = -3;
my $end_row = 50;
my $start_col = 0;
my $end_col = 50;
my $display_cols = 10;
my $display_rows = 10; 
my $nr_rows = $end_row - $start_row + 1;
my $nr_cols = $end_col - $start_col + 1;
my $title_rows = ($start_row < 0) ? (abs($start_row)) : (0);
my $title_cols = ($start_col < 0) ? (abs($start_col)) : (0);

foreach my $row  (($start_row - $title_rows)..$end_row)
 {
  foreach my $col (($start_col - $title_cols)..$end_col)
   {
    $tm_array->{"$row,$col"} = "$row:$col";
   }
 }

my $top = MainWindow->new;
$top->geometry('870x300');

$top->bind( '<MouseWheel>', [ sub { $_[0]->yviewScroll(-($_[1]/120)*3, 'units'); }, Tk::Ev('D') ] );

$t = $top->Scrolled( 'TableMatrix', 
                     -titlerows => $title_rows,   -titlecols => $title_cols,
                     -rows =>      $nr_rows,      -cols =>      $nr_cols, 
                     -height =>    $display_rows, -width =>     $display_cols, 
                     -variable => $tm_array,
                     -roworigin => $start_row,
                     -colorigin => $start_col, 
                     -colstretchmode => 'none',
                     -rowstretchmode => 'none',
                     -selectmode => 'single',
                     -drawmode => 'fast',
                     -maxwidth => 800,
                     -maxheight => 600,
                     -rowheight => -20,
                     -colwidth => -200,
                     -resizeborders => 'none',
                     -sparsearray => 0, 
                     -selecttitle => 0,                     
                     -state => 'disabled',
                     -font => ['Tahoma', 10, 'bold'],
                     -bg => '#D4D0C8',
                     -fg => '#000000' 
);

$t->tagConfigure('Normal',       -bg => '#D4D0C8', -fg => 'black');
$t->tagConfigure('DragSelected', -bg => '#EEEE11', -fg => 'black');
#$t->tagConfigure('DarkRed',      -bg => '#881111', -fg => 'black');
#$t->tagConfigure('LightRed',     -bg => '#EE9999', -fg => 'black');
#$t->tagConfigure('DarkGreen',    -bg => '#118888', -fg => 'black');
#$t->tagConfigure('LightGreen',   -bg => '#99EEEE', -fg => 'black');


my $cb_use = $t->Checkbutton( -text => 'nutzen' ); 
my @test_arr = ( 'TEXT', 'ZAHL', '#.## ¤', '#.## ¤ / # ¤', 'PLZ', 'TT.MM.JJJJ', 'TT.MM.JJ' );
my $test_var = $test_arr[0];
my $be_format = $t->JBrowseEntry( -label => '', -variable => \$test_var, -choices => \@test_arr,
                                  -state => 'normal', -font => ['Tahoma', 8], -width => 10 );
my $lbl_hl = $top->Label(-text => "Headline");

$t->windowConfigure("-3,0", -window=>$cb_use); 
$t->windowConfigure("-2,0", -window=>$be_format); 
$t->windowConfigure("-1,0", -window=>$lbl_hl); 

$top->bind( '<B1-Motion>', [ \&dragscroll ] );
sub dragscroll
 {
  my @coords = (($t->pointerx - $t->rootx), ($t->pointery - $t->rooty)); 
  
 }

my ($dnd_t, $ds_t);
$dnd_t = $t->DragDrop( -event => '<B1-Motion>', 
                       -sitetypes => [qw(Local)], 
                       -startcommand =>  sub {
                                              my @coords = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty))); 
                                              if (($coords[0] >= 0) and ($coords[1] >= 0))
                                               {
                                                $t->tagCell('Normal', $drop[0].','.$drop[1]) if (@drop); 
                                                $t->tagCell('Normal', $drag[0].','.$drag[1]) if (@drag); 
                                                @drag = @coords;
                                                $dnd_t->configure( -text => $tm_array->{$drag[0].','.$drag[1]} );
                                                $t->tagCell('DragSelected', $drag[0].','.$drag[1]); 
                                                return 0;
                                               }
                                              else
                                               { return(1); }
                                             } );
$ds_t = $t->DropSite ( -droptypes     => ['Local'], 
                       -dropcommand   => sub { 
                                              @drop = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty)));                                                 
                                              $t->tagCell('Normal', $drag[0].','.$drag[1]); 
                                              $t->tagCell('DragSelected', $drop[0].','.$drop[1]);                
                                              &switch_cells; 
                                             } );


my $btn_dragscroll_left = $top->Button(  -text => chr(0x37), -width => 1, -height => 13, -font => ['Webdings', 7], -relief => 'raised' );  
my $btn_dragscroll_right = $top->Button( -text => chr(0x38), -width => 1, -height => 13, -font => ['Webdings', 7], -relief => 'raised' );  

my $button = $top->Button( -text => 'Exit', -width => 135, -command => sub{ $top->destroy } ); 

$btn_dragscroll_left->place(  -x =>   1, -y => 20 );
$t->place(                    -x =>  20, -y => 20 );
$btn_dragscroll_right->place( -x => 842, -y => 20 );

my $inside_scroll = 0;
$btn_dragscroll_left->bind( '<Enter>', [ sub 
                                          {
                                           $inside_scroll = 1;
                                           $btn_dragscroll_left->configure( -relief => 'sunken' );
                                           while($inside_scroll == 1)
                                            {
                                             $t->xviewScroll(-1, 'units');  
                                             $t->after(100);
                                             $t->update;
                                            }                                            
                                          }
                                       ] );
$btn_dragscroll_left->bind( '<Leave>', [ sub { $inside_scroll = 0; $btn_dragscroll_left->configure( -relief => 'raised' ); } ] );

$btn_dragscroll_right->bind( '<Enter>', [ sub 
                                           {
                                            $inside_scroll = 1;
                                           $btn_dragscroll_right->configure( -relief => 'sunken' );
                                            while($inside_scroll == 1)
                                             {
                                              $t->xviewScroll(1, 'units');  
                                              $t->after(100);
                                              $t->update;
                                             }                                            
                                           }
                                        ] );
$btn_dragscroll_right->bind( '<Leave>', [ sub { $inside_scroll = 0; $btn_dragscroll_right->configure( -relief => 'raised' ); } ] );

$button->place( -x => 20, -y => 260 );

Tk::MainLoop;