# Copyright (C) 2000-2002, Free Software Foundation FSF.

package PPresenter::Images;

use strict;
use PPresenter::Object;
use PPresenter::Image;

use base 'PPresenter::Object';

use constant ObjDefaults =>
{ -name      => 'image registry'
, -imageDirs => undef
, show       => undef
, tmpdir     => undef
, images     => []
};

sub InitObject()
{   my $self = shift;
    $self->SUPER::InitObject;

    $self->addImageDir('.', 'PPresenter/images');

    my $tmp = $self->{tmpdir} || undef;

    unless($tmp)
    {   $tmp = defined $ENV{TMPDIR} ? "$ENV{TMPDIR}/gpp.$$"
             : -d '/tmp' ? "/tmp/gpp.$$"
             : "scaled.$$";
        $self->{tmpdir} = $tmp;
    }
    
    ! -d $tmp && mkdir $tmp, 0700
        or die "Couldn't create $tmp for scaled images.\n";
    
    eval "END {\$self->cleanup_imagedir('$tmp')}";
        
    $self;
}

sub cleanup_imagedir($)
{   my ($self, $dir) = @_;

    print PPresenter::TRACE "Removing scaled images in $dir.\n";

    $self->{show}->remove_dir($dir);
}

sub findImageFile($)
{   my ($self, $filename) = @_;

    foreach (@{$self->{imageDirs}})
    {   return "$_/$filename" if -f "$_/$filename";
    }

    return undef;
}

sub addImageDir(@)
{   my $self = shift;

    foreach my $dir (@_)
    {   if($dir =~ m[^/])
        {   unshift @{$self->{imageDirs}}, $dir;
            next;
        }

        my @add = map { -d "$_/$dir" ? "$_/$dir" : () } @INC;
        warn "Image directory `$dir' not found.\n" if $^W && @add==0;
        push @{$self->{imageDirs}}, @add;
    }

    $self;
}

sub image(@)             # user calls $show->image(...)
{   my $self = shift;

    return unless @_;
    my $obj = $_[0];

    return $self->createImage(@_) unless ref $obj;
    return $obj                   if $obj->isa('PPresenter::Image');

    push @_, show => $self->{show};

    if($obj->isa('Tk::Photo'))
    {   require PPresenter::Image::tkPhoto;
        my $img = PPresenter::Image::tkPhoto->convert(@_);

        warn "Two images named $img.\n"
           if $^W && $self->findImage($img);

        push @{$self->{images}}, $img;
        return $img;
    }

    if($obj->isa('Image::Magick'))
    {   require PPresenter::Image::Magick;
        my @imgs = PPresenter::Image::Magick->convert(@_);
        foreach (@imgs)
        {   warn "Image $_ redefined.  Use -name to diverse them.\n"
                if $self->findImage($_);
        }
        push @{$self->{images}}, @imgs;
        return @imgs;
    }

    warn "What do you try to feed me? A ",ref $obj," is not an image, is it?\n";
    return;
}

sub createImage(@)
{   my $self = shift;
    my $show = $self->{show};

    my %options = ( @_
    , show     => $show
    );

    my $source = $options{-file};
    unless(defined $source)
    {   warn "No image file or image name specified.\n";
        return;
    }

    my $img = $self->findImage($source);
    return $img if $img;

    $source = $self->findImageFile($source)
        unless $source =~ m[^/];

    unless(defined $source)
    {   warn "Cannot find image file $options{-file}.\n";
        return;
    }

    unless(-r $source)
    {   warn "Cannot read image file $source.\n";
        return;
    }

    @options{'dev', 'ino'} = (stat $source)[0,1];
    $options{source}       = $source;

    foreach (@{$self->{images}})
    {   return $_ if $_->sameSource(\%options);
    }

    print PPresenter::TRACE "Defining new image $source.\n";

    if($show->hasImageMagick)
    {   require PPresenter::Image::Magick;
        $img = PPresenter::Image::Magick->new(%options);
    }
    else
    {   require PPresenter::Image::tkPhoto;
        $img = PPresenter::Image::tkPhoto->new(%options);
    }

    return unless $img;

    push @{$self->{images}}, $img;
    $img;
}

sub findImage($) {PPresenter::Image->fromList(shift->{images}, shift)}

1;