/
logo
139 lines (104 loc) · 3.22 KB
/
logo
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#!/usr/bin/perl -wT
use Imager;
use CGI qw(:standard);
use strict;
# set this the directory you're keeping the font files in
my $fontdir = '../fonts/';
# make sure we get a good font name
my $fontname = param('font');
if (!defined $fontname || $fontname =~ /\W/) {
$fontname = 'arial';
}
my $text = param('text');
my $anim = param('anim');
my $size = param('size') + 0;
$size > 3 or $size=3;
my $bgname = param('bg') || '000000';
my $fgname = param('fg') || 'FFFFFF';
my $border = param('border') || 2;
my $trans = param('trans');
chdir '/tmp'; # bah!
my $font = Imager::Font->new(file=>$fontdir.$fontname.".ttf")
or print STDERR "Cannot open font\n";
print STDERR "Font $fontname\n";
if (!-e $fontdir.$fontname.".ttf") {
print STDERR "Cannot find font\n";
}
my $fg = Imager::Color->new("#$fgname");
my $bg = Imager::Color->new("#$bgname");
if ($trans) {
$bg = Imager::Color->new(($bg->rgba)[0,1,2], 0);
}
my @box = $font->bounding_box(string=>$text, size=>$size, canon=>1);
my $xsize = $box[2]+$border*2;
my $ysize = $box[3]+$border*2;
$|=1;
# we get faster quantization if we build our own palette
# we want 20 steps between fg and bg
my @cols;
my @fg = $fg->rgba;
my @bg = $bg->rgba;
my @steps = map { $bg[$_]-$fg[$_] } 0..2;
push (@cols, $fg, $bg);
for my $grad (1..19) {
push(@cols, Imager::Color->new(map { $fg[$_]+$steps[$_]*$grad/20 } 0..2));
}
if ($anim) {
my @im;
my $steps = int($size / 3) - 2;
my $sz = $size - $steps * 3;
while ($sz <= $size) {
my $im = Imager->new(xsize=>$xsize, ysize=>$ysize, channels=>$trans?4:3);
$im->box(filled=>1, color=>$bg);
my @sbox = $font->bounding_box(string=>$text, size=>$sz, canon=>1);
my $x = ($xsize-$sbox[2])/2 - $sbox[0];
my $y = ($ysize+$sbox[3])/2 + $sbox[1];
$im->string(font=>$font, text=>$text, x=>$x,
y=>$y, size=>$sz, color=>$fg, aa=>1);
push @im, $im;
$sz += 3;
}
print "Content-Type: image/gif\n\n";
Imager->write_multi({type=>'gif',
transp=>$trans?'threshold':'none',
make_colors=>'none',
colors=>\@cols,
fd=>fileno(STDOUT),
gif_disposal=>[(2) x @im],
gif_delays=>[(10) x @im ]}, @im);
}
else {
my $im = Imager->new(xsize=>$xsize, ysize=>$ysize,
channels => $trans?4:3);
$im->box(filled=>1, color=>$bg);
$im->string(font=>$font, text=>$text, x=>-$box[0]+$border,
y=>$box[3]+$box[1]+$border, size=>$size, color=>$fg, aa=>1);
print "Content-Type: image/gif\n\n";
$im->write(fd=>fileno(STDOUT), type=>'gif',
transp=>$trans?'threshold':'none', gifquant=>'gen');
}
__END__
=head1 NAME
logo - generates a simple logo using Imager
=head1 SYNOPSIS
(run as a CGI script)
=head1 DESCRIPTION
Given a font and number of parameters, described below, I<logo> draws
text to an image and writes that result as a GIF to STDOUT, with the
required CGI headers.
The parameters that logo takes are:
=over
=item font
the basename of the font file to be used in drawing the text
=item text
the text to draw
=item size
the height in pixels to draw the text
=item anim
if this is non-zero the text is animated, from a very small size to
the size specified by I<size>
=item bg
the background color of the image. Used as the combining color if
transparent.
=back
=cut