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

Last change on this file since 19620 was 5498, checked in by mdewsnip, 21 years ago

Fixed up some parameter names.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 13.0 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# flash_button.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# flash_button.pl generates all the flashy javascript type
31# buttons used by Greenstone
32# these are the buttons described in macro files as:
33# top_nav_button
34# nav_bar_button
35# document_button
36
37BEGIN {
38 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
39 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
40}
41
42use Gimp qw/:auto :DEFAULT/;
43use parsargv;
44use util;
45
46# set trace level to watch functions as they are executed
47#Gimp::set_trace(TRACE_ALL);
48#Gimp::set_trace(TRACE_CALL);
49
50my $gsdl_yellow = "#D2B464";
51my $black = "#000000";
52
53my ($cfg_file, $width, $height, $text, $filenamestem, $fixed_width,
54 $width_space, $whitespace, $dont_center, $bgcolor, $fontcolor,
55 $fontsize, $fontfoundry, $fontname, $fontweight, $fontslant, $fontwidth,
56 $fontspacing, $fontregistry, $fontencoding, $image_dir);
57
58sub print_usage {
59 print STDERR "\n usage: $0 [options]\n\n";
60 print STDERR " options:\n";
61 print STDERR " -cfg_file file configuration file containing one or more\n";
62 print STDERR " sets of the following options - use to create\n";
63 print STDERR " batches of images\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 " -width number width of button [65]\n";
67 print STDERR " -height number height of button [30]\n";
68 print STDERR " -text string button text\n";
69 print STDERR " -filenamestem string filename - two images will be produced -\n";
70 print STDERR " filenamestemon.gif and filenamestemof.gif\n";
71 print STDERR " -fixed_width fix width of image - if this isn't set\n";
72 print STDERR " image will be cropped with with width_space\n";
73 print STDERR " space at each side of text\n";
74 print STDERR " -width_space number width in pixels of blank space to leave at left\n";
75 print STDERR " and right edges of text [1]\n";
76 print STDERR " -whitespace add 1 pixel of white space at left and right edges\n";
77 print STDERR " of image\n";
78 print STDERR " -dont_center don't center text horizontally (only applicable if\n";
79 print STDERR " image is fixed width\n";
80 print STDERR " -bgcolor hex_value background color of button [$gsdl_yellow]\n";
81 print STDERR " -fontcolor hex_value text color [$black]\n";
82 print STDERR " -fontsize number font point size [10]\n";
83 print STDERR " -foundry string [*]\n";
84 print STDERR " -fontname string [lucida]\n";
85 print STDERR " -fontweight string [medium]\n";
86 print STDERR " -fontslant [r]\n";
87 print STDERR " -fontwidth [*]\n";
88 print STDERR " -fontspacing [*]\n\n";
89 print STDERR " -fontregistry [*]\n\n";
90 print STDERR " -fontencoding [*]\n\n";
91}
92
93sub reset_options {
94 $image_dir = "./";
95 $width = 65;
96 $height = 30;
97 $text = "";
98 $filenamestem = "";
99 $fixed_width = 0;
100 $width_space = 1;
101 $whitespace = 0;
102 $dont_center = 0;
103 $bgcolor = $gsdl_yellow;
104 $fontcolor = $black;
105 $fontsize = 10;
106 $fontfoundry = "*";
107 $fontname = "lucida";
108 $fontweight = "medium";
109 $fontslant = "r";
110 $fontwidth = "*";
111 $fontspacing = "*";
112 $fontregistry = "*";
113 $fontencoding = "*";
114}
115
116sub gsdl_flash_button {
117
118 if (!parsargv::parse(\@ARGV,
119 'cfg_file/.*/', \$cfg_file,
120 'image_dir/.*/./', \$image_dir,
121 'width/^\d+$/65', \$width,
122 'height/^\d+$/30', \$height,
123 'text/.*/', \$text,
124 'filenamestem/.*', \$filenamestem,
125 'fixed_width', \$fixed_width,
126 'width_space/^\d+$/1', \$width_space,
127 'whitespace', \$whitespace,
128 'dont_center', \$dont_center,
129 "bgcolor/#[0-9A-Fa-f]{6}/$gsdl_yellow", \$bgcolor,
130 "fontcolor/#[0-9A-Fa-f]{6}/$black", \$fontcolor,
131 'fontsize/^\d+$/10', \$fontsize,
132 'foundry/.*/*', \$fontfoundry,
133 'fontname/.*/lucida', \$fontname,
134 'fontweight/.*/medium', \$fontweight,
135 'fontslant/.*/r', \$fontslant,
136 'fontwidth/.*/*', \$fontwidth,
137 'fontspacing/.*/*', \$fontspacing,
138 'fontregistry/.*/*', \$fontregistry,
139 'fontencoding/.*/*', \$fontencoding)) {
140 &print_usage();
141 die "flash_button.pl: incorrect options\n";
142 }
143
144 # will create wherever gimp was started up from if we don't do this
145 if ($image_dir eq "./") {
146 $image_dir = `pwd`;
147 chomp $image_dir;
148 }
149
150 # replace any '\n' occurring in text with carriage return
151 $text =~ s/\\n/\n/gi;
152
153 if ($cfg_file =~ /\w/) {
154
155 open (CONF, $cfg_file) || die "couldn't open cfg_file $cfg_file\n";
156 while (1) {
157
158 &reset_options ();
159
160 # read image configuration entry
161 my $status = &read_config_entry (CONF);
162 if ($filenamestem !~ /\w/) {
163 if ($status) {last;}
164 else {next;}
165 }
166
167 &produce_images (0);
168 if ($status) {last;}
169 }
170
171 close CONF;
172
173 } else {
174
175 &produce_images (0);
176
177 }
178}
179
180sub produce_images {
181 my ($off_img) = @_;
182
183 # create image, set background color etc.
184 my ($image, $backlayer) = &create_image ($off_img);
185
186 # set the text if there is any
187 if (length($text)) {
188
189 my $textlayer = gimp_text ($image, $backlayer, 0, 0, $text, 0, 1,
190 $fontsize, PIXELS, $fontfoundry, $fontname, $fontweight,
191 $fontslant, $fontwidth, $fontspacing, $fontregistry, $fontencoding);
192
193 my $textwidth = gimp_drawable_width($textlayer);
194 my $textheight = gimp_drawable_height($textlayer);
195
196 # check that text fits within image
197 if ($textheight > $height) {
198 die "'$text' at fontsize of $fontsize pixels does not fit within image\n" .
199 "$height pixels high. Decrease fontsize or increase image height\n";
200 }
201
202 my $spacers = $width_space * 2;
203 $spacers += 2 if $whitespace;
204
205 if (!$fixed_width || $textwidth > $width) {
206
207 if ($fixed_width) {
208 print STDERR "WARNING (flash_button.pl): '$text' does not fit within $width pixel fixed width ";
209 print STDERR "image. Image width was increased to ",$textwidth + $spacers, " pixels\n";
210 }
211
212 $width = $textwidth + $spacers;
213
214 # recreate image in new size
215 ($image, $backlayer) = &create_image ($off_img);
216 $textlayer = gimp_text ($image, $backlayer, 0, 0, $text, 0, 1,
217 $fontsize, PIXELS, $fontfoundry, $fontname, $fontweight,
218 $fontslant, $fontwidth, $fontspacing, $fontregistry, $fontencoding);
219
220 }
221
222 my $y_offset = ($height-$textheight)-int($fontsize/5);
223 my $halfdescenders = "";
224
225 # Russian half descenders (KOI8-R)
226 # -- Uncomment if generating Russian images using KOI8-R encoded text --
227 # $halfdescenders .= chr(195) . chr(253); # Checked
228 # $halfdescenders .= chr(196) . chr(198) . chr(221) . chr(227) . chr(228); # Unchecked
229
230 # Kazakh (and Russian) half descenders (Helvetica Kazakh font)
231 # -- Uncomment if generating Kazakh or Russian images using text encoded to match
232 # a Kazakh Helvetica font:
233 # http://www.unesco.kz/ci/projects/greenstone/kazakh_fonts/helv_k.ttf
234 # Mapping for this encoding is: mapping/from_uc/kazakh.ump --
235 # $halfdescenders .= chr(178) . chr(179) . chr(187); # Kazakh specific
236 # $halfdescenders .= chr(196) . chr(214) . chr(217) . chr(228); # Generic Russian
237 # $halfdescenders .= chr(244) . chr(246) . chr(249);
238
239 # -- Uncomment if generating images using a font with half descenders --
240 # if ($text =~ /[$halfdescenders]/) {
241 # half descenders - put text at fontsize/10 pixels above bottom
242 # $y_offset = ($height-$textheight)-int($fontsize/10);
243 # }
244
245 my $descenders = "";
246
247 # Russian descenders (KOI8-R)
248 # -- Uncomment if generating Russian images using KOI8-R encoded text --
249 # $descenders .= chr(210) . chr(213);
250
251 # Kazakh (and Russian) descenders (Helvetica Kazakh font)
252 # -- Uncomment if generating Kazakh or Russian images using text encoded to match
253 # a Kazakh Helvetica font:
254 # http://www.unesco.kz/ci/projects/greenstone/kazakh_fonts/helv_k.ttf
255 # Mapping for this encoding is: mapping/from_uc/kazakh.ump --
256 # $descenders .= chr(189) . chr(190); # Kazakh specific
257 # $descenders .= chr(240) . chr(243); # Generic Russian
258
259 if ($text =~ /[gjpqyJ$descenders]/) { ## capital J is a descender in lucida font
260 # descenders - put text at bottom of image, otherwise
261 # go for fontsize/5 pixels above bottom. This is kind of hacky
262 # and may need some playing with for different fonts/fontsizes
263 $y_offset = $height-$textheight;
264 }
265
266 if ($fixed_width) {
267 if ($dont_center) {
268 # don't center text horizontally (start it width_space pixels from left edge)
269 my $x_offset = $width_space;
270 $x_offset += 1 if $whitespace;
271 gimp_layer_set_offsets ($textlayer, $x_offset, $y_offset);
272 } else {
273 gimp_layer_set_offsets ($textlayer, ($width-$textwidth)/2, $y_offset);
274 }
275 } else {
276 gimp_layer_set_offsets ($textlayer, $spacers / 2, $y_offset);
277 }
278 }
279
280 # add pixel of whitespace to each edge if required
281 if ($whitespace) {
282 gimp_rect_select ($image, 0, 0, 1, $height, 0, 0, 0);
283 gimp_edit_clear ($backlayer);
284 gimp_selection_none ($image);
285 gimp_rect_select ($image, $width-1, 0, 1, $height, 0, 0, 0);
286 gimp_edit_clear ($backlayer);
287 gimp_selection_none ($image);
288 }
289
290 # flatten the image
291 my $finishedlayer = gimp_image_flatten ($image);
292
293 # make indexed colour
294 gimp_convert_indexed ($image, NO_DITHER, MAKE_PALETTE, 256, 0, 1,"");
295
296 # save image
297 my $filename = $filenamestem . "on.gif";
298 $filename = $filenamestem . "of.gif" if $off_img;
299 $filename = &util::filename_cat ($image_dir, $filename);
300
301 gimp_file_save (RUN_NONINTERACTIVE, $image, $finishedlayer, $filename, $filename);
302
303 &produce_images (1) unless $off_img;
304}
305
306sub create_image {
307 my ($off_img) = @_;
308
309 # create the image
310 my $image = gimp_image_new ($width, $height, RGB_IMAGE);
311
312 # background layer
313 my $backlayer = gimp_layer_new ($image, $width, $height, RGB_IMAGE,
314 "BGLayer", 100, NORMAL_MODE);
315
316 # add the background layer
317 gimp_image_add_layer ($image, $backlayer, 0);
318
319 # set colour of background
320 gimp_palette_set_foreground ($bgcolor);
321
322 # clear the background
323 gimp_selection_all ($image);
324 gimp_edit_clear ($backlayer);
325 gimp_selection_none ($image);
326
327 # create the gradient background
328 gimp_blend ($backlayer, 0, NORMAL_MODE, LINEAR, 70, 0, REPEAT_NONE, 0, 0, 0, 5, $height-3, 5, 0);
329
330 # adjust lightness of "off" gif
331 gimp_hue_saturation ($backlayer, 0, 0, 100, 0) if $off_img;
332
333 # set colour of text
334 gimp_palette_set_foreground ($fontcolor);
335
336 return ($image, $backlayer);
337}
338
339# returns 1 if this is the last entry,
340sub read_config_entry {
341 my ($handle) = @_;
342
343 my $line = "";
344 while (defined ($line = <$handle>)) {
345 next unless $line =~ /\w/;
346 my @line = ();
347 if ($line =~ /^\-+/) {return 0;}
348 $line =~ s/^\#.*$//; # remove comments
349 $line =~ s/\cM|\cJ//g; # remove end-of-line characters
350 $line =~ s/^\s+//; # remove initial white space
351 while ($line =~ s/\s*(\"[^\"]*\"|\'[^\']*\'|\S+)\s*//) {
352 if (defined $1) {
353 # remove any enclosing quotes
354 my $entry = $1;
355 $entry =~ s/^([\"\'])(.*)\1$/$2/;
356
357 # substitute any environment variables
358 $entry =~ s/\$(\w+)/$ENV{$1}/g;
359 $entry =~ s/\$\{(\w+)\}/$ENV{$1}/g;
360
361 push (@line, $entry);
362 } else {
363 push (@line, "");
364 }
365 }
366 if (scalar (@line) == 2 && defined ${$line[0]}) {
367 ${$line[0]} = $line[1];
368 }
369 }
370 return 1;
371}
372
373sub query {
374
375 gimp_install_procedure("gsdl_flash_button", "create flashy javascript buttons for gsdl",
376 "", "Stefan Boddie", "Stefan Boddie", "2000-03-10",
377 "<Toolbox>/Xtns/gsdl_flash_button", "*", &PROC_EXTENSION,
378 [[PARAM_INT32, "run_mode", "Interactive, [non-interactive]"]], []);
379}
380
381Gimp::on_net { gsdl_flash_button; };
382exit main;
Note: See TracBrowser for help on using the repository browser.