#!/usr/bin/perl -w
use warnings;
use strict;
use Tk;
use Tk::NoteBook;
require Tk::Pane;
use Tk::LabEntry;

my ($dx,$dy);
my $mw = MainWindow->new;
$mw->geometry( "600x500");
$mw->title("My New Game");

#

###program parameter hash
my %tools = ( 'program1' => 
     { 'PARM1' => 1, 'PARM2' => 'n', 
      'PARM3' => 'y', 'PARM4' => 'n', 
      'PARM5' => 'y', 'PARM6' => 'n', 
      'PARM7' => 'y', 'PARM8' => 'n', 
      'PARM9' => 'y', 'PARM10' => 'n' }, 
      
      'program2' => { 'PARM1' => 1, 'PARM2' => 2, 
      'PARM3' => 3, 'PARM4' => 4, 'PARM5' => 5, 
      'PARM6' => 6, 'PARM7' => 7, 'PARM8' => 8, 
      'PARM9' => 9, 'PARM10' => 10 });

my $tframe = $mw->Frame->pack(-fill=>'both');
my $mframe = $mw->Frame->pack(-expand=>1,-fill=>'both');

$tframe->Label(-text=>'My Game')->pack();
                                                                                                                            
## create notebook
my $book = $mframe->NoteBook( -dynamicgeometry=>0)
              ->pack(-expand=>1,-fill=>'both');

#####program1#######
my $tab_cnt=1;

my %panes;

for my $tab (keys %tools){	   
  	##create tab,scroll pane,frames
  	my $tab_tab = $book->add("Game $tab_cnt", 
  	 -raisecmd=> sub{
  	#   $tab_spane->configure( -scrollregion => [0,0,$book->reqwidth,$book->reqheight]);
  	   $mw->update},
  	   -label => "$tab"); #->pack(-expand=>1,-fill=>'both');
  	# packing a page add causes a weird error

  	my $tab_spane = $tab_tab->Scrolled('Pane',
  	 -background=>'slate grey',
  	 -scrollbars => 'osoe',
  	 )->pack(-expand=>1, -fill=>'both');
  	 
  	 
  	my $tab_frame1=$tab_spane->Frame(
  	-background=>'blue')->pack(-side=>'left',-expand=>1,-fill=>'both',-padx=>15);
  	my $tab_frame2=$tab_spane->Frame(
  	-background=>'red')->pack(-side=>'bottom',-anchor=>'s',-fill=>'x');
	$tab_cnt++;

       #create columns
       my $tab_column1 = $tab_frame1->Frame()->pack(-side=>'left',-expand=>1,-fill=>'both');
       my $tab_column2 = $tab_frame2->Frame()->pack(-side=>'right',-expand=>1,-fill=>'both');      
	
       ##now fill frames
       my $parm_cnt=1;
	print "Processing tool: $tab\n";

  	foreach my $parm (custom_sort(\%{$tools{$tab}})) {

		 print " $parm = $tools{$tab}{$parm}\n";
    		 if ($parm_cnt < 6 ){
													
     	 	 my $tab_test=$tab_column1->LabEntry(-label => "$parm=");
		 $tab_test->Subwidget('entry')->configure(-textvariable => \$tools{$tab}{$parm} );
		 $tab_test->configure(-labelPack=>[-side=>'left']);
               $tab_test->pack(-anchor=>'e');

		 } else {

     	 	 my $tab_test=$tab_column2->LabEntry(-label => "$parm=");
		 $tab_test->Subwidget('entry')->configure(-textvariable => \$tools{$tab}{$parm} );
		 $tab_test->configure(-labelPack=>[-side=>'left']);
               $tab_test->pack(-anchor=>'e');
  
     	 	 }
	     $parm_cnt++;
            }   

#######run button#############
my $run = $tab_tab->Button(
    -text => "\n  Run $tab       \n ", 
    -command => [\&run, $tab],
    -background=>'slate grey')->pack;
} # end of page creation loop


# now add your canvas which will host the actual game
my $game_tab = $book->add("Game Canvas", 
  	 -raisecmd=> sub{
 	   $mw->update},
          -label => " Actual Game Canvas "); 


 
# make the actual Canvas
my $scan =  $game_tab->Scrolled('Canvas', -bg => 'black')->pack(-expand=>1, -fill=>'both');
# get the real canvas of the scrolled widget
my $realcan = $scan->Subwidget('scrolled');

$realcan->bind('move', '<1>', sub {&mobileStart();});
$realcan->bind('move', '<B1-Motion>', sub {&mobileMove();});
$realcan->bind('move', '<ButtonRelease>', sub {&mobileStop();});




MainLoop;

####################### subs #################################


sub run {
  print "@_\n";
  my $program = shift;

# clear out any old game data by tag
$scan->delete('move');

# switch to Game tab
  $book->raise( 'Game Canvas');

# I have the proper dereferencing here,
# to show you how it would work
my $y = 10; #starting print point

foreach my $parm (custom_sort(\%{$tools{$program}})) {

  print " $parm = $tools{$program}{$parm}\n";
   
 $scan->createText(50,$y,
    -text   => "$parm @ $tools{$program}{$parm}",
    -fill =>'yellow',
    -anchor => 'nw',
    -font   => 'big',
    -tags=> ['move']
    );

 $y +=50;

  }

# set scroll region for canvas
$scan->configure(-scrollregion=>[$scan->bbox("all")]);

}



sub custom_sort {
  my $hash = shift;
  return
      map { $_->[0] }
      sort {
          $a->[1] cmp $b->[1]
                  ||
          $a->[2] <=> $b->[2]}
      map { [ $_, /(\w+)(\d+)$/ ] }
      keys %$hash;
}




sub mobileStart {
      my $ev = $realcan->XEvent;
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      $realcan->raise('current');
      print "START MOVE->  $dx  $dy\n";
}

sub mobileMove {
      my $ev = $realcan->XEvent;
      $realcan->move('current', $ev->x + $dx, $ev->y +$dy);
      ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
      print "MOVING->  $dx  $dy\n";
}

sub mobileStop{&mobileMove;}