source: gsdl/trunk/bin/script/gimp/title_icon-1.2.pl@ 19620

Last change on this file since 19620 was 3669, checked in by jrm21, 21 years ago

need to protect variable in s/ in case it has special chars in it (such as

  • . ( [ )
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 13.4 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# title_icon.pl
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 1999 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28# Modified by Rachid Ben Kaddour <[email protected]> for gimp1.2
29
30# title_icon.pl generates all the green_title type icons and
31# collection icons for Greenstone
32
33BEGIN {
34 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
35 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
36}
37
38use Gimp qw/:auto :DEFAULT/;
39use parsargv;
40use util;
41use unicode;
42
43# set trace level to watch functions as they are executed
44#Gimp::set_trace(TRACE_ALL);
45#Gimp::set_trace(TRACE_CALL);
46
47my $gsdl_green = "#96c19b";
48my $black = "#000000";
49
50
51local ($cfg_file, $size, $imagefile, $width, $height, $imageheight, $stripecolor, $stripewidth,
52 $stripe_alignment, $i_transparency, $text, $text_alignment, $filename, $textspace_x,
53 $textspace_y, $bgcolor, $fontcolor, $fontsize, $minfontsize, $foundry, $fontname,
54 $fontweight, $fontslant, $fontwidth, $fontspacing, $fontregistry, $fontencoding, $image_dir, $dont_wrap);
55
56sub print_usage {
57 print STDERR "\n usage: $0 [options] macrofile\n\n";
58 print STDERR " options:\n";
59 print STDERR " -cfg_file file configuration file containing one or more\n";
60 print STDERR " sets of the following options - use to create\n";
61 print STDERR " batches of images\n";
62 print STDERR " -size number the overall size ratio of the image (i.e. a size\n";
63 print STDERR " of 2 will create an image twice the default size)\n";
64 print STDERR " -image_dir directory directory to create images in [`pwd`]\n";
65 print STDERR " this should be full path to existing directory\n";
66 print STDERR " -imagefile filename of image to embed within new icon\n";
67 print STDERR " -width number width of icon [150]\n";
68 print STDERR " -height number height of icon [44]\n";
69 print STDERR " -imageheight number this is the height of the image if the image contains\n";
70 print STDERR " an image (like collection icons) [110]\n";
71 print STDERR " -stripecolor hex_value color of vertical stripe [$gsdl_green]\n";
72 print STDERR " -stripewidth width of vertical stripe [40]\n";
73 print STDERR " -stripe_alignment alignment of vertical stripe (left or right) [left]\n";
74 print STDERR " -i_transparency number transparency of image within icon (0 > transparent > 100) [60]\n";
75 print STDERR " -text string image text\n";
76 print STDERR " -text_alignment alignment of text (left or right) [left]\n";
77 print STDERR " -filename string filename of resulting image\n";
78 print STDERR " -textspace_x number space in pixels between left/right edge of image and\n";
79 print STDERR " left/right edge of text [3]\n";
80 print STDERR " -textspace_y number space in pixels between top of image and top of\n";
81 print STDERR " text [3]\n";
82 print STDERR " -bgcolor hex_value background color of icon [$gsdl_green]\n";
83 print STDERR " -fontcolor hex_value text color [$black]\n";
84 print STDERR " -fontsize number font point size [17]\n";
85 print STDERR " -minfontsize number minimum point size font will be reduced to fit image [10]\n";
86 print STDERR " -foundry string [*]\n";
87 print STDERR " -fontname string [lucida]\n";
88 print STDERR " -fontweight string [medium]\n";
89 print STDERR " -fontslant [r]\n";
90 print STDERR " -fontwidth [*]\n";
91 print STDERR " -fontspacing [*]\n";
92 print STDERR " -fontregistry [*]\n";
93 print STDERR " -fontencoding [*]\n";
94 print STDERR " -dont_wrap don't attempt to wrap text\n\n";
95}
96
97sub reset_options {
98 $image_dir = "./";
99 $imagefile = "";
100 $width = int (150 * $size);
101 $height = int (44 * $size);
102 $imageheight = int (110 * $size);
103 $stripecolor = $gsdl_green;
104 $stripewidth = int (40 * $size);
105 $stripe_alignment = "left";
106 $i_transparency = 60;
107 $text = "";
108 $text_alignment = "left";
109 $filename = "";
110 $textspace_x = int (3 * $size);
111 $textspace_y = int (3 * $size);
112 $bgcolor = $gsdl_green;
113 $fontcolor = $black;
114 $fontsize = int (17 * $size);
115 $minfontsize = int (10 * $size);
116 $foundry = "*";
117 $fontname = "lucida";
118 $fontweight = "medium";
119 $fontslant = "r";
120 $fontwidth = "*";
121 $fontspacing = "*";
122 $fontregistry = "*";
123 $fontencoding = "*";
124}
125
126sub gsdl_title_icon {
127
128 if (!parsargv::parse(\@ARGV,
129 'cfg_file/.*/', \$cfg_file,
130 'size/\d+/1', \$size,
131 'image_dir/.*/./', \$image_dir,
132 'imagefile/.*/', \$imagefile,
133 'width/^\d+$/150', \$width,
134 'height/^\d+$/44', \$height,
135 'imageheight/^\d+$/110', \$imageheight,
136 "stripecolor/#[0-9A-Fa-f]{6}/$gsdl_green", \$stripecolor,
137 'stripewidth/^\d+$/40', \$stripewidth,
138 'stripe_alignment/^(left|right)$/left', \$stripe_alignment,
139 'i_transparency/^\d+$/60', \$i_transparency,
140 'text/.*/', \$text,
141 'text_alignment/^(left|right)$/left', \$text_alignment,
142 'filename/.*', \$filename,
143 'textspace_x/^\d+$/3', \$textspace_x,
144 'textspace_y/^\d+$/3', \$textspace_y,
145 "bgcolor/#[0-9A-Fa-f]{6}/$gsdl_green", \$bgcolor,
146 "fontcolor/#[0-9A-Fa-f]{6}/$black", \$fontcolor,
147 'fontsize/^\d+$/17', \$fontsize,
148 'minfontsize/^\d+$/10', \$minfontsize,
149 'foundry/.*/*', \$foundry,
150 'fontname/.*/lucida', \$fontname,
151 'fontweight/.*/medium', \$fontweight,
152 'fontslant/.*/r', \$fontslant,
153 'fontwidth/.*/*', \$fontwidth,
154 'fontspacing/.*/*', \$fontspacing,
155 'fontregistry/.*/*', \$fontregistry,
156 'fontencoding/.*/*', \$fontencoding,
157 'dont_wrap', \$dont_wrap)) {
158 &print_usage();
159 die "title_icon.pl: incorrect options\n";
160 }
161
162 # will create wherever gimp was started up from if we don't do this
163 if ($image_dir eq "./") {
164 $image_dir = `pwd`;
165 chomp $image_dir;
166 }
167
168 if ($cfg_file =~ /\w/) {
169
170 open (CONF, $cfg_file) || die "couldn't open cfg_file $cfg_file\n";
171 while (1) {
172
173 &reset_options ();
174
175 # read image configuration entry
176 my $status = &read_config_entry (CONF);
177 if ($filename !~ /\w/) {
178 if ($status) {last;}
179 else {next;}
180 }
181
182 &produce_image ();
183 if ($status) {last;}
184 }
185
186 close CONF;
187
188 } else {
189
190 &produce_image ();
191
192 }
193}
194
195sub produce_image {
196
197 &adjust_args ();
198 &wrap_text () unless $dont_wrap;
199
200 my $use_image = 0;
201 if ($imagefile =~ /\w/) {
202 if (!-r $imagefile) {
203 print STDERR "WARNING (title_icon.pl): imagefile '$imagefile cannot be ";
204 print STDERR "read - $filename will be created without the use of an image file\n";
205 } else {
206 $use_image = 1;
207 $height = $imageheight;
208 }
209 }
210
211 # create the image
212 my $image = gimp_image_new ($width, $height, RGB_IMAGE);
213
214 # background layer
215 my $backlayer = gimp_layer_new ($image, $width, $height, RGB_IMAGE,
216 "BGLayer", 100, NORMAL_MODE);
217
218 # add the background layer
219 gimp_image_add_layer ($image, $backlayer, 0);
220
221 # set colour of stripe
222 gimp_palette_set_foreground ($stripecolor);
223
224 # clear the background
225 gimp_selection_all ($image);
226 gimp_edit_clear ($backlayer);
227 gimp_selection_none ($image);
228
229 # fill in stripe
230 if ($stripe_alignment eq "left") {
231 gimp_rect_select ($image, 0, 0, $stripewidth, $height, 0, 0, 0);
232 } else {
233 gimp_rect_select ($image, $width-$stripewidth, 0, $stripewidth, $height, 0, 0, 0);
234 }
235 gimp_bucket_fill ($backlayer, FG_BUCKET_FILL, NORMAL_MODE, 100, 0, 1, 0, 0);
236 gimp_selection_none ($image);
237
238 # get image file (image goes on opposite side to stripe)
239 if ($use_image) {
240 my $rimage = gimp_file_load (RUN_NONINTERACTIVE, $imagefile, $imagefile);
241 my $rdraw = gimp_image_active_drawable ($rimage);
242 gimp_scale ($rdraw, 1, 0, 0, $width-$stripewidth, $height);
243 gimp_edit_copy ($rdraw);
244
245 my $imagelayer = gimp_layer_new ($image, $width, $height, RGB_IMAGE,
246 "ImageLayer", $i_transparency, NORMAL_MODE);
247
248 gimp_image_add_layer ($image, $imagelayer, 0);
249
250 # clear the new layer
251 gimp_selection_all ($image);
252 gimp_edit_clear ($imagelayer);
253 gimp_selection_none ($image);
254
255 my $flayer = gimp_edit_paste ($imagelayer, 1);
256 if ($stripe_alignment eq "left") {
257 gimp_layer_set_offsets($flayer, $stripewidth, 0);
258 gimp_layer_set_offsets($imagelayer, $stripewidth, 0);
259 } else {
260 gimp_layer_set_offsets($flayer, 0, 0);
261 gimp_layer_set_offsets($imagelayer, 0, 0);
262 }
263
264 $backlayer = gimp_image_flatten ($image);
265 }
266
267 # set colour of text
268 gimp_palette_set_foreground ($fontcolor);
269
270 # set the text if there is any
271 my ($textlayer, $textheight, $textwidth);
272 my $fsize = $fontsize;
273 if (length($text)) {
274 $text =~ s/\\n/\n/gi;
275
276 while (1) {
277
278 $textlayer = gimp_text ($image, $backlayer, 0, 0, $text, 0, 1, $fsize,
279 PIXELS, $foundry, $fontname, $fontweight, $fontslant,
280 $fontwidth, $fontspacing, $fontregistry, $fontencoding);
281
282 # check that text fits within image
283 $textwidth = gimp_drawable_width($textlayer);
284 $textheight = gimp_drawable_height($textlayer);
285 if ((($textwidth + $textspace_x) > $width) ||
286 (($textheight + $textspace_y) > $height)) {
287 if ($fsize < $minfontsize) {
288 die "Error (title_icon.pl): text '$text' doesn't fit on ${width}x${height} image " .
289 "(minimum font size tried: $minfontsize\n";
290 } else {
291 gimp_selection_all ($image);
292 gimp_edit_clear ($textlayer);
293 gimp_selection_none ($image);
294 $fsize --;
295 print STDERR "WARNING (title_icon.pl): '$text' doesn't fit: reducing font size to $fsize\n";
296 }
297 } else {
298 last;
299 }
300 }
301
302 # align text
303 if ($text_alignment eq "left") {
304 gimp_layer_set_offsets ($textlayer, $textspace_x, $textspace_y);
305 } else {
306 gimp_layer_set_offsets ($textlayer, ($width-$textwidth)-$textspace_x, $textspace_y);
307 }
308 }
309
310 # flatten the image
311 my $finishedlayer = gimp_image_flatten ($image);
312
313 if ($filename =~ /\.gif$/i) {
314 # make indexed colour (may need to do this for
315 # other formats as well as gif)
316 gimp_convert_indexed ($image, NO_DITHER, MAKE_PALETTE, 256, 0, 1, "");
317 }
318
319 # save image
320 my $filename = &util::filename_cat ($image_dir, $filename);
321 if ($filename =~ /\.jpe?g$/i) {
322 # gimp_file_save doesn't appear to work properly for jpegs
323 file_jpeg_save (RUN_NONINTERACTIVE, $image, $finishedlayer,
324 $filename, $filename, 0.8, 0, 1);
325 } else {
326 gimp_file_save (RUN_NONINTERACTIVE, $image, $finishedlayer,
327 $filename, $filename);
328 }
329}
330
331# returns 1 if this is the last entry,
332sub read_config_entry {
333 my ($handle) = @_;
334
335 my $line = "";
336 while (defined ($line = <$handle>)) {
337 next unless $line =~ /\w/;
338 my @line = ();
339 if ($line =~ /^\-+/) {return 0;}
340 $line =~ s/^\#.*$//; # remove comments
341 $line =~ s/\cM|\cJ//g; # remove end-of-line characters
342 $line =~ s/^\s+//; # remove initial white space
343 while ($line =~ s/\s*(\"[^\"]*\"|\'[^\']*\'|\S+)\s*//) {
344 if (defined $1) {
345 # remove any enclosing quotes
346 my $entry = $1;
347 $entry =~ s/^([\"\'])(.*)\1$/$2/;
348
349 # substitute any environment variables
350 $entry =~ s/\$(\w+)/$ENV{$1}/g;
351 $entry =~ s/\$\{(\w+)\}/$ENV{$1}/g;
352
353 push (@line, $entry);
354 } else {
355 push (@line, "");
356 }
357 }
358 if (scalar (@line) == 2 && defined ${$line[0]}) {
359 ${$line[0]} = $line[1];
360 }
361 }
362 return 1;
363}
364
365# adjust arguments that are effected by the size argument
366sub adjust_args {
367
368 if ($size != 1) {
369 my @size_args = ('width', 'height', 'imageheight', 'stripewidth',
370 'textspace_x', 'textspace_y', 'fontsize', 'minfontsize');
371 foreach $arg (@size_args) {
372 $$arg = int ($$arg * $size);
373 }
374 }
375}
376
377sub wrap_text {
378
379 # don't wrap text if it already contains carriage returns
380 return if $text =~ /\n/;
381
382 # the following assumes that all words are less than $wrap_length long
383 my $wrap_length = 14;
384
385 my $new_text = "";
386 while (length ($text) >= $wrap_length) {
387 my $line = substr ($text, 0, $wrap_length);
388 $text =~ s/^\Q$line\E//;
389 $line =~ s/\s([^\s]*)$/\n/;
390 $text = $1 . $text;
391 $new_text .= $line;
392 }
393 $new_text .= $text;
394 $text = $new_text;
395}
396
397sub query {
398
399 gimp_install_procedure("gsdl_title_icon", "create title icons for gsdl",
400 "", "Stefan Boddie", "Stefan Boddie", "2000-03-10",
401 "<Toolbox>/Xtns/gsdl_title_icon", "*", &PROC_EXTENSION,
402 [[PARAM_INT32, "run_mode", "Interactive, [non-interactive]"]], []);
403}
404
405Gimp::on_net { gsdl_title_icon; };
406exit main;
407
Note: See TracBrowser for help on using the repository browser.