#!/usr/bin/perl 
# written by zentara (zentara@zentara.net)
# this script is free from any restrictions
# I hope you find it useful
# Feb,8,2004
use warnings;
use strict;
use Tk;
use Tk::Pane;
use Tk::JPEG;
use Tk::HList;
use Tk::ItemStyle;
use Imager;
use Tk::NoteBook;
use File::Basename;
use File::Path;
use File::Copy;
use Storable;
use POSIX qw(strftime);
use YAML;

my %tabs;
my $photo;#my $photo;
my $nb;#my notebook, only 1 is created
my $h; #my HList;
my $key_sel = 'admin'; #current selected $key
my $key_prev = 'admin'; #previous selection starts with admin
my %info;
my $entry; #name box
my $entry1; #comment box
my $colorbut; #IDcolor
my $piclab; #picture label
my $dialog; #toplevel window 
my $dmessage; #dialog message

if(-e 'notebook.db'){
     %info = %{retrieve('notebook.db')};   # direct to hash 
    } 

#to see a dump of the db, just put an 1 as an arg to the script
if(shift){print Dump(\%info);exit;}


#setup tabbed categories and assign each a color
#and listing priority in HoA
#change these to what you want, and their color and order
my %tabColors = (
    Name  => ['bisque', 1],
    Test_Scores   => ['lightyellow', 2],
    Background  => ['azure', 3],
    Classes =>  ['PeachPuff', 4],
    Sports   => ['pink', 5],
    Problems  => ['OldLace', 6],
    Awards  => ['wheat1', 7],
    Other =>  ['khaki', 8],
);

$SIG{__DIE__} = sub {&save_it(); exit};
$SIG{INT} = sub {&save_it(); exit};

my @exts = qw(.jpg .png .gif); # list allowed extensions
if(! -e 'thumbs'){mkdir 'thumbs'; make_thumbs();}
my @thumbs = <thumbs/*.jpg>;
my @thumbnails; #actual thumbnails, @thumbs are the filenames


my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('800x700+100+15');

$mw->bind('<Control-c>', [sub{&save_it(); Tk::exit;}] );

my $topframe = $mw->Frame(-height =>30, -background=>'black')
                            ->pack(-fill=>'both', -expand=>1);

my $leftframe = $mw->Frame( -width =>25, 
                            -background=>'black',
			    )->pack(-side => "left", -anchor => "n",
			             -fill=>'both', -expand=>1);

my $mainframe = $mw->Frame(-background=>'black')
                            ->pack(-side => "right", -anchor => "n",
   	                      -fill=>'both', -expand=>1);

#fill leftframe with thumbnails
HList2();

#fill mainframe with default screen 
setup_pane();

$topframe->Button(-text => "Add New Entry",
                   -bg=>'cyan3',
		   -activebackground =>'cyan',
                   -padx=>40,
		   -relief=>'raised',
		   -command => sub {&new_key})->pack(-side =>'left');
$topframe->Button(-text => "Delete Entry",
                   -bg=>'thistle3',
		   -activebackground =>'thistle1',
                   -padx=>40,
		   -relief=>'raised',
		   -command => sub {&delete_key})->pack(-side =>'right');


$topframe->Button(-text => "Exit",
                   -activebackground =>'snow',                  
                   -padx=>40,
		   -relief=>'raised',
		   -command => sub {&save_it(); exit; })->pack();

#in case you want to play with the Up Down aroow keys in HList
#$mw->focusFollowsMouse;
#$h->bind('<Return>', [sub {&browseThis($h->info('selection') )}] );


MainLoop;

sub HList2 {
    
 $h = $leftframe->Scrolled( 'HList', 
                               -header => 1,
                               -columns => 2,
                               -width => 20,
                               -height => 60,
                               -takefocus => 1,
                               -background => 'steelblue',
			       -foreground =>'snow',
			       -selectmode => 'single',
                               -selectforeground => 'pink',
                               -selectbackground => 'black',
                               -browsecmd => \&browseThis,
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '   THUMBNAIL  ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
			-relief => 'raised');


$h->header('create', 1, -text => '      ID      ',
                        -borderwidth => 3,
                        -headerbackground => 'lightsteelblue',
			-relief => 'raised');


my $font = '-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*';

#sort entries with admin at top and no entry for default
my @list = grep (!/admin/, sort keys %info);
unshift @list,'admin';

foreach (@list){&add_key($_)}

}
                
#############################################################
sub setup_pane{

my $pane = $mainframe->Scrolled('Pane', Name => 'Main Display',
               -width => 1000,
	       -height =>1000,
               -background => 'black',
	       -scrollbars => 'osoe',
               -sticky => 'n',
              )->pack(-side => "left", -anchor => "n",
	              -fill=>'both',-expand=>1);


#default displayed image
my $image = $mw->Photo(-file => $info{'admin'}{'pic'}) or die $!;

$photo = $pane->Label(-image => $image, -background =>'black'
                                         )->pack(-side => 'top',
                                               -anchor => 'n',
                                               -fill => 'both',
					       -expand => 1,
					      );

$photo->bind('<ButtonPress-3>', sub {&update_pic_thumb });

#name entry box
my $f1 = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'both', -expand => 1,);

my $f2 = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'both', -expand => 1,);


$f2->Label(-text=>"Name:",-background => 'black',-foreground => 'green')
                               -> pack(-side => 'left', -anchor => 'n');
$entry = $f2->Entry(-textvariable => \$info{$key_sel}{'name'}, 
                    -width =>30,
                    ) ->pack(-side => 'left', -anchor => 'n');

$entry->configure(-state => 'disabled'); #prevent admin name change


$entry->bind('<Button 1>',[sub {$h->xview(moveto => 1)}]);
$entry->bind('<Return>',[sub {#check for duplicate key
                              if(ref($info{$entry->get}) eq 'HASH')
			            {print chr(07); return}
                              $h->itemConfigure($h->info('selection'), 
                              1, '-text' => $entry->get); 
			      $info{$entry->get} = $info{$key_sel};
			      delete $info{$key_sel};
	                      $key_sel = $entry->get;
			     }]);

#comment entry box
$f2->Label(-text=>" Comment:",-background => 'black',-foreground => 'green')
                              ->pack(-side => 'left', -anchor => 'n');
$entry1 = $f2->Entry(-textvariable => \$info{$key_sel}{'comment'}, -width =>8)
                                   ->pack(-side => 'left', -anchor => 'n');
$entry1->bind('<Return>',[sub {$h->itemConfigure($h->info('selection'), 
                               0, '-text' => $entry1->get); 
			        }]);

#IDcolor select
$f2->Label(-text=>" IDcolor:",-background => 'black',-foreground => 'green')
                              ->pack(-side => 'left', -anchor => 'n');

$colorbut = $f2->Button(-bg => $info{$key_sel}{'color'}, 
                    -textvariable=> \$info{$key_sel}{'color'},
                    -width =>15,
                    -command =>  [sub {&select_color}] 
                                )->pack(-side => 'left', -anchor => 'n');



#picture entry box
$piclab = $f1->Label(-text=> "<-- thumbnails ***  $info{$key_sel}{'pic'}",
                        -width => 30,
                        -background => 'black',
                        -foreground => 'green')
                         -> pack(-side => 'left', -anchor => 'n');
$piclab->configure(-cursor => 'hand2');
$piclab->bind('<Button 1>',[sub {$h->xview(moveto => 0)}]);


$f1->Label(-text=>' Right Click image to change',
                        -width => 30,
                        -background => 'black',
                        -foreground => 'green')
                         -> pack(-side => 'right', -anchor => 'n');


$nb = $pane->NoteBook( -inactivebackground => "lightblue");

 foreach my $tabname (sort{$tabColors{$a}[1] cmp $tabColors{$b}[1]} keys %tabColors){
            my $tab = $nb->add($tabname, 
                    -label=>$tabname, 
                    -raisecmd =>sub{
		        $nb->configure( -bg => $tabColors{$tabname}[0] );
		        $tabs{$tabname}{'textbox'}->focus();
                        $tabs{$tabname}{'textbox'}->see('end');
                                    }, 
	            	     );

      $tabs{$tabname}{'textbox'} = $tab ->Scrolled('Text', 
                                      -scrollbars=>'se',
                                      -bg => $tabColors{$tabname}[0])
			              	 ->pack(-side => 'left',
                                                -anchor => 'n');

    }

#put admin's data in as default
foreach my $tabname(keys %tabs){
$tabs{$tabname}{'textbox'}->insert('end', $info{'admin'}{'nb'}{$tabname}{'textbox'});
}
#sets admin as default selection
$h->selectionSet(0);

$nb->pack(-side => 'bottom', -anchor => 'w',-fill=>'both',expand=>1);

}

############################################################## 
sub browseThis {
   my $ent = shift;
   $key_sel = $h->itemCget($ent, 1, '-text');

if ((ref($dialog) eq "Tk::Toplevel")and($dialog->state eq 'normal')){
        $dialog->withdraw;};


   my $pic = $info{$key_sel}{'pic'} || 'pics/admin.jpg';
   my $image = $mw->Photo(-file => "$pic");
   $photo->configure(-image => $image );

#store previous keys tabs textbox entries
#unless it was deleted
if(defined $info{$key_prev}){
      foreach my $tabname(keys %tabs){
       my $savetxt =  $tabs{$tabname}{'textbox'}->get("1.0","end");
       chomp $savetxt;
       $info{$key_prev}{'nb'}{$tabname}{'textbox'} = $savetxt; 
	      $tabs{$tabname}{'textbox'}->delete("1.0","end");
	      $tabs{$tabname}{'textbox'}->see("1.0");
	}
}

#update name comment and pictures
if($key_sel eq 'admin'){$entry->configure(-state =>'disabled')}
    else{$entry->configure(-state =>'normal')}
$entry->configure(-textvariable => \$info{$key_sel}{'name'});
$entry1->configure(-textvariable => \$info{$key_sel}{'comment'});
$colorbut->configure(-bg => $info{$key_sel}{'color'},
                     -textvariable => \$info{$key_sel}{'color'});

$piclab->configure(-text => "<-- thumbnails ***  $info{$key_sel}{'pic'}");

            
#insert new selection's value  
foreach my $tabname(keys %tabs){
$tabs{$tabname}{'textbox'}->insert('end', $info{$key_sel}{'nb'}{$tabname}{'textbox'});
}

#get current tabname and give it's textbox focus
####################################
my $tab_cur = $nb->raised();
$tabs{$tab_cur}{'textbox'}->focus();
$tabs{$tab_cur}{'textbox'}->see('end');

#setup for next selection
$key_prev = $key_sel;
}

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

sub make_thumbs{

umask 0022;
for('thumbs','backups/thumbs','backups/pics'){ 
  if(! -e $_){mkpath($_) or warn $!}
}

my @pics = <pics/*.jpg pics/*.gif pic/*.png>;
my $image = Imager->new();
foreach my $pic (@pics){    
            my ($basename,$path,$suffix) = fileparse($pic,@exts);
            	    
            $info{$basename}{'name'} = $basename;
	    $info{$basename}{'pic'} = "pics/$basename.jpg"; #convert to jpg
	    $info{$basename}{'thumbnail'} = "thumbs/$basename.jpg";
	    $info{$basename}{'comment'} = 'nice';
                  
      $image->open(file=>$pic) or die $image->errstr();
      rename($pic,"backups/pics/$basename.bak$suffix") or warn $!;

# Create smaller version
         my $thumb = $image->scale(xpixels=>100);
         print "Storing thumbnail as: thumbs/$basename.jpg\n";
         $thumb->write(file=>"thumbs/$basename.jpg", 
                   jpegquality=>30) or die $thumb->errstr;

#Create resized picture
         my $resize = $image->scale(ypixels=>400);
         print "Storing resize as: pics/$basename.jpg\n";
         $resize->write(file=>"pics/$basename.jpg", 
                   jpegquality=>90) or die $resize->errstr;

    }

#get rid of the default keys            
delete $info{'default'};

print "\n#################endofthumbcreation###############################\n";

}
###################################################################
sub save_it{
#store previous keys tabs textbox entries
#unless it was deleted
if(defined $info{$key_prev}){
  foreach my $tabname(keys %tabs){
     my $savetxt = $tabs{$tabname}{'textbox'}->get("1.0","end");
     chomp $savetxt;
     $info{$key_prev}{'nb'}{$tabname}{'textbox'} = $savetxt; 
  }
}

store(\%info,'notebook.db');
my $backup = strftime( 'db-%m_%d_%Y-%H:%M:%S', localtime );
copy ('notebook.db',"backups/$backup") or warn "Couldn't make backup $!\n";
}
#####################################################################

sub update_pic_thumb {

return if $key_sel eq 'admin';

if (! defined $info{$key_sel}{'pic'}){
           $info{$key_sel}{'pic'} = 'pics/default.jpg'; 
}

umask 0022;
for('backups/thumbs','backups/pics'){ 
  if(! -e $_){mkpath($_) or warn $!}
}

$dialog = $mw->Toplevel();
$dialog->overrideredirect(1);
$dialog->geometry('250x150+600+100');
$dialog->configure(-cursor => 'top_left_arrow');
$dmessage = $dialog->Label(-text=>"Status: Ok",
                             -bg=>'pink',
			     -fg=>'black',
			     -width=>180)->pack();

my $df1 = $dialog->Frame(-height =>20)->pack(-fill=>'both',-expand=>1);

my $dlabel = $df1->Label(-text=>"Enter photo Name: pics/????",
                            -bg=>'lightblue',
			        )->pack(-side=>'left',-anchor=>'w');

my $dentry = $dialog->Entry(-width=>150); #need to define before filesel dialog
my $dfilesel = $df1->Button( -text => 'Select',
                         -bg=>'yellow',
                         -activebackground=>'lightyellow',
			 -command => sub{
	                     my @types =( ["Allowed photos", [qw/.jpg .png .gif/]],);
		             my $file = &file_select(@types); 
			     $dentry->delete(0,'end');
			     $dentry->insert(0,$file);
			     $dialog->raise;
			     },
                            )->pack(-side=>'right',-anchor=>'w');

$dentry->pack(-fill =>'both', -expand=>1);

$dentry->insert(0,$info{$key_sel}{'pic'});
$dentry->focus();

my ($dothumb,$dopic) = (0,0);
$dialog->Checkbutton(-text=>'Change pic',
                     -offvalue=> 0,
                     -onvalue=> 1,
                     -variable=>\$dopic,
                    # -command=> sub{&verify-pic})
                     )->pack(-anchor=>'w');

$dialog->Checkbutton(-text=>'Change thumbnail',
                     -offvalue=> 0,
                     -onvalue=> 1,
                     -variable=>\$dothumb,
                     #-command=>sub{&image_change})
                     )->pack(-anchor=>'w');

my $fd = $dialog->Frame()->pack(-fill =>'both', -expand=>1);

$fd->Button( -text => 'Do Change',
              -bg=>'lightgreen',
	      -activebackground=>'green',
              -command => sub{&image_change($dentry->get(),$dothumb,$dopic)}
                    )->pack(-side=>'left');


$fd->Button( -text => 'Cancel',
              -bg=>'orange',
	      -activebackground=>'red',
              -command => sub{$dialog->withdraw},
	            )->pack(-side=>'right');

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

sub image_change{
my ($new,$dothumb,$dopic) = @_;
my ($basename,$path,$suffix) = fileparse($new,@exts);

if( (! -e $new) or 
    (! grep(/$suffix$/,@exts)) 
  )
     {$dmessage->configure(-text=>"Photo not valid!");
      print chr(07);             
      return 0;
 }else{$dmessage->configure(-text=>"Status:Ok")}

my $image = Imager->new();
                
      $image->open(file=>$new) or die $image->errstr();

# Create smaller version
    if($dothumb){   
         my $oldth =$info{$key_sel}{'thumbnail'} || 'thumbs/default.jpg';
         if($oldth ne 'thumbs/default.jpg'){rename $oldth,"backups/$oldth" or warn $!}
	  
         my $thumb = $image->scale(xpixels=>100);
         $thumb->write(file=>"thumbs/$basename.jpg", 
                   jpegquality=>30) or die $thumb->errstr;

         $info{$key_sel}{'thumbnail'} = "thumbs/$basename.jpg";  
         my $newthumb = $mw->Photo(-file => $info{$key_sel}{'thumbnail'});
   
         $h->itemConfigure($h->info('selection'), 
                              0, '-image' => $newthumb); 
     }

#Create resized picture
    if($dopic){    
        my $resize = $image->scale(ypixels=>400);
        $resize->write(file=>"pics/$basename.jpg", 
                   jpegquality=>90) or die $resize->errstr;
      $info{$key_sel}{'pic'} = "pics/$basename.jpg"; 
      my $image = $mw->Photo(-file => $info{$key_sel}{'pic'});
      $photo->configure(-image => $image );
      }
undef $image;
}
}
#########################################################################
sub file_select{
my @types = @_;
my $file = $mw->getOpenFile( -filetypes => \@types );
return($file);
}
########################################################################
sub delete_key{

return if $key_sel eq 'admin';

my $dialogdel = $mw->Toplevel(-bg=>'steelblue');
$dialogdel->overrideredirect(1);
$dialogdel->geometry('200x100+600+100');
$dialogdel->configure(-cursor => 'top_left_arrow');
$dialogdel->Label(-text=>"Ready to delete $key_sel",
                             -bg=>'pink',
			     -fg=>'black',
			     -width=>180)->pack(-side=>'top',-fill=>'x');

my $dlabel = $dialogdel->Label(-text=>"Confirm delete $key_sel?",
                                -bg=>'yellow',
			        )->pack(-side=>'top');

$dialogdel->Button( -text => 'Delete',
              -bg=>'yellow',
              -activebackground=>'orange',
	       -command => sub{my $listnum =$h->info('selection');
	                       $h->delete('entry',$h->info('selection'));
	                       if($h->info('exists', $listnum + 1))
			            {$h->selectionSet($listnum + 1)}
                                     else {$h->selectionSet($listnum - 1)}
			       delete $info{$key_sel};
                               foreach my $tabname(keys %tabs){
                                   $tabs{$tabname}{'textbox'}->delete("1.0","end");
	                           $tabs{$tabname}{'textbox'}->see("1.0");       
			         }
                	       &browseThis($h->info('selection'));
			       $dialogdel->destroy;			                                                                     			    
			    })->pack(-side=>'left',-anchor=>'w');

$dialogdel->Button( -text => 'Cancel',
              -bg=>'red',
              -activebackground=>'plum',
	      -command => sub{$dialogdel->destroy}
	     )->pack(-side=>'right',-anchor=>'e');


}
##############################################################################
sub add_key{

my($key,$color) = @_;

#color is for the IDcolor, defaults to lightsteelblue
if(! defined $info{$key}{'color'}){ $info{$key}{'color'} = 'lightsteelblue'};

my $textstyle  = $h->ItemStyle('text', -justify => 'center',
                                    -bg => $info{$key}{'color'},
                                    -selectforeground => 'green',
                                    );			    

my $e = $h->addchild("",-data => $info{$key}{'pic'});
        
        #needed to prevent HList from silently crashing if no thumbnail
        if(! -e $info{$key}{'thumbnail'}){
        $info{$key}{'thumbnail'} = 'thumbs/default.jpg'}

        my $image = $mw->Photo(-file => $info{$key}{'thumbnail'});

        $h->itemCreate ($e, 0,
           -itemtype => 'imagetext',
           -image => $image,
           -text => $info{$key}{'comment'},
           );

         $h->itemCreate($e, 1,
           -itemtype => 'text',
           -style => $textstyle,
           -text => $info{$key}{'name'},
           );

return $e;
}
#############################################################
sub new_key{

#only allow 1 NEW at a time
if(ref($info{'NEW'}) eq 'HASH'){print chr(07); return} 

my $key = 'NEW';
my $color = 'lightsteelblue';
$info{$key}{'color'} = $color;
$info{$key}{'pic'} = 'pics/default.jpg';
$info{$key}{'thumbnail'} = 'thumbs/default.jpg';
$info{$key}{'name'} = $key;
$info{$key}{'comment'} = '???';


#returns new HList number
my $e = &add_key('NEW',$color);
$h->selectionClear();
$h->selectionSet($e);
$h->see($e);
&browseThis($e);
}

##############################################################
sub select_color{

my $dialogcol = $mw->Toplevel(-bg=>'steelblue');
$dialogcol->overrideredirect(1);
$dialogcol->geometry('+100+100');
$dialogcol->configure(-cursor => 'top_left_arrow');

my @colors = qw(DarkGrey orange pink hotpink red 
                peru goldenrod tan gold wheat  
                lightyellow yellow khaki lightgreen green 
		lightsteelblue turquoise cyan violet plum 
		bisque beige snow);

my ($r,$c)=(0,0);                
foreach my $color(@colors){ 
  $dialogcol->Button( -text =>$color,
              -bg=> $color,
              -width=> 12,
	      -activebackground=>$color,
	       -command => [\&change_col,$color], 
	              )->grid(-column => $c, -row => $r);
$c++;
if($c % 5 == 0){$r++;$c = 0};
}

$dialogcol->Button( -text => 'Finished',
              -bg=>'red',
              -activebackground=>'plum',
	      -command => sub{$dialogcol->destroy;
			      })->grid(-column=>$c, -row=> $r+1);


sub change_col{
      $info{$key_sel}{'color'} = shift;
      $colorbut->configure(-bg=> $info{$key_sel}{'color'});
	       my $textstyle  = $h->ItemStyle('text', 
	                        -justify => 'center',
                                    -bg => $info{$key_sel}{'color'},
                                    -selectforeground => 'green',
                                   );			    
     $h->itemConfigure($h->info('selection'), 1,'-style'=>$textstyle);			    
  }                    
}
###################################################################3