##
##  wml::des::gfont - Graphical Font Tag
##  Copyright (c) 1997-2001 Ralf S. Engelschall, All Rights Reserved. 
##

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

#use wml::std::tags

<protect pass=2>
<:
use Image::Size;

#   global variables for gfont tag
$gfont_cnt     = 0;
@gfont_size    = ( 12, 16, 20, 32, 40, 50, 60, 80, 100, 120, 140, 160);
@gfont_size_CM = qw( F F T T S S L L H H V V V V );

sub read_gfont_info {
    my ($file, $cmd) = @_;
    my $info_cmd;

    $file .= '.cmd';
    return 0 if (! -r $file);

    open (INFO, "< $file");
    $info_cmd = <INFO>;
    close (INFO);
    if ($info_cmd eq $cmd) {
        return 1;
    } else {
        return 0;
    }
}

sub write_gfont_info {
    my ($file, $cmd) = @_;

    $file .= '.cmd';
    open (INFO, "> $file") || return;
    print INFO $cmd;
    close (INFO);
}
:>
</protect>

<define-tag gfont endtag=required whitespace=delete>
<preserve base color bgcolor face size align crop adjust file notag />
<set-var crop=* />
<set-var notag=* />
<set-var %attributes />
<defvar base <or <get-var GFONT_BASE /> <get-var IMAGE_BASE />
                 <get-var WML_SRC_BASENAME /> /> />
<perl>
{
    #   import attributes to ePerl 
    my $base    = '<get-var base />';
    my $color   = '<get-var color />';
    my $bgcolor = '<get-var bgcolor />';
    my $face    = '<get-var face />';
    my $size    = '<get-var size />';
    my $align   = '<get-var align />';
    my $crop    = (qq|<get-var crop />| eq '' ? 1 : 0);
    my $adjust  = '<get-var adjust />';
    my $file    = '<get-var file />';
    my $notag   = (qq|<get-var notag />| eq '' ? 1 : 0);
    my $error, $result, $gfont_cmd;

    my $srcfile = $WML_SRC_BASENAME;

    #   import the tag body
    my $str;
    <perl:assign:sq $str>%body</perl:assign:sq>

    #   create the output filename
    if ($file eq '') {
        if (-d $base && $base !~ m|/$|) {
            $base .= '/' . $srcfile;
        }
        $file = sprintf("%s.gfont%"."03d.gif", $base, $gfont_cnt++);
    }

    #   determine fontface, fontsize and thus fontname
    $face = 'ps:ptmr8r' if ($face eq '');
    $size = 0 if ($size eq '');
    $size = -2 if ($size <= -2);
    $size =  9 if ($size >= 9);
    $size += 2;
    $result = `gfont -q -F $face 2>/dev/null`;
    if ($result eq '') {
        if ($face =~ /^(mf|ps):/) {
            $result = $face;
        } else {
            $result = ($face =~ /^(CM|EC)/ ? "mf:" : "ps:");
        }
    }
    if ($result eq '' && $face !~ /^(mf|ps):/) {
        $result = ($face =~ /^(CM|EC)/ ? "mf:" : "ps:");
    }
    if ($result =~ /^mf:/) {
        $size = $gfont_size_CM[$size+2];
    }
    elsif ($result =~ /^ps:/) {
        $size = $gfont_size[$size];
    }
    #  there is no need to put an ``else'' statement to report this
    #  error. Let's continue and gFONT will return a nice error message
    #  below.

    $font = "-F $face-$size";

    #   determine colors
    if ($bgcolor =~ m|^#([0-9a-fA-F]+)$|) {
        $bgcolor = "-b $1";
    }
    else {
        # default is transparent if -b is missing
        $bgcolor = '';
    }
    if ($color =~ m|^#([0-9a-fA-F]+)$|) {
        $color = "-f $1";
    }
    else {
        # default is black
        $color = '-f 000000'; 
    }
    $align = " align=$align" if ($align ne '');

    #   cropping and size support
    if ($crop) {
        $crop = '-c';
    }
    else {
        $crop = '';
    }
    if ($adjust) {
        $adjust = "-r '$adjust'";
    }
    else {
        $adjust = '';
    }

    #   create GIF image via external gFONT tool
    $gfont_cmd = "gfont -o " . $file . " " . $crop . " " . $adjust
        . " " . $bgcolor . " " . $color . " " .  $font . " '".$str."'";
    if (! &read_gfont_info ($file, $gfont_cmd)) {
        $error = `$gfont_cmd 2\>&1`;
        if ($? >> 8) {
            print STDERR "** wml::des::gfont:\n$error";
            exit(1);
        }
        &write_gfont_info ($file, $gfont_cmd);
    }

    if (not $notag) {
        #   determine image size
        my ($w, $h) = Image::Size::imgsize($file);

        #   insert the replacement HTML markup code
        <perl:print>\
          <img src="$file" alt="$str" width="$w" \
               height="$h" border="0" $align \
               <attributes-quote <attributes-extract :img:(.*) %attributes /> /> \
          />\
        </perl:print>
    }
}
</perl>
<restore  base color bgcolor face size align crop adjust file notag />
</define-tag>

##EOF##
