##
##  wml::des::imgdot - 1pt Dot-Images for Webdesign
##  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 a dot image
sub imgdot {
    my ($base, $x, $y, $c, $r, $g, $b, $transp, $format) = @_;
    my ($file, $im, $col, $data);
    local (*FP);

    if ($base ne '' && $base !~ m|/$|) {
        if (-d $base) {
            $base .= '/';
        }
        else {
            $base .= '.';
        }
    }
    if ($main::DEBUG) {
        # use -DDEBUG=1 for seeing the imgdot's
        $c = 'DEBUG';
        ($r, $g, $b) =  (255, 64, 64);
        $transp = 0;
    }
    $file = "${base}imgdot-${x}x${y}-$c.$format";

    #   create image if it does not still exist
    if (not -f $file) {
        $im = new GD::Image($x, $y);
        $col = $im->colorAllocate($r, $g, $b);
        $im->transparent($col) if $transp;
        eval "\$data = \$im->$format";
        if ($@) {
            warn "Error: wml::des::imgdot: " . $@;
        }
        else {
            open(FP, ">$file");
            print FP $data;
            close(FP);
        }
    }
    return $file;
}
:>
</protect>

<define-tag imgdot whitespace=delete>
<preserve base format width height color align noscale />
<set-var noscale=* />
<set-var %attributes />
<defvar base <or <get-var IMGDOT_BASE /> <get-var IMAGE_BASE /> /> />
<defvar format <or <get-var IMAGE_FORMAT /> gif /> />
<perl>
    #   import attributes to ePerl 
    $base    = qq|<get-var base />|;
    $format  = qq|<downcase <get-var format /> />|;
    $width   = qq|<get-var width />|;
    $height  = qq|<get-var height />|;
    $color   = qq|<get-var color />|;
    $align   = qq|<get-var align />|;
    $noscale = (qq|<get-var noscale />| eq '' ? 1 : 0);

    #   determine parameter values
    $width  = 1 if ($width  eq '');
    $height = 1 if ($height eq '');
    $align = 'bottom' if ($align eq '');
    if ($color eq '') {
        $transp = 1;
        ($r, $g, $b) = (255, 255, 255);
        $c = 'transp-' . &rgb2triple($r, $g, $b);
    }
    elsif ($color =~ s/^-//) {
        $transp = 1;
        ($r, $g, $b) = &triple2rgb($color);
        $c = 'transp-' . &rgb2triple($r, $g, $b);
    }
    else {
        $transp = 0;
        ($r, $g, $b) = &triple2rgb($color);
        $c = &rgb2triple($r, $g, $b);
    }
    $x = ($noscale ? $width  : 1);
    $y = ($noscale ? $height : 1);

    #   create the actual GIF image file
    $file = &imgdot($base, $x, $y, $c, $r, $g, $b, $transp, $format);

    #   insert the corresponding HTML markup code
    <perl:print>\
      <img src="$file" alt="" width=$width height=$height \
           align=$align border=0 \
           <attributes-quote <attributes-extract :img:(.*) %attributes /> /> />
    </perl:print>
</perl>
<restore  base format width height color align noscale />
</define-tag>

##EOF##
