#!/usr/bin/perl
use warnings;
use strict;
use Tk;

# the left side canvas

#####  play with this number 1000 to add or reduce canvas size ###################

my @chs = (0..1000);  # ascending order
my $num_channels = scalar @chs;

my $mw =  new MainWindow();
$mw->geometry("600x400+200+200");

$mw->fontCreate('big',
   -family=>'arial',
  -weight=>'bold',
  -size=>int(-18*18/14));

$mw->fontCreate('medium',
   -family=>'arial',
   -weight=>'bold',
   -size=>int(-12*12/10));

$mw->fontCreate('small',
   -family=>'arial',
   -weight=>'normal',
   -size=>int(-10*10/10));


my $topframe = $mw->Frame(-bg=>'grey45')->pack();
my $infolab = $topframe->Label(-text =>'Some Info',
                               -bg=>'grey45',
                               -fg=>'lightgreen',
                                )->pack();

my $midframe = $mw->Frame(-bg=>'grey45')->pack();
my $midframel = $midframe->Frame(-bg=>'grey45')
                   ->pack(-side=>'left',-expand=>1,-fill=>'y');
my $midframer = $midframe->Frame(-bg=>'grey45')
                   ->pack(-side=>'right');

my $botframe = $mw->Frame(-bg=>'grey45')->pack();

my $canvast = $midframer->Scrolled('Canvas',
             -bg =>'lightyellow',
             -width=>2400,
             -height=>25,
	     -scrollregion=>[-10,0,7250,25],
	     -scrollbars =>'e',
	     -xscrollincrement => 1,
	     ) ->pack(-side=>'top');

my $canvasp = $midframer->Scrolled('Canvas',
             -bg =>'lightsteelblue',
             -width=>2400,
             -height=> 50 * $num_channels,
             -scrollregion=>[-10,0,7250,(50 * $num_channels)],
             -scrollbars=>'se',
	     -xscrollincrement => 1,
	     -yscrollincrement => 1,
	     ) ->pack(-side=>'bottom',-fill=>'both');

#need real canvas for binding
my $realcan = $canvasp->Subwidget("scrolled");

my $canvasd = $midframel->Canvas(
             -bg =>'grey45',
             -width=>75,
             -height=>25,
	     ) ->pack(-side=>'top');

my $canvass = $midframel->Scrolled('Canvas',
             -bg =>'lightsteelblue',
             -width=>75,
             -height=> 50 * $num_channels,
             -scrollregion=>[0,0,75,(50 * $num_channels)],
             -scrollbars =>'s',
	     -yscrollincrement => 1,
	     ) ->pack(-side=>'top');


my $xscroll = $canvasp->Subwidget("xscrollbar");
my $yscroll = $canvasp->Subwidget("yscrollbar");
$xscroll->configure(-troughcolor =>'grey45',
                    -activebackground =>'lightseagreen',
		    -background =>'lightseagreen',
		    -command => \&xscrollit,
		    );
$yscroll->configure(-troughcolor =>'grey45',
                    -activebackground =>'lightseagreen',
		    -background => 'lightseagreen',
		    -command => \&yscrollit,
		    );

#hidden and disabled scrollbars
my $xscroll1 = $canvass->Subwidget("xscrollbar");
my $yscroll1 = $canvast->Subwidget("yscrollbar");
$xscroll1->configure(-troughcolor =>'grey45',
                    -activebackground =>'grey45',
		    -background =>'grey45',
		    -highlightcolor =>'grey45',
		    -highlightbackground => 'grey45',
		    -elementborderwidth => 0,
		    -relief => 'flat',
		    );

$yscroll1->configure(-troughcolor =>'grey45',
                    -activebackground =>'grey45',
		    -background =>'grey45',
		    -highlightcolor =>'grey45',
		    -highlightbackground => 'grey45',
		    -elementborderwidth => 0,
		    -relief => 'flat',
		    );

##############################################################

#create timebar and markers

for(0..24000){
  if( $_ % 100 == 0){
      $canvast->createLine($_,0,$_,10);
      $canvast->createText($_,20,-text=>$_);
      next;
   }
}

=head
for(0..7200){
       
      if( $_ % 300 == 0){
         my $time =  $_ / 300;
         my $padded = ("0" x (2-length( $time ))).$time;
         $canvast->createLine($_,0,$_,12,-width=> 4 );
         $canvast->createText($_, 20, -text=> "$padded:00" );
 
      }elsif( $_ % 150 == 0){
          my $time =  ($_ - 150) / 300;
          my $padded = ("0" x (2-length( $time ))).$time;
         
         $canvast->createLine($_,0,$_,10,-width => 2);
         $canvast->createText($_, 20, -text=> "$padded:30" );
      
      }elsif( $_ % 75 == 0){
         $canvast->createLine($_,0,$_,6,-width => 1);
         
      }      
 
}
=cut

#--create left side station boxes---------------------------------
#need to store y pixel locations to fill in data in an orderly manner
my %slots;  #used to hold locations for main data positions

foreach my $slotnum (0 .. $num_channels){
   my $ch = shift @chs;

   $slots{$slotnum}{'channel'} = $ch;
   $slots{$slotnum}{'top'} =  2 + $slotnum * 50;
   $slots{$slotnum}{'bottom'} = 48 + $slotnum * 50;
   $slots{$slotnum}{'toptext'} = 15 + $slotnum * 50;
   $slots{$slotnum}{'midtext'} = 30 + $slotnum * 50;
   $slots{$slotnum}{'bottext'} = 45 + $slotnum * 50;

   $canvass->createRectangle(0, 2 + $slotnum * 50, 75, 48 + $slotnum * 50 ,
              -fill =>'#f4dae4',
            );
   
   $canvass->createText(38, 15 + $slotnum * 50,
              -text => $ch ,
              -font => 'big',
	    );
  
   $canvass->createText(38, 35 + $slotnum * 50,
              -text => $ch ,
              -font => 'medium',
	      -fill => 'blue'
	    );
}

#########################################
# now fill in some data
 
foreach my $slotnum (0 .. $num_channels){
    
    for(0..24000){
         if( $_ % 100 == 0){
             
        # actually you should do a bbox of the text below
        # to find the rect boundaries, but I cheat here
        # and hardwire in a 60 pixel width 
        my $rect = $canvasp->createRectangle($_- 30 ,$slots{$slotnum}{'top'} - 2,
                                      $_+ 30 ,$slots{$slotnum}{'bottom'} - 2,
              -fill =>'#dddddd',
              -tags => ['rect',$_,$slotnum],
            );
             
         my $text = $canvasp->createText( $_, $slots{$slotnum}{'midtext'},
                  -text=>  $slotnum.'-'.$_,
                  -tags => ['text',$_,$slotnum]
                  );
             next;
          
          }
     }

}

# add some bindings
$realcan->bind("rect", "<Enter>", 
         sub { $realcan->itemconfigure("current", -fill => '#ffffff'); });
# When the mouse is not over, color it grey.
$realcan->bind("rect", "<Leave>",
         sub { $realcan->itemconfigure("current", -fill => '#dddddd'); });

#get info on left mouse click
$realcan->bind('rect',"<1>",sub {  
     my $item = $realcan->find('withtag','current');
     my (@tags) = $realcan->gettags($item);
     print join '-',@tags,"\n";
});

MainLoop;

#########
sub xscrollit{
 my $fraction = $_[1];
 $canvast->xviewMoveto($fraction);
 $canvasp->xviewMoveto($fraction);
}
########################################
sub yscrollit{
  my $fraction = $_[1];
  $canvass->yviewMoveto($fraction);
  $canvasp->yviewMoveto($fraction);

}