KW Perl Mongers Perl Modules: A Look Under the Hood #16

Beer Coasters

        #!/usr/bin/perl -w
        use strict; 
        use GD::Text::Arc;
        use CGI;
        my $boldfont = "Frabk.ttf";
        my $thirdfont = "Forte.ttf";
        my $savedir = ".";
        my $q = new CGI;
        my $name = $q->param('name') || "Anon";
        $name =~ s/\W//g;
        $name .= "'s";
        $name = substr($name,0,10);
        my @param = ("use Perl;", "$name Coaster");
        my $image = &calcImage(@param);
        &drawImage($image);
        #&saveImage($image);
        sub calcImage {
            my @param = @_;
            my $image = GD::Image->new(400,400);
            my $camel = GD::Image->new("./camel.jpg") || die "oops, can't find camel";
            $image->copy($camel,150,150,0,0,90,100);
            my $white = $image->colorAllocate(255,255,255);
            my $red = $image->colorAllocate(128,75,75);
            my $gray =  $image->colorAllocate(75,75,75);
            $image->trueColor();
            my $radius = 120;
            my $centerX;
            my $centerY;
            my $paramNo = 0;
            my $ta = GD::Text::Arc->new($image);
            # general details
            $ta->set('radius', $radius);
            $ta->set('font',   $boldfont);
            $ta->set('center_x', $centerX);
            $ta->set('center_y', $centerY);
            $ta->set('side', 'inside');
            # top line
            $ta->set('colour', $gray);
            $ta->set_font($boldfont, 36);
            $ta->set('text', $param[0]);
            $ta->set('orientation', 'clockwise');
            $ta->draw();
            # bottom line
            $ta->set('color', $red);
            $ta->set_font($thirdfont,36);
            $ta->set('text', $param[1]);
            $ta->set('orientation', 'counterclockwise');
            $ta->draw();
            return $image;
        }
        sub drawImage {
            my $image = shift;
            print $q->header(-type => 'image/jpeg');
            print $image->jpeg;
        }
        sub saveImage {
            my $image = shift;
            my $paramNum = 0;
            my $savefilename;
            $savefilename = "${savedir}/beer-test.jpg";
            # save graphic
            open(my $fileH, ">$savefilename") || die "failed for '$savefilename': $!";
            print $fileH $image->jpeg;
            close($fileH);
        }   

<< Previous | Index | Next >> Copyright © 2004 Daniel Allen