##
##  wml::des::imgbg - Background Images
##  Copyright (c) 1997-2001 Ralf S. Engelschall, All Rights Reserved. 
##  Copyright (c) 2000-2001 Denis Barbier
##

#  The <preserve>/<restore> tags with multiple arguments require WML 2.0.3
#use wml::mod::version
<require 2.0.3 />

#use wml::std::tags
#use wml::sup::hextriple

<protect pass=2>
<:
use GD;

#   general function for creating the image
sub imgbg {
    my ($base, $direction, $content, $pixels, $format) = @_;;
    my ($file, $id, @C, $size, $im, $c, $r, $g, $b, $col, $w, $x);
    my ($nbcol, $bcol, $ecol, $rmin, $gmin, $bmin, $rmax, $gmax, $bmax);
    my ($i, $dx, $dy, $data);
    local (*FP);

    #   determine filename
    $id = "$direction-$pixels-$content";
    $id =~ s|[,:]|-|g;
    $id =~ s|#||g;
    $file = "${base}imgbg-$id.$format";

    #   create content list
    if ($content !~ m|,|) {
        @C = ($content);
    }
    else {
        @C = split(/,/, $content);
    }

    #   determine size
    $size = 0;
    foreach $c (@C) {
        $size += $1 if ($c =~ m|^(\d+):.+|);
    }

    #   create GIF image if still not exist
    if (not -f $file) {
        $x = 0;
        if ($direction eq 'h') {
            #   horizontal image
            $im = new GD::Image($size, $pixels);
            $dx = 1;
            $dy = 0;
        } else {
            #   vertical image
            $im = new GD::Image($pixels, $size);
            $dx = 0;
            $dy = 1;
        }
        foreach $c (@C) {
            ($w, $bcol, $ecol, $nbcol) =
                ($c =~ m|^(\d+):([^:]+)(?::)?([^:]+)?(?::)?(\d+)?$|);
            if ($ecol eq '' ) {
                ($ecol, $nbcol) = ($bcol, 1);
            } elsif ($nbcol eq '' ) {
                $nbcol = 10;
            }
            ($rmin, $gmin, $bmin) = &triple2rgb($bcol);
            ($rmax, $gmax, $bmax) = &triple2rgb($ecol);
            for ($i=1; $i<=$nbcol; $i++) {
                $r = $rmin + ($rmax-$rmin)*$i/$nbcol;
                $g = $gmin + ($gmax-$gmin)*$i/$nbcol;
                $b = $bmin + ($bmax-$bmin)*$i/$nbcol;
                $col = $im->colorAllocate($r, $g, $b);
                if ($pixels == 1) {
                    $im->line($dx*($x+$w*($i-1)/$nbcol),
                          $dy*($x+$w*($i-1)/$nbcol),
                          $dx*($x+$w*$i/$nbcol),
                          $dy*($x+$w*$i/$nbcol),
                          $col);
                }
                else {
                    $im->filledRectangle($dx*($x+$w*($i-1)/$nbcol),
                          $dy*($x+$w*($i-1)/$nbcol),
                          ($dx == 0 ? $pixels : $dx*($x+$w*$i/$nbcol)),
                          ($dy == 0 ? $pixels : $dy*($x+$w*$i/$nbcol)),
                          $col);
                }
            }
            $x += $w;
        }
        eval "\$data = \$im->$format";
        if ($@) {
            warn "Error: wml::des::imgbg: " . $@;
        }
        else {
            open(FP, ">$file");
            print FP $data;
            close(FP);
        }
    }
    return $file;
}
:>
</protect>

<define-tag imgbg whitespace=delete>
<preserve base format direction content pixels />
<set-var %attributes />
<defvar base <or <get-var BGIMG_BASE /> <get-var IMAGE_BASE /> /> />
<defvar format <or <get-var IMAGE_FORMAT /> gif /> />
<defvar pixels 1 />
<perl>
    #   import attributes to ePerl 
    $base      = qq|<get-var base />|;
    $direction = qq|<get-var direction />|;
    $content   = qq|<get-var content />|;
    $format    = qq|<downcase <get-var format /> />|;
    $pixels    = qq|<get-var pixels />|;

    #   determine parameter values
    if ($base ne '' && $base !~ m|/$|) {
        if (-d $base) {
            $base .= '/';
        }
        else {
            $base .= '.';
        }
    }
    $direction = 'h' if ($direction eq '');
    $content = '100:#000000,900:#ffffff' if ($content eq '');

    #   create the actual GIF image file
    $file = &imgbg($base, $direction, $content, $pixels, $format);

    #   insert the corresponding filename
    <perl:print: $file />
</perl>
<restore  base format direction content pixels />
</define-tag>

##EOF##
