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

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

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