view release on metacpan or  search on metacpan

cgi-bin/app-button  view on Meta::CPAN

#!/usr/bin/perl -wT

#########################################################
# TODO
#########################################################
# o load image from file
# o load image from URL
#########################################################

BEGIN {
    #$ENV{GDFONTPATH} = "/usr/local/fonts";
    #$ENV{DEFAULT_FONTPATH} = "/usr/local/fonts";
}

use CGI;
$cgi = new CGI;

use GD;

#########################################################
# CREATE THE IMAGE
#########################################################
$type = $cgi->param("type");
$type = "png" if (!$type || $type ne "jpeg");

$height = $cgi->param("height");
$height = 19 if (!$height);

$width = $cgi->param("width");
$width = 85 if (!$width);

$im = new GD::Image($width,$height);

#########################################################
# ALLOCATE COLORS ON DEMAND
#########################################################
$numcolors = 0;    # number of colors allocated so far
%colorvalue = (
    "white"   => "#ffffff",
    "black"   => "#000000",
    "red"     => "#ff0000",
    "blue"    => "#0000ff",
    "green"   => "#00ff00",
    "magenta" => "#ff00ff",
    "cyan"    => "#00ffff",
    "yellow"  => "#ffff00",
);
%color = ();
$current_color = undef;  # current color
%hexvalue = (
    '0' => 0, '1' => 1, '2' => 2,  '3' => 3,  '4' => 4,  '5' => 5,  '6' => 6,  '7' => 7,
    '8' => 8, '9' => 9, 'a' => 10, 'b' => 11, 'c' => 12, 'd' => 13, 'e' => 14, 'f' => 15,
);

sub color {
    my ($colortext) = @_;
    my ($color, $r, $g, $b);
    if ($colortext =~ /^#?([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})$/) {  # an RGB triple (i.e. #cc9999)
        $color = $color{$colortext};
        if (! defined $color) {
            $r = lc($1);
            $g = lc($2);
            $b = lc($3);
            $r = $hexvalue{substr($r,0,1)} * 16 + $hexvalue{substr($r,1,1)};
            $g = $hexvalue{substr($g,0,1)} * 16 + $hexvalue{substr($g,1,1)};
            $b = $hexvalue{substr($b,0,1)} * 16 + $hexvalue{substr($b,1,1)};
            $color = $im->colorAllocate($r,$g,$b);
            $color{$colortext} = $color;
            $current_color     = $color;
            $numcolors++;
        }
    }
    elsif ($colortext =~ /^[0-9]+$/) {      # a colormap index (i.e. 0)
        $color = $color{$colortext};
        if (! defined $color) {
            $color = $current_color;
        }
    }
    else {                                  # a color name (i.e. "white")
        $color = $color{$colortext};
        if (! defined $color) {
            if (defined $colorvalue{$colortext}) {
                $color = &color($colorvalue{$colortext});
                $color{$colortext} = $color;

cgi-bin/app-button  view on Meta::CPAN

    if ($selected) {
        $fontsize += 2;
    }
    else {
        $im->line(0              ,$height-1,$width-1      ,$height-1,&color("#ffffff"));  # bottom
        $im->line(0              ,$height-2,$width-1      ,$height-2,&color("#ffffff"));  # bottom
        $im->line(0              ,$height-3,$width-1      ,$height-3,&color("#000000"));  # bottom line
    }

    if (defined $fontname && $fontname ne "" && $fontname ne "builtin") {
        $fontfile = lc($fontname);
        $fontfile .= ".ttf" if ($fontfile !~ /\.ttf$/);
        $fontfile = "/usr/local/fonts/$fontfile";
        @bounds = GD::Image->stringTTF(0,$fontfile,$fontsize,0,1,1,$text);
        if ($#bounds == 7) {
            $stringheight = $bounds[5] - $bounds[3];
            $stringwidth = $bounds[2] - $bounds[0];
            $x = int(($width - $stringwidth)/2);
            $y = int(($height - $stringheight)/2);
            $im->stringTTF(&color($fontcolor),$fontfile,$fontsize,0,$x,$y,$text);
        }
        else {
            $im->string(gdSmallFont,5,5,$@ . ": $fontfile",&color($fontcolor));
        }
    }
    else {
        $fontsize = $#builtin_font if ($fontsize > $#builtin_font);
        $font = $builtin_font[$fontsize];
        $fontheight = $font->height;
        $fontwidth = $font->width;
        $x = int(($width - $fontwidth*length($text))/2);
        $y = int(($height - $fontheight + 1)/2);
        $im->string($font,$x,$y,$text,&color($fontcolor));
    }
}
else {
    $im->rectangle(0,0,99,99,&color("black"));  # Put a black frame around the picture
    $im->arc(50,50,95,75,0,360,&color("blue")); # Draw a blue oval
    $im->fill(50,50,&color("red"));             # And fill it with red
}

binmode STDOUT;   # make sure we are writing to a binary stream

$method = $cgi->request_method();

if ($method) {
    #print $cgi->header(-type=>"image/$type");
    print $cgi->header(-type=>"image/$type", -expires=>'+1d', -Last_modified => 'Sun, 06 Jan 1980 00:00:00 GMT');
}

if ($method ne "HEAD") {
    if ($type eq "jpeg") {
        $quality = $cgi->param("quality");
        $quality = 100 if (!defined $quality || $quality !~ /^[0-9]+$/);
        $quality = 0 if ($quality < 0);
        $quality = 100 if ($quality > 100);
        print $im->jpeg($quality);
    }
    else {
        print $im->png;
    }
}