#!/usr/bin/perl -w

# $Id: pixmaped,v 1.82 1999/09/04 13:28:52 root Exp $

# Copyright (c) Mark Summerfield 1999. All Rights Reserved.
# May be used/distributed under the GPL.

# TODO See "TODO.html". 

use strict ;

use Tk ;
use Tk::FileSelect ;
#use Tk::Clipboard ;
use Tk::MesgBox ;
use Tk::ColourChooser ;
use File::Basename ;
use Cwd ;

use FindBin qw( $RealBin ) ;
use lib $RealBin ;


use vars qw( $VERSION $DEBUG
             %Global  %Const  %Opt 
             $Win 
             %Image   %Grid      @ImageGrid
             %Button  $MenuFile  @Undo  %Modules 
         ) ; 

$VERSION = '1.50' ; # Application version.

$DEBUG   = 0 ;

my $DieOnWarn      = 0 ;
my $WarnInDialogue = 0 ;

my $Cursor         = 'left_ptr' ;
my $Waiting        = 0 ;

&initialise ;

MainLoop ;


sub initialise {

    $Win = MainWindow->new() ;
    $Win->title( "Loading  Pixmaped..." ) ; 
    &cursor( 'watch' ) ;
    $Win->protocol( "WM_DELETE_WINDOW", \&file::quit ) ;
    $Win->update ; 
    $Win->CmdLine() ;
    $DEBUG = $ARGV[0] eq '-d' ? 1 : $ARGV[0] eq '-D' ? 2 : 0 if $ARGV[0] ;

    &load_library( "pixmaped-globals.pl" ) ;
    &load_library( "pixmaped-consts.pl" ) ;
    &load_library( "pixmaped-opts.pl" ) ; # Default.
    &read_opts ;                          # User.
    $Opt{SHOW_PROGRESS} = 1 if $DEBUG == 2 ;
    &set_consts ;                         # Need opts to set these.
    &load_library( "pixmaped-menu.pl" ) ;
    &load_library( "pixmaped-button-commands.pl" ) ;
    &load_library( "pixmaped-buttons.pl" ) ;
    &load_library( "pixmaped-grid.pl" ) ;
    &load_library( "pixmaped-grid-commands.pl" ) ;
    &load_library( "pixmaped-keys.pl" ) ;
    &load_library( "pixmaped-file-commands.pl" ) ;
    &load_library( "pixmaped-edit-commands.pl" ) ;
    &load_library( "pixmaped-image-commands.pl" ) ;
    &load_library( "pixmaped-help-commands.pl" ) ;
    &load_library( "pixmaped-resize.pl" ) ;
    &load_library( "pixmaped-shapes.pl" ) ;
    &load_library( "pixmaped-options.pl" ) ;
    &load_library( "pixmaped-xpm.pl" ) ;

    &load_library( "tk-text.pl" ) ;
    &load_library( "misc.pl" ) ;

    # We can't assume the user has GD.pm or Image::Magick.
    $Modules{GD}   = &load_optional_library( 'GD.pm', "pixmaped-gif.pl" ) ;
    $Modules{MIFF} = &load_optional_library( 
                        'Image/Magick.pm', "pixmaped-imagemagick.pl" ) ;

    $Button{WIDGET}{GRAB_COLOUR}->invoke ;
    $Button{WIDGET}{PENCIL}->invoke ;
    &file::new( 1 ) ;
    $Win->packPropagate( 0 ) ;
    &cursor() ;
}


BEGIN {
    $SIG{__WARN__} = sub {
        if( $WarnInDialogue and defined $Win ) {
            &cursor( 'clock' ) ;

            my $msg = $Win->MesgBox(
                            -title => "Pixmaped Error",
                            -text  => $_[0],
                            -icon  => 'ERROR',
                            ) ;
            $msg->Show ;

            &cursor() ;
        }
        else {
            print STDOUT join( "\n", @_ ), "\n" ;
        }
    } ;
}


sub cursor {

    my $cursor = shift ;

    # Watch has highest priority, then all others equally.
    # undef signifies return to previous.
    if( ( not defined $cursor ) or
        ( $cursor eq 'watch' ) or
        ( $Cursor ne 'watch' ) ) {
        if( not defined $cursor and $Cursor eq 'watch' ) {
            --$Waiting ;
            $cursor = $Waiting == 0 ? 'left_ptr' : 'watch' ;
		}
		elsif( defined $cursor and $cursor eq 'watch' ) {
            ++$Waiting ;
		}
        $Cursor = defined $cursor ? $cursor : 'left_ptr' ;
		$Win->configure( -cursor => $Cursor ) 
     }
}


sub message {
    my( $type, $title, $text ) = @_ ;

    if( defined $Win ) {
        my $msg = $Win->MesgBox(
                        -title => "Pixmaped $title $type",
                        -text  => "$text.",
                        -icon  => uc $type,
                        ) ;
        $msg->Show ;
    }
    else {
        print STDOUT "$title $type: $text.\n" ; 
    }
}


sub read_opts {

    return unless -e $Const{OPTS_FILE} ;

    if( open( IN, $Const{OPTS_FILE} ) ) {
        local $_ ;
        while( <IN> ) {
            next if /^#/o or /^\s*$/o ;
            chomp ;
            my( $key, $val ) = /^([^\s:]+)\s*:\s*(.*)/o ;
            $val = $1 if $val =~ /([^#]+)#/o ;
            $val =~ s/\s+$//o ;
            $Opt{uc $key} = $val ;
        }
        close IN ;
        &opts_check ;
    }
    else {
        warn "Failed to read $Const{OPTS_FILE}: $!.\n" ;
    }
}


sub write_opts {

    $Opt{SHOW_PROGRESS} = 0 if $DEBUG == 2 ;

    if( open( OUT, ">$Const{OPTS_FILE}" ) ) {
        local $_ ;
        foreach ( sort keys %Opt ) {
            print OUT "$_: $Opt{$_}\n" ;
        }
        close OUT ;
        $Global{WROTE_OPTS} = 1 ;
    }
    else {
        warn "Failed to write $Const{OPTS_FILE}: $!.\n" ;
    }
}


sub set_consts {
    # No dependencies.
}


sub load_library {
    my $file = shift ;
    
    unless( my $return = do "${file}" ) {
        my $warned = 0 ;
        warn "Failed to parse $file: $@.\n", 
            $warned = 1 if $@ ;
        warn "Failed to do $file: $!\n",     
            $warned = 1 if not $warned and not defined $return ;
        warn "Failed to run $file.\n",       
            $warned = 1 if not $warned and $return ;
        die "Failed to load $file.\n" if $DieOnWarn ;
    }
}


sub load_optional_library {
    my( $libname, $filename ) = @_ ;

    my $fakefilename = $filename ;
    $fakefilename =~ s/\.pl$/-fake.pl/o ;

    my $loaded = 1 ;
    eval {
        require $libname ;
    } ;
    $loaded = 0 if $@ ; 

    if( $loaded ) {
        &load_library( $filename ) ;
    }
    else {
        &load_library( $fakefilename ) ;
    }

    $loaded ;
}


__END__


=pod SCRIPT CATEGORIES

Graphics

=pod DESCRIPTION

Perl/Tk image editor for icons and other small images. 

=pod PREREQUISITES

Pragmas:

C<strict>
C<lib>

Modules:

C<Tk>
C<Tk::FileSelect>
C<Tk::MesgBox>
C<Tk::ColourChooser>
C<File::Basename>
C<Cwd>
C<FindBin>

=pod COREQUISITES

At least one of these is recommended if you want to edit .gif images.
Image::Magick provides maximum versatility.

C<GD>
C<Image::Magick>

=pod OSNAMES

Developed under:
Linux/X-Windows

Known to run under:
Win32

=pod LICENSE

GPL.

=cut
