#!
use strict;
use warnings;
use MIME::Base64;
use Tk::ROText;
use Tk;

#Declarations#
my $VERSION = 1.0;
my ($data,);

#Main#
my $mw = MainWindow->new(-relief => 'raised', -bd => 2,);
$mw->geometry("+35+65"); photoenc_gui($mw); Tk::MainLoop();
1;

#Subroutines#
sub photoenc_gui
{
    #Widget Initialization
    my $e1     = $mw->Entry(-bg => '#ffffff', -fg => '#000000',
                            -selectbackground => '#000000',
                            -selectforeground => '#fff000',
                            -textvariable => \our $file,
                            -width => '80',);
    my $b1_bro = $mw->Button(-activeforeground => '#fff000',
                             -font => 'Script 18 italic',
                             -relief => 'flat', -text => 'Browse',);
    my $b2_enc = $mw->Button(-activeforeground => '#fff000',
                             -font => 'Script 18 italic',
                             -relief => 'flat', -text => 'Encode',);
    my $b3_xit = $mw->Button(-activeforeground => '#fff000',
                             -font => 'Script 18 italic',
                             -relief => 'flat', -text => 'Exit',);
    my $lab1   = $mw->Label(-bd => '4', -font => 'Script 24 bold',
                            -text => 'Tk Photo Encoder',
                            -relief => 'sunken',);
    our $txt1  = $mw->Scrolled('ROText', -scrollbars => 'osoe',
                               -bg => '#ffffff', -fg => '#000000',
                               -selectbackground => '#000000',
                               -selectforeground => '#fff000',
                               -width => 80, -wrap => 'none',);
    
    our $tl1   = $mw->Toplevel(-relief => 'raised', -bd => 2.5,);
                               $tl1->overrideredirect(1);
                               $tl1->resizable(0, 0);
                               $tl1->transient($mw);
                               $tl1->withdraw;
    our $f1_menu1  = $tl1->Frame(-relief => 'sunken',
                                 -borderwidth => '1.5',
                                 -takefocus => '1',);
    my $b1_menu1   = $tl1->Button(-activeforeground => '#fff000',
                                  -relief => 'flat', -anchor => 'w',
                                  -text => 'Copy to Clipboard',);
    my $b2_menu1   = $tl1->Button(-activeforeground => '#fff000',
                                  -relief => 'flat', -anchor => 'w',
                                  -text => 'Save As',);

    #Bindings
    $lab1->bind('<ButtonPress-1>' => sub {
        my $counter = 0;
        while ($counter <= 100) {
            my $a = 'grey'."$counter"; $counter++;
            $lab1->configure(-fg => "$a"); $mw->update; $mw->after(50);
        }$counter--;
        while ($counter >= 0) {
            my $a = 'grey'."$counter"; $counter--;
            $lab1->configure(-fg => "$a"); $mw->update; $mw->after(50);
    }});
    $b1_bro->bind('<ButtonPress-1>' => sub {
        $b1_bro->configure(-relief => 'flat',);
        $b1_bro->configure(-fg => 'cyan');
        $b1_bro->flash; $b1_bro->flash;
        $b1_bro->configure(-fg => '#000000');
    });
    $b2_enc->bind('<ButtonPress-1>' => sub {
        $b2_enc->configure(-relief => 'flat',);
        $b2_enc->configure(-fg => 'green');
        $b2_enc->flash; $b2_enc->flash;
        $b2_enc->configure(-fg => '#000000');
    });
    $b3_xit->bind('<ButtonPress-1>' => sub {
        $b3_xit->configure(-relief => 'flat',);
        $b3_xit->configure(-fg => 'red');
        $b3_xit->flash; $b3_xit->flash;
        $b3_xit->configure(-fg => '#000000');
    });
    $f1_menu1->bind('<FocusOut>'      => sub {$tl1->withdraw;});
    $txt1    ->bind('<ButtonPress-3>' => \&menu1);
    &BindMouseWheel($txt1);

    #Widget configuration
    $b1_bro  ->configure(-command => \&b1_bro_cmd);
    $b2_enc  ->configure(-command => \&b2_enc_cmd);
    $b3_xit  ->configure(-command => sub {exit;});
    $b1_menu1->configure(-command => \&menu_cmd_1);
    $b2_menu1->configure(-command => \&menu_cmd_2);

    #Widget Placement
    $b1_bro->grid(-in     => $mw,       -columnspan => '1',
                  -column => '2',       -rowspan => '1',
                  -row    => '2',       -sticky => 'e');
    $b2_enc->grid(-in     => $mw,       -columnspan => '1',
                  -column => '4',       -rowspan => '1',
                  -row    => '2',       -sticky => 'w');
    $b3_xit->grid(-in     => $mw,       -columnspan => '1',
                  -column => '4',       -rowspan => '1',
                  -row    => '3',       -sticky => 'sw');
    $e1    ->grid(-in     => $mw,       -columnspan => '1',
                  -column => '3',       -rowspan => '1',
                  -row    => '2',       -sticky => 'we');
    $txt1  ->grid(-in     => $mw,       -columnspan => '1',
                  -column => '3',       -rowspan => '1',
                  -row    => '3',       -sticky => 'wsne');
    $lab1  ->grid(-in     => $mw,       -columnspan => '5',
                  -column => '1',       -rowspan => '1',
                  -row    => '1',       -sticky => 'wsne');
    
    $f1_menu1  ->grid(-in     => $tl1,          -columnspan => '1',
                      -column => '1',           -rowspan => '1',
                      -row    => '1',           -sticky => 'news');
    $b1_menu1  ->grid(-in     => $f1_menu1,     -columnspan => '1',
                      -column => '1',           -rowspan => '1',
                      -row    => '1',           -sticky => 'new');
    $b2_menu1  ->grid(-in     => $f1_menu1,     -columnspan => '1',
                      -column => '1',           -rowspan => '1',
                      -row    => '2',           -sticky => 'new');

    #Grid Configuration
    $mw->gridRowconfigure(1,     -minsize => 40,);
    $mw->gridRowconfigure(2,     -minsize => 8,);
    $mw->gridRowconfigure(3,     -minsize => 325, -weight => 1,);
    $mw->gridRowconfigure(4,     -minsize => 16,);
    $mw->gridColumnconfigure(1,  -minsize => 8,);
    $mw->gridColumnconfigure(2,  -minsize => 27,);
    $mw->gridColumnconfigure(3,  -minsize => 8, -weight => 1,);
    $mw->gridColumnconfigure(4,  -minsize => 49,);
    $mw->gridColumnconfigure(5,  -minsize => 8,);
    
    $tl1->gridRowconfigure(1,         -minsize => 8,);
    $tl1->gridColumnconfigure(1,      -minsize => 8,);
    $f1_menu1->gridRowconfigure(1,    -minsize => 8,);
    $f1_menu1->gridRowconfigure(2,    -minsize => 8,);
    $f1_menu1->gridColumnconfigure(1, -minsize => 8,);
    
    #Defaults
    $e1->focus;
    $txt1->menu(undef);

    #Callbacks
    sub b1_bro_cmd #----------------------------------------------------
    {
        my $ofile = $mw->getOpenFile();
        if (defined $ofile) {$file = "$ofile";}
    }
    sub b2_enc_cmd #----------------------------------------------------
    {
        undef $data;
        $mw->Busy(-recurse => 1);
        unless (defined $file)
               {&error('enc1'); goto b2_enc_end;}
        unless (-e $file)
               {&error('enc2'); goto b2_enc_end;}
        $txt1->delete("1.0", 'end');
        
        my     ($bin, $stat,);
        open   (PHOTO, "< $file") or &error('enc3') and goto b2_enc_end; 
        while  ($stat = sysread(PHOTO, $bin, 57 * 17))
               {$data .= encode_base64($bin);}
        close  (PHOTO);
        unless (defined $stat) {&error('enc4'); goto b2_enc_end;}
        
        $txt1->insert('end', $data);
        b2_enc_end: $mw->Unbusy; $txt1->focus;
    }
    sub BindMouseWheel #------------------------------------------------
    {
        my($w) = @_;
        if ($^O eq 'MSWin32') {
            $w->bind('<MouseWheel>'=>[sub{
            $_[0]->yview('scroll', -($_[1]/120)*3,'units')} ,Ev('D')]);
            $w->bind('<ButtonPress-2>' => sub {$w->focus});
        }else{
            $w->bind('<4>' => sub {$_[0]->yview('scroll', -3, 'units')
                                   unless $Tk::strictMotif;});
            $w->bind('<5>' => sub {$_[0]->yview('scroll', +3, 'units')
                                   unless $Tk::strictMotif;});
        }
    }
    sub menu1 #---------------------------------------------------------
    {
        $f1_menu1->focus;
        my ($x, $y) = $mw->pointerxy;  $y -= 40;
        $tl1->geometry('+'."$x".'+'."$y");
        $tl1->deiconify(); $tl1->raise();
    }
    sub menu_cmd_1 #----------------------------------------------------
    {
        $txt1->focus; $txt1->SetCursor('1.0'); $txt1->selectAll;
        $mw->update; $mw->Busy(-recurse => 1);
        
        #my $text = $txt1->getSelected; This line is slow as $#%!     :\
        $mw->clipboardClear; $mw->clipboardAppend($data);
        
        $txt1->delete("1.0", 'end');
        $txt1->insert('end', 'Operation completed.  The data has been '.
                             'copied to the clipboard.');
        $mw->Unbusy; undef $data; undef $file;
    }
    sub menu_cmd_2 #----------------------------------------------------
    {
        $mw->Busy(-recurse => 1);
        my $types = [
                        ['Encoded Files',    '.enc',          ],
                        ['Text Files',       ['.txt', '.text']],
                        ['All Files',        '*',             ],
                    ];
        $file =~ m/(.+)\/(.+)(\..{3,4})/;
        my $ifile = $2;
        my $sfile = $mw->getSaveFile(-title => 'Save As',
                                     -filetypes => $types,
                                     -defaultextension => '.enc',
                                     -initialfile => $ifile,);
        if (defined $sfile) {
            $txt1->focus; $txt1->SetCursor('1.0');
            $txt1->selectAll; $mw->update;
            open(FH, "> $sfile") or &error('menu2_1');
            print FH $data; close FH;
            $mw->clipboardClear; $mw->clipboardAppend($data);
            $txt1->delete("1.0", 'end');
            $txt1->insert('end', "Operation completed.\n\n$file has ".
                          "been encoded,\nand saved as $sfile.\n\n".
                          'The data has been copied to the clipboard.');
            undef $data; undef $file;
        }$mw->Unbusy;
    }
    sub error #---------------------------------------------------------
    {
        my $err = $_[0]; print "\a";
        $txt1->delete("1.0", 'end');
        
        if ($err eq 'enc1') 
            {$txt1->insert('end', "Must choose a file to encode.\n");}
        if ($err eq 'enc2')
            {$txt1->insert('end', "File: $file not found.\n");}
        if ($err eq 'enc3')
            {$txt1->insert('end', "Can't open file: $file\n$!");}
        if ($err eq 'enc4')
            {$txt1->insert('end', "sysread error.\n$!");}
        if ($err eq 'menu2_1')
            {$txt1->insert('end', "Cannot open file.\n$!");}
    }
}

#POD Section#
=head1 NAME

Tk PhotoEncoder

=head1 DESCRIPTION

Useful for storing photos within your pTk application.

=head1 README

Tk PhotoEncoder - GUI-based photo encoder.

=head1 PREREQUISITES

MIME-Base64
Tk

=head1 COREQUISITES

n/a

=head1 History

v1_0 - Initial release.

=head1 Copyright

Tk PhotoEncoder
Copyright (C) 2004 Jason David McManus

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=pod OSNAMES

any?

=pod SCRIPT CATEGORIES

=cut