File: cvtbdf.pl

package info (click to toggle)
libgd-perl 2.53-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 1,028 kB
  • ctags: 191
  • sloc: perl: 3,002; makefile: 44
file content (206 lines) | stat: -rwxr-xr-x 7,264 bytes parent folder | download | duplicates (11)
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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
#!/usr/local/bin/perl
# Filename     - cvtbdf.pl
# Author       - Geoff Baysinger (gbaysing@HiWAAY.net)
# Purpose      - Allows "simple" installation of additional BDF fonts for GD.pm
# Usage        - "cvtbdf.pl" (no arguments, see instructions)
# License      - Freely given to be distributed with the GD.pm libraries
#                (you may modify this script to your heart's content,
#                 but it may only be distributed by the author or via the GD.pm
#                 package.)
#
# Summary      -
#   Uses "bdftogd", (provided with GD.pm) to convert BDF fonts to GD format.
#   It should makes the edits necessary to the GD.pm source files so that.
#   the "bdftogd" process is automated and all the user needs do is recompile
#   the GD.pm package (only "GD.so" is changed during compilation).
#
# Instructions -
#   1) go to your GD.pm source installation directory
#      note: if you have already installed GD.pm, run a "make clean"
#   2) create a subdirectory called "fonts" (mkdir fonts)
#   3) copy the BDF font files you wish to convert to the "fonts" directory
#      note: The BDF font must be a type that "bdftogd" can convert, hence
#            it must be a standard monospaced character font, not a BDF
#            cursor file. Some monospaced fonts may still not work. Test
#            with "bdftogd" before running this script if you are unsure.
#   4) copy "bdftogd" and "cvtbdf.pl" to the "fonts" directory
#   5) run "cvtbdf.pl"
#   6) go to your GD.pm source installation directory and install the new
#      version via a "make" and "make install"
#
# Notes        -
#   A) Keep the "fonts" subdirectory and all fonts you wish to use in the
#      future. Each time you want to add a font you will need the old ones
#      in the directory, or they will disappear during the next recompile.
#   B) Add new fonts in the future is as easy as copying the .bdf file to
#      the "fonts" directory and running steps #5 and #6 again.
#
# Thanks       -
#   To Lincoln Stein for the use of CGI.pm and GD.pm and to all other
#   contributors of those packages.

# make sure we have the conversion program
if (! -x "bdftogd") { die "OOPS!\n  Can't execute 'bdftogd', is it even there?\n  error: $!\n\n"; }

&badnames;
&saveorig("GD.pm","GD.xs","libgd/Makefile.PL");
&copyorig("GD.pm","GD.xs","libgd/Makefile.PL");

for $i (@files) {
  open(OLDXS,"../GD.xs") || die "OOPS!\n  Can't open '../GD.xs' for reading\n  Make sure you're in a 'fonts' subdirectory\n  error: $!\n\n";
  open(NEWXS,"> ../GD.xs.fonts") || die "OOPS!\n  Can't open '../GD.xs.fonts' for writing\n  Make sure you're in a 'fonts' subdirectory\n  error: $!\n\n";
  open(OLDPM,"../GD.pm") || die "OOPS!\n  Can't open '../GD.pm' for reading\n  Make sure you're in a 'fonts' subdirectory\n  error: $!\n\n";
  open(NEWPM,"> ../GD.pm.fonts") || die "OOPS!\n  Can't open '../GD.pm.fonts' for writing\n  Make sure you're in a 'fonts' subdirectory\n  error: $!\n\n";
  open(OLDMAKE,"../libgd/Makefile.PL") || die "OOPS!\n  Can't open '../libgd/Makefile.PL' for reading\n  Make sure you're in a 'fonts' subdirectory\n  error: $!\n\n";
  open(NEWMAKE,"> ../libgd/Makefile.PL.fonts") || die "OOPS!\n  Can't open '../libgd/Makefile.PL.fonts' for writing\n  Make sure you're in a 'fonts' subdirectory\n  error: $!\n\n";

# some state-keeping variables
  my $extern;
  my $package;
  my $export;
  my $preload;
  my $h;
  my $c;

# figure out our "name"
  my $name = "BDF" . $i;
  $name =~ /(.*)\.bdf/;
  $name = $1;
  print "=> name = $name\n";


# do the actual font conversion:
  open(FONT,"$i");
# usage: bdftogd fontname filename, eg. bdftogd FontLarge gdfontl }
  my $fontname = "Font" . $name;
  my $filename = "font" . $name;
  my $gdname = "gdfont" . $name;
  open(CONVERT,"| bdftogd $fontname $filename");
  while (<FONT>) { print CONVERT; }
  close CONVERT;
# move the font files to "../libgd"
  open(OLD,"${gdname}.h");
  open(NEW,"> ../libgd/${gdname}.h");
  while (<OLD>) { print NEW; }
  close OLD;
  close NEW;
  unlink("${gdname}.h");
  open(OLD,"${gdname}.c");
  open(NEW,"> ../libgd/${gdname}.c");
  while (<OLD>) { print NEW; }
  close OLD;
  close NEW;
  unlink("${gdname}.c");

## Begin editing files
# GD.xs:
  while (<OLDXS>) {
    $data = $_;
    if (! $extern && $data =~ /^extern[\s]{1,}gdFontPtr/) {
      $data = "extern  gdFontPtr       gdFont" . $name . ";\n" . $data;
      $extern = 1;
    } elsif (! $package && $data =~ /^MODULE[\s]*=[\s]*GD[\s]{1,}PACKAGE[\s]*=[\s]*GD::Font[\s]{1,}PREFIX=gd/) {
      $data .= "\nGD::Font\ngd" . $name . "(packname=\"GD::Font\")\n        char *  packname\n        PROTOTYPE: \$\n        CODE:\n        {\n                RETVAL = gdFont" . $name . ";\n        }\n        OUTPUT:\n                RETVAL\n";
      $package = 1;
    }
    print NEWXS $data;
  }

# GD.pm:
  while (<OLDPM>) {
    $data = $_;
    if (! $export && $data =~ /\@EXPORT = qw\(/) {
      $data .= "        gd" . $name . "Font\n";
      $export = "done";
    } elsif (! $preload && $data =~ /^# Preloaded methods go here./) {
      $data .= "sub GD::gd" . $name . "Font {\n    return &GD::Font::" . $name . ";\n}\n";
      $preload = "done";
    }
    print NEWPM $data;
  }

# libgd/Makefile.PL:
  while (<OLDMAKE>) {
    $data = $_;
#        'H'         => [qw(gd.h gdfontl.h gdfonts.h io.h gdfontg.h gdfontmb.h gdfontt.h mtables.h)],
    if (! $h && $data =~ /^([\s]*'H'[\s]*\=\>[\s]*\[qw\(gd\.h[\s])(.*)/) {
      $data = $1 . "${gdname}.h " . $2 . "\n";
      $h = "done";
    } elsif (! $c && $data =~ /^([\s]*'C'[\s]*\=\>[\s]*\[qw\(gdfontg\.c[\s])(.*)/) {
#        'C'         => [qw(gdfontg.c gdfontmb.c gdfontt.c gdfontl.c gdfonts.c libgd.c)],
      $data = $1 . "${gdname}.c " . $2 . "\n";
      $c = "done";
    }
    print NEWMAKE $data;
  }

# close the files
  close OLDXS;
  close NEWXS;
  close OLDPM;
  close NEWPM;
  close OLDMAKE;
  close NEWMAKE;

# copy the files to the proper extension
  open(NEWXS,"../GD.xs.fonts");
  open(OLDXS,"> ../GD.xs");
  open(NEWPM,"../GD.pm.fonts");
  open(OLDPM,"> ../GD.pm");
  open(NEWMAKE,"../libgd/Makefile.PL.fonts");
  open(OLDMAKE,"> ../libgd/Makefile.PL");
  while (<NEWXS>) { print OLDXS; }
  while (<NEWPM>) { print OLDPM; }
  while (<NEWMAKE>) { print OLDMAKE; }
  close NEWXS;
  close OLDXS;
  close NEWPM;
  close OLDPM;
  close NEWMAKE;
  close OLDMAKE;

# unlink the temp files
  unlink "../GD.pm.fonts";
  unlink "../GD.xs.fonts";
  unlink "../libgd/Makefile.PL.fonts";
}

sub saveorig {
  local (@files) = @_;
  for $file (@files) {
    if (! -f "../${file}.orig") {
      open(OLD,"../$file") || die $!;
      open(ORIG,"> ../${file}.orig") || die $!;
      while (<OLD>) { print ORIG; }
      close OLD;
      close ORIG;
    }
  }
}

sub copyorig {
  local(@files) = @_;
  for $file (@files) {
    open(ORIG,"../${file}.orig") || die $!;
    open(NEW,"> ../$file") || die $!;
    while (<ORIG>) { print NEW; }
    close ORIG;
    close NEW;
  }
}

sub badnames {
  @badnames = (<*.BDF>,<*.Bdf>,<*.BDf>,<*.bDf>,<*.bDF>,<*.BdF>);
  for $i (@badnames) {
    my $goodname = $i;
    $goodname =~ tr/A-Z/a-z/;
    open(BAD,"$i");
    open(GOOD,"> $goodname");
    while (<BAD>) { print GOOD; }
    close BAD;
    close GOOD;
    unlink $i;
  }
  @files = <*.bdf>;
}