1 #!/usr/bin/perl -w -CSD
2 # This script requires 't1asm' program, which is part of t1utils package,
11 #my $kageaddr="home.fonts.jp:5100"; # Specify port number!
12 #my $kageaddr="fonts.jp:80"; # Specify port number!
13 #my $kagecgi="/~kamichi/test/kagecgi.cgi"; #
14 #my $kagecgi="v0.4/engine/kage.cgi"; #
15 my $kageaddr="localhost:80"; # Specify port number!
16 my $kagecgi="cgi-bin/kage.cgi"; #
18 my $t1asm = "/usr/bin/env t1asm"; # point to 't1asm' executable.
19 #die "Cannot execute $t1asm. Abort.\n" unless -x $t1asm;
20 #my $pfaedit="/usr/bin/env pfaedit"; # point to 'pfaedit' executable.
21 my $pfaedit="/usr/bin/env fontforge"; # point to 'fontforge' executable.
22 #die "Cannot execute $pfaedit. Abort.\n" unless -x $pfaedit;
24 my $omegadb_path=""; # Check the path of omegadb, if needed.
25 my $cleanup_script=""; # Check the path of pfaedit script, if needed.
27 unless($omegadb_path){
28 if(-w '/usr/local/share/chise/omega'){
29 $omegadb_path='/usr/local/share/chise/omega';
30 }elsif(-w '/usr/share/chise/omega'){
31 $omegadb_path='/usr/share/chise/omega';
32 }elsif(-w '/sw/share/chise/omega'){
33 $omegadb_path='/sw/share/chise/omega';
34 }elsif(-w '/usr/local/lib/chise/omega'){
35 $omegadb_path='/usr/local/lib/chise/omega';
40 $omegadb_path=~s!/$!!;
43 ($makefonts_dir=$0)=~s!^(.*)/.*$!$1!;
45 unless($cleanup_script){
46 if(-e "$makefonts_dir/svg2t1.pfe"){
47 $cleanup_script="$makefonts_dir/svg2t1.pfe";
48 }elsif(-e "/usr/local/share/texmf/omega/ocp/chise_rqd/chise/svg2t1.pfe"){
49 $cleanup_script="/usr/local/share/texmf/omega/ocp/chise_rqd/chise/svg2t1.pfe";
50 }elsif(-e "/usr/local/share/texmf/omega/ocp/local/chise/svg2t1.pfe"){
51 $cleanup_script="/usr/local/share/texmf/omega/ocp/local/chise/svg2t1.pfe";
52 }elsif(-e "/usr/share/texmf/omega/ocp/chise_rqd/chise/svg2t1.pfe"){
53 $cleanup_script="/usr/share/texmf/omega/ocp/local/chise/svg2t1.pfe";
54 }elsif(-e "/sw/share/texmf/omega/ocp/local/chise/svg2t1.pfe"){
55 $cleanup_script="/sw/share/texmf/omega/ocp/local/chise/svg2t1.pfe";
59 unless($cleanup_script and -e $cleanup_script){
60 print STDERR "svg2t1.pfe not found!\n",
61 "please check \$cleanup_script in $0.\n";
65 my $dbpath="$omegadb_path/glyph.db"; # check your DB path.
68 my $db = new BerkeleyDB::Hash
69 -Filename => $dbpath, -Flags => DB_CREATE
70 || print STDERR "Cannot open $dbpath. Do not use glyph database.\n";
77 my ($fontname, $fullname, $familyname,
78 $weight, $version, $uniqueID,
79 $numchars, $encoding) = @_;
81 %!PS-Adobe-Font-1.0: $fontname
85 /FontMatrix [0.001 0 0 0.001 0 0] readonly def
86 /UniqueID $uniqueID def
87 /FontBBox [0 -100 1000 900 ]readonly def
88 /FontInfo 8 dict dup begin
89 /version ($version) readonly def
90 /Notice (Copyright (C) Chise Project; Glyphs generated by KAGE server) readonly def
91 /FullName ($fullname) readonly def
92 /FamilyName ($familyname) readonly def
93 /Weight ($weight) readonly def
95 /isFixedPitch true def
96 /UnderlinePosition -200 def
101 /Private 9 dict dup begin
102 /-|{string currentfile exch readstring pop}executeonly def
103 /|-{noaccess def}executeonly def
104 /|{noaccess put}executeonly def
105 /BlueValues [] noaccess ND
106 /UniqueID $uniqueID def
107 /MinFeature{16 16} |-
112 2 index /CharStrings $numchars dict dup begin
126 dup/FontName get exch definefont pop
127 mark currentfile closefile
132 # Convert eps to Type1 charstring.
133 # Return: Type1 charstring.
136 my @paths= split(/\n/, $eps);
137 my ($x1, $y1, $x2, $y2);
138 my $glyph= "\{\n0 1000 hsbw\n";
140 if(m/error/i or m/bad/i){
144 if(m/([\-\d]+)\s+([\-\d]+)\s+moveto/){
145 $x1=$1; $y1=$2; $y1=$y1+100;
147 $glyph.=sprintf("%d %d rmoveto\n",$x1-$x2,$y1-$y2);
149 $glyph.="$x1 $y1 rmoveto\n";
152 elsif(m/([\-\d]+)\s+([\-\d]+)\s+lineto/){
153 $x2=$1; $y2=$2; $y2=$y2+100;
154 $glyph.=sprintf("%d %d rlineto\n",$x2-$x1,$y2-$y1);
158 $glyph.="closepath\n";
161 return $glyph.= "endchar\n\} |-\n";
164 # Query KAGE server and generate Type1 charstrings.
165 # Return: charstrings, encoding vector, and number of chars.
167 my ($requests, $suffix) = @_; # Receive REF for @requests array.
168 my $charstrings = "";
170 my $encoding=""; # /Encoding vector
171 my $blackbox=<<'BLACKBOX';
182 foreach my $req (@$requests){
184 # Referene passing destroys the original array!
185 my $request="$req.$suffix";
186 my ($eps, $charstring);
187 my $char = sprintf("ch%03d", $charnum);
188 if(defined $db && $db->db_get($request, $eps)==0){
189 # If glyph is already in DB, then use it.
190 $charstring = eps2charstring($eps);
191 print STDERR "Use cached glyph for $request.\n";
193 # If glyph is not yet in DB, query KAGE server.
195 my $location; # For redirection
196 if($kageserver = IO::Socket::INET->new("$kageaddr")){
197 print $kageserver "GET /$kagecgi?$req&shotai=$suffix&type=eps\r\n";
198 # print $kageserver "HEAD /$kagecgi?$req&shotai=$suffix&type=svg HTTP/1.1\r\n";
199 # print $kageserver "Host: $kageaddr\r\n\r\n";
200 # #Get redirection info.
202 # while(<$kageserver>){
204 # next unless m|^location:\s+http://([a-z0-9.:]+)/|i;
207 # close($kageserver);
209 # and $kageserver=IO::Socket::INET->new($location)){
210 # print $kageserver "GET /$request.svg HTTP/1.1\r\n";
211 # print $kageserver "Host: $location\r\n\r\n";
212 local $/; $eps=<$kageserver>;
214 $eps =~ s/\r//gm; # remove CR.
215 $eps =~ s/^.+\n\n//ms; # remove HTTP header.
220 print STDERR "Cannot connect to KAGE server at $kageaddr.\n";
223 if($charstring = eps2charstring($eps)){
224 if(defined $db && $db->db_put($request, $eps)==0){
225 # If glyph request is successful, then store it to DB.
226 print STDERR "Glyph for $request cached.\n";
229 # If glyph request failed, then print a black box.
230 # Do not store glyph to DB.
231 print STDERR "Glyph request for $request failed.\n";
232 $charstring = $blackbox;
235 $charstrings.= "/$char $charstring";
236 $encoding.= "dup $charnum/$char put\n";
239 return ($charstrings, $encoding, $charnum);
246 # Read ids data generated by inCHISE
247 my $idsdata="$omegadb_path/idsdata.txt";
248 my ($font_start, $ids_start, %ids);
250 # "require" doesn't work well.
251 # I don't know why...
252 open (my $data, "<:utf8","$idsdata");
255 if(m/^START\t(\d+)\t(\d+)/){
256 $font_start=$1,$ids_start=$2;
257 }elsif(m/^(.*?)\t(\d+)\t(\d+)/){
263 die "Cannot read $idsdata\n";
266 # Create (a nested) list of requests.
267 # $Request[font-number][char-code]='uhhhh...'
269 foreach my $key (keys %ids){
272 foreach my $elem (split(//,$key)){
273 $elem=unpack('U', $elem);
274 if($elem < 0x10000){ # BMP
275 $code.=sprintf("u%04x", $elem);
276 }elsif($elem < 0x110000){ # needs surrogate pair
277 my $high_surrogate=($elem-0x10000) / 0x400 + 0xd800;
278 my $low_surrogate=($elem-0x10000) % 0x400 + 0xdc00;
279 $code.=sprintf("u%04xu%04x",
280 $high_surrogate, $low_surrogate);
281 }else{ #out of range.
282 $code="uffff"; # this generates KAGE server error.
286 $code=~s/(.)u/$1.u/g;
287 $Requests[$ids{$key}[0]]->[$ids{$key}[1]]=$code;
290 print STDERR "Sending query to KAGE server at $kageaddr.\n";
293 foreach my $fontnum (0 .. $#Requests){
294 my @faces=(['Mincho', 'min', 'mincho'],
295 ['Gothic', 'got', 'gothic']
297 foreach my $i (0 .. 1){
298 my $fontname=sprintf("Chise%s%03d", $faces[$i][0], $fontnum);
299 my $pfbname=sprintf("chisesub%03d%s.pfb", $fontnum, $faces[$i][1]);
300 my $suffix=$faces[$i][2]; # .mincho or .gothic
302 # mincho= 430000..., gothic 440000...
303 my $unique_id=430000+$fontnum+$i*10000;
305 my($charstrings, $encoding, $charnum)=
306 makefont($Requests[$fontnum], $suffix);
308 $encoding = sprintf("/Encoding %d array\n%sreadonly def",
309 $charnum, $encoding);
312 printheader($fontname, # FontName
313 $fontname, # FullName
314 'Chise', # FamilyName
316 '001.001', # version (whatever)
317 $unique_id, # UniqueID (should be >= 4000000)
318 $charnum+1, # Number of chars (.notdef included)
319 $encoding # Encoding vector
320 ) . $charstrings . printfooter();
321 # Convert font to PFB
322 open(my $asm, '|-', "$t1asm -b -o $pfbname");
326 system("$pfaedit -script $cleanup_script $pfbname");