source: trunk/filemanager/tp/dompdf/lib/ttf2ufm/ttf2ufm-src/other/showg @ 2000

Revision 2000, 13.8 KB checked in by amuller, 14 years ago (diff)

Ticket #597 - Implementação do módulo gerenciador de arquivos

Line 
1#!/usr/bin/perl
2
3my @cmpfiles;
4
5while($ARGV[0] eq "-c") {
6        shift(@ARGV);
7        push(@cmpfiles, shift(@ARGV));
8}
9
10if( $#ARGV < 1) {
11        die("Usage: $0 [-c file]... file glyph-code...\n");
12}
13
14$fname=shift @ARGV;
15
16# storage for files
17my %fontname;
18my %fbbox;
19my %fblues;
20my %fenc;
21my %frevenc;
22my %fsubrs;
23my %fchars;
24my @cmnbbox; # common bounding box covering all files
25
26@cmnbbox = (100, 100, 100, 100);
27
28# read all files into memory
29for $f (@cmpfiles, $fname) {
30        open(FILE, "<$f") or die("no such file $f");
31        while(<FILE>) {
32                if(/FontBBox\s+\{\s*(.*)\s*}/) {
33                        @bbox=split(/\s+/, $1);
34                        push(@{$fbbox{$f}}, @bbox);
35                        if($bbox[0] < $cmnbbox[0]) {
36                                $cmnbbox[0] = $bbox[0];
37                        }
38                        if($bbox[1] < $cmnbbox[1]) {
39                                $cmnbbox[1] = $bbox[1];
40                        }
41                        if($bbox[2] > $cmnbbox[2]) {
42                                $cmnbbox[2] = $bbox[2];
43                        }
44                        if($bbox[3] > $cmnbbox[3]) {
45                                $cmnbbox[3] = $bbox[3];
46                        }
47                } elsif( /BlueValues\s+\[\s*(.*)\s*\]/ || /OtherBlues\s+\[\s*(.*)\s*\]/ ) {
48                        @blues=split(/\s+/, $1);
49                        push(@{$fblues{$f}}, @blues);
50                } elsif( /^dup\s+(\d+)\s+\/(\S+)\s+put/ ) {
51                        $fenc{$f}{$1} = $2;
52                        if( ! defined $frevenc{$f}{$2} ) {
53                                $frevenc{$f}{$2} = $1;
54                        }
55                } elsif( /^dup\s+(\d+)\s+\{\s*$/ ) {
56                        $key = $1;
57                        $bf = $_;
58                        while(<FILE>) {
59                                $bf .= $_;
60                                if( /\}\s+NP/ ) {
61                                        last;
62                                }
63                        }
64                        $fsubrs{$f}{$key} = $bf;
65                } elsif( /^\/(\S+)\s+\{\s*$/ ) {
66                        $key = $1;
67                        $bf = $_;
68                        while(<FILE>) {
69                                $bf .= $_;
70                                if( /endchar/ ) {
71                                        last;
72                                }
73                        }
74                        $fchars{$f}{$key} = $bf;
75                } elsif( /^\/FontName\s+(\S+)/ ) {
76                        $fontname{$f} = $1;
77                }
78        }
79        close(FILE);
80}
81
82######################## Prolog ###################################
83
84print("%%!PS-Adobe-1.0
85%%DocumentNeededResources: font Courier
86%%Pages: (atend)
87%%EndComments
88%%BeginProlog
89/cmpfcolorarray [
90        [ 1 0.2 0.2 ] % slightly lighter red
91        [ 0 0.7 0.7 ] % cyan
92        [ 0.7 0.7 0 ] % brown-yellow
93] def
94/cmpfcolor { % number -> .
95        cmpfcolorarray length mod % get the subarray number
96        cmpfcolorarray exch get aload pop setrgbcolor
97} bind def
98/contourcolor { 0 0 0 setrgbcolor } bind def % black
99/bluezonecolor { 0.95 0.95 1 setrgbcolor } bind def % very light blue
100/coordcolor { 0 1 0 setrgbcolor } bind def % green
101/textcolor { 0 0 0 setrgbcolor } bind def % black
102/stemcolor { 1 0 0 setrgbcolor } bind def % red
103/mainstemcolor { 0 0 1 setrgbcolor } bind def % blue
104
105% /fnt2pt { 72 5 mul 1000 div } bind def
106
107/linehor { % . font_y -> .
108        gsave
109        0 72 translate
110        72 fnt2pt scale
111        newpath
112        0 exch moveto
113        7 0 rlineto
114        stroke
115        grestore
116} bind def
117
118/linevert { % . font_x -> .
119        gsave
120        72 0 translate
121        fnt2pt 72 scale
122        newpath
123        0 moveto
124        0 7 rlineto
125        stroke
126        grestore
127} bind def
128
129/bluezone { % . font_y_1 font_y_2 -> .
130        gsave
131        bluezonecolor
132        0 72 translate
133        72 fnt2pt scale
134        newpath
135        0 exch moveto
136        7 0 rlineto
137        7 exch lineto
138        -7 0 rlineto
139        closepath
140        fill
141        grestore
142} bind def
143
144/drawstem { %  . xwidth ywidth x0 y0 -> .
145        gsave
146        72 72 translate fnt2pt fnt2pt scale xorg yorg translate
147        newpath
148        moveto
149        dup 0 exch rlineto
150        exch 0 rlineto
151        neg 0 exch rlineto
152        closepath fill
153        grestore
154} bind def
155       
156/getlen {
157        dup stringwidth pop
158} bind def
159
160/compressfont 0.8 def
161
162/label { % . string stringwd y -> .
163        dup lasty lt {
164                dup lasty fontsz sub le
165        } {
166                dup lasty fontsz add ge
167        } ifelse {
168                /curx 0 store
169        } if
170        dup /lasty exch store
171        0 exch moveto
172        compressfont mul dup curx add maxx gt {
173                /curx 0 store
174        } if
175        curx 0 rmoveto
176        dup 0 rlineto
177        stroke
178        gsave
179        curx lasty moveto
180        curx add /curx exch store
181        compressfont 1 scale
182        show
183        grestore
184} bind def
185");
186
187@bbox=@cmnbbox;
188
189$nx=$bbox[2]-$bbox[0];
190$ny=$bbox[3]-$bbox[1];
191$maxsz= ($nx>$ny) ? $nx : $ny;
192$fnt2pt= 72*5/$maxsz;
193printf("/fnt2pt 72 5 mul %d div def\n", $maxsz);
194$xorg= -($bbox[0]-($maxsz-$nx)/2);
195$yorg= -($bbox[1]-($maxsz-$ny)/2);
196printf("/xorg %d def /yorg %d def\n", $xorg, $yorg);
197
198print("
199%%EndProlog
200");
201
202######################## Subroutines ##############################
203
204sub bluezone # from to
205{
206        my ($a, $b)=@_;
207        printf("%d %d bluezone\n",$a+$yorg, $b+$yorg);
208        $ycoord{$a+0}=1;
209        $ycoord{$b+0}=1;
210}
211
212sub linehor # x
213{
214        my $a=$_[0];
215        printf("%d linehor\n",$a+$yorg);
216        $ycoord{$a+0}=1;
217}
218
219sub linevert # x
220{
221        my $a=$_[0];
222        printf("%d linevert\n",$a+$xorg);
223        $xcoord{$a+0}=1;
224}
225
226sub hstem # from width
227{
228        my ($from, $width)=@_;
229        $stemhused=1;
230        printf("%d %d %d %d drawstem %% %d %d h \n", -$stemwd, $width,
231                $bbox[0]-2-$stemhgrp*$stemwd, $from,
232                $from, $width);
233        printf("%d %d %d %d drawstem %% %d %d h \n", $stemwd, $width,
234                $bbox[2]+2+$stemhgrp*$stemwd, $from,
235                $from, $width);
236}
237
238sub vstem # from width
239{
240        my ($from, $width)=@_;
241        $stemvused=1;
242        printf("%d %d %d %d drawstem %% %d %d v \n", $width, -$stemwd,
243                $from, $bbox[1]-2-$stemhgrp*$stemwd,
244                $from, $width);
245        printf("%d %d %d %d drawstem %% %d %d v \n", $width, $stemwd,
246                $from, $bbox[3]+2+$stemhgrp*$stemwd,
247                $from, $width);
248}
249
250sub nextstemgrp
251{
252        if($stemhused || $stemvused) {
253                $stemhgrp++;
254                $stemhused=0;
255                $stemvgrp++;
256                $stemvused=0;
257        }
258}
259
260sub substems # fname subrlist
261{
262        my $fname = shift;
263        my $i, $cmd, @vals;
264
265        print("\nstemcolor\n");
266
267        for $i (@_) {
268                &nextstemgrp();
269                for $_ (split(/\n/, $fsubrs{$fname}{$i})) {
270                        s/^\s+//;
271                        @vals=split(/\s+/, $_);
272                        $cmd=$vals[$#vals];
273                        if($cmd eq "hstem") {
274                                &hstem($vals[0], $vals[1]);
275                        } elsif($cmd eq "vstem") {
276                                &vstem($vals[0], $vals[1]);
277                        }
278                }
279        }
280        print("\n");
281}
282
283sub drawcharwstems # charstring
284{
285        my($x,$y)=(0,0);
286        my @vals, $cmd, $i;
287
288        print("\nmainstemcolor\n");
289        &nextstemgrp();
290        for $_ (split(/\n/, $_[0])) {
291                s/^\s+//;
292                @vals=split(/\s+/, $_);
293                $cmd=$vals[$#vals];
294
295                if($cmd eq "hsbw") {
296                        $x=$vals[0]+0;
297                } elsif($cmd eq "hstem") {
298                        &hstem($vals[0], $vals[1]);
299                } elsif($cmd eq "hstem3") {
300                        &hstem($vals[0], $vals[1]);
301                        &hstem($vals[2], $vals[3]);
302                        &hstem($vals[4], $vals[5]);
303                } elsif($cmd eq "vstem") {
304                        &vstem($vals[0], $vals[1]);
305                } elsif($cmd eq "vstem3") {
306                        &vstem($vals[0], $vals[1]);
307                        &vstem($vals[2], $vals[3]);
308                        &vstem($vals[4], $vals[5]);
309                } elsif($cmd eq "rmoveto") {
310                        # a shortcut
311                        last;
312                }
313        }
314        &drawchar("drawchar", 1, "contourcolor", $_[0]);
315}
316
317sub drawchar #procname wantgrid color charstring
318{
319        my($procname, $wantgrid, $color, $charstring) = @_;
320        my($x,$y)=(0,0);
321        my @vals, $cmd, $i;
322        my %xv=();
323        my %yv=();
324
325        printf("\n/%s {\n",$procname);
326        printf("\ngsave 72 72 translate fnt2pt fnt2pt scale %d %d translate\n", $xorg, $yorg);
327        printf("%s 1 setlinewidth newpath\n", $color);
328        for $_ (split(/\n/, $charstring)) {
329                s/^\s+//;
330                @vals=split(/\s+/, $_);
331                $cmd=$vals[$#vals];
332
333                if($cmd eq "callsubr" && $vals[1] == 4) {
334                        push(@subrlist, $vals[0]);
335                } elsif($cmd eq "amoveto") {
336                        $x=$vals[0]+0;
337                        $y=$vals[1]+0;
338                        $xv{$x+0}=1; $yv{$y+0}=1;
339                        printf("%d %d moveto\n", $x, $y);
340                        printf("%d %d 5 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
341                } elsif($cmd eq "rmoveto") {
342                        $x+=$vals[0];
343                        $y+=$vals[1];
344                        $xv{$x+0}=1; $yv{$y+0}=1;
345                        printf("%d %d moveto\n", $x, $y);
346                        printf("%d %d 5 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
347                } elsif($cmd eq "hmoveto") {
348                        $x+=$vals[0];
349                        $xv{$x+0}=1; $yv{$y+0}=1;
350                        printf("%d %d moveto\n", $x, $y);
351                        printf("%d %d 5 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
352                } elsif($cmd eq "vmoveto") {
353                        $y+=$vals[0];
354                        $xv{$x+0}=1; $yv{$y+0}=1;
355                        printf("%d %d moveto\n", $x, $y);
356                        printf("%d %d 5 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
357                } elsif($cmd eq "alineto") {
358                        $x=$vals[0]+0;
359                        $y=$vals[1]+0;
360                        $xv{$x+0}=1; $yv{$y+0}=1;
361                        printf("%d %d lineto\n", $x, $y);
362                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
363                } elsif($cmd eq "rlineto") {
364                        $x+=$vals[0];
365                        $y+=$vals[1];
366                        $xv{$x+0}=1; $yv{$y+0}=1;
367                        printf("%d %d lineto\n", $x, $y);
368                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
369                } elsif($cmd eq "hlineto") {
370                        $x+=$vals[0];
371                        $xv{$x+0}=1; $yv{$y+0}=1;
372                        printf("%d %d lineto\n", $x, $y);
373                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
374                } elsif($cmd eq "vlineto") {
375                        $y+=$vals[0];
376                        $xv{$x+0}=1; $yv{$y+0}=1;
377                        printf("%d %d lineto\n", $x, $y);
378                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
379                } elsif($cmd eq "arcurveto") {
380                        for $i (0,2,4) {
381                                $x=$vals[$i]+0;
382                                $y=$vals[$i+1]+0;
383                                printf("%d %d ", $x, $y);
384                        }
385                        $xv{$x+0}=1; $yv{$y+0}=1;
386                        printf("curveto\n");
387                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
388                } elsif($cmd eq "rrcurveto") {
389                        for $i (0,2,4) {
390                                $x+=$vals[$i];
391                                $y+=$vals[$i+1];
392                                printf("%d %d \n", $x, $y);
393                        }
394                        $xv{$x+0}=1; $yv{$y+0}=1;
395                        printf("curveto\n");
396                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
397                } elsif($cmd eq "hvcurveto") {
398                        $x+=$vals[0];
399                        printf("%d %d \n", $x, $y);
400                        $x+=$vals[1];
401                        $y+=$vals[2];
402                        printf("%d %d \n", $x, $y);
403                        $y+=$vals[3];
404                        printf("%d %d \n", $x, $y);
405                        $xv{$x+0}=1; $yv{$y+0}=1;
406                        printf("curveto\n");
407                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
408                } elsif($cmd eq "vhcurveto") {
409                        $y+=$vals[0];
410                        printf("%d %d \n", $x, $y);
411                        $x+=$vals[1];
412                        $y+=$vals[2];
413                        printf("%d %d \n", $x, $y);
414                        $x+=$vals[3];
415                        printf("%d %d \n", $x, $y);
416                        $xv{$x+0}=1; $yv{$y+0}=1;
417                        printf("curveto\n");
418                        printf("%d %d 3 0 360 arc %d %d moveto\n", $x, $y, $x, $y);
419                } elsif($cmd eq "closepath") {
420                        printf("closepath stroke newpath\n");
421                }
422        }
423
424        printf("grestore } bind def\n");
425        if($wantgrid) {
426                printf("coordcolor\n");
427                for $x (keys %xv) {
428                        &linevert($x);
429                }
430                for $y (keys %yv) {
431                        &linehor($y);
432                }
433        }
434}
435
436$pages=0;
437
438for $arg (@ARGV) {
439        undef $name, $code;
440
441        if( $arg =~ /^\/(.*)/ ) {
442                $name=$1;
443        } elsif( $arg =~ /^\.(.)/ ) {
444                $code=ord($1);
445        } else {
446                $code=$arg;
447        }
448
449        $pages++;
450
451        $stemhgrp=0;
452        $stemhused=0;
453        $stemvgrp=0;
454        $stemvused=0;
455        $stemwd=10;
456        undef %xcoord;
457        undef %ycoord;
458
459        if( defined $name ) {
460                $xname = $name;
461                $xcode = $frevenc{$fname}{$name};
462                if( $xcode eq "" ) {
463                        $xcode = "**UNKNOWN**";
464                }
465        } else {
466                $xname = $fenc{$fname}{$code};
467                if( $xname eq "" ) {
468                        $xname = "**UNKNOWN**";
469                }
470                $xcode = $code;
471        }
472
473        printf("%%%%Page: %d %d\n", $pages, $pages);
474        printf("gsave
475
4760 setlinewidth
47736 72 translate
478
479gsave
480contourcolor
48172 72 scale
482newpath
4830 0 moveto
4847 0 rlineto
4850 7 rlineto
486-7 0 rlineto
487closepath
488stroke
4891 1 translate
490newpath
4910 0 moveto
4925 0 rlineto
4930 5 rlineto
494-5 0 rlineto
495closepath
496stroke
497grestore
498
499");
500
501        undef @subrlist;
502
503
504        @bbox=@{$fbbox{$fname}};
505
506        print("coordcolor\n");
507        printf("0 linehor %d linehor %d linehor\n", $bbox[1]+$yorg, $bbox[3]+$yorg);
508        printf("%d linevert %d linevert\n", $bbox[0]+$xorg, $bbox[2]+$xorg);
509
510        %vals=@{$fblues{$fname}};
511        for $i (keys %vals) {
512                &bluezone($i, $vals{$i});
513        }
514
515        $havechar = 1;
516        if( defined $fchars{$fname}{$xname} ) {
517                &drawcharwstems($fchars{$fname}{$xname});
518        } else {
519                $havechar = 0;
520                if(defined $name) {
521                        printf(STDERR "WARNING: %s nas no character with name \"%s\"\n", $fname, $name);
522                } else {
523                        printf(STDERR "WARNING: %s nas no character with code \"%s\"\n", $fname, $code);
524                }
525        }
526
527        &substems($fname, @subrlist);
528
529        printf(STDERR "glyph name:%s code:%s (%d substituted stem groups)\n", $xname, $xcode, scalar @subrlist);
530
531        $cmpfidx = 0;
532        for $cmpf(@cmpfiles) {
533                undef $cname, $ccode;
534
535                if( defined $name ) {
536                        if ( ! defined $fchars{$cmpf}{$name} && defined $fenc{$cmpf}{$xcode}) {
537                                printf(STDERR "  NOTE: %s nas no glyph with name \"%s\", guessed by code\n", $cmpf, $name);
538                                $cname = $fenc{$cmpf}{$xcode};
539                                if( $cname eq "" ) {
540                                        $cname = "**UNKNOWN**";
541                                }
542                                $ccode = $xcode;
543                        } else {
544                                $cname = $name;
545                                $ccode = $frevenc{$cmpf}{$name};
546                                if( $ccode eq "" ) {
547                                        $ccode = "**UNKNOWN**";
548                                }
549                        }
550                } else {
551                        $cname = $fenc{$cmpf}{$code};
552                        if( $cname eq "" ) {
553                                $cname = "**UNKNOWN**";
554                        }
555                        $ccode = $code;
556                }
557
558                if( defined $fchars{$cmpf}{$cname} ) {
559                        &drawchar("drawcmpchar", 0, sprintf("%d cmpfcolor", $cmpfidx),
560                                $fchars{$cmpf}{$cname});
561                        printf("drawcmpchar\n\n");
562                        printf(STDERR "  in %s glyph name:%s code:%s\n", $cmpf, $cname, $ccode);
563                } else {
564                        if(defined $name) {
565                                printf(STDERR "  WARNING: %s nas no character with name \"%s\"\n", $cmpf, $name);
566                        } else {
567                                printf(STDERR "  WARNING: %s nas no character with code \"%s\"\n", $cmpf, $code);
568                        }
569                }
570                $cmpfidx++;
571        }
572
573        if($havechar) {
574                printf("drawchar\n\n");
575        }
576
577        # flush the last group
578        &nextstemgrp();
579
580        # the values of coordinates
581        printf("/fontsz 8 fnt2pt div def\n");
582        printf("/Myfont /Courier findfont fontsz scalefont def\n\n");
583        printf("contourcolor Myfont setfont\n");
584
585        for $org (0, $xorg+$bbox[2]+$stemwd*$stemhgrp+72/$fnt2pt) {
586                printf("gsave\n");
587                printf("/maxx 72 fnt2pt div %d sub def /curx 0 def /lasty -10000 def\n",
588                                2+$stemhgrp*$stemwd-$xorg-$bbox[0]);
589                printf("0 72 translate fnt2pt fnt2pt scale %f yorg translate 1 setlinewidth\n", $org);
590                for $y (sort {$a <=> $b} keys %ycoord) {
591                        printf("(%d) getlen %d label\n", $y, $y);
592                }
593                printf("grestore\n");
594        }
595
596        for $org (0, $yorg+$bbox[3]+$stemwd*$stemvgrp+72/$fnt2pt) {
597                printf("gsave\n");
598                printf("/maxx 72 fnt2pt div %d sub def /curx 0 def /lasty -10000 def\n",
599                                2+$stemvgrp*$stemwd-$yorg-$bbox[1]);
600                printf("72 0 translate fnt2pt fnt2pt scale xorg %f translate 90 rotate 1 setlinewidth\n", $org);
601                for $x (sort {$a <=> $b} keys %xcoord) {
602                        printf("(%d) getlen %d label\n", $x, -$x);
603                }
604                printf("grestore\n");
605        }
606
607        printf("gsave 0 %d translate\n", 7.5*72 );
608        printf("contourcolor /Courier findfont 12 scalefont setfont\n");
609        $line = 0;
610
611        $cmpfidx = $#cmpfiles;
612        if( $cmpfidx > (2.5*72/15)-4 ) {
613                $cmpfidx = (2.5*72/15)-4;
614        }
615        for(; $cmpfidx>=0; $cmpfidx--) {
616                $cmpf = $cmpfiles[$cmpfidx];
617                printf("%d cmpfcolor\n", $cmpfidx);
618                printf("newpath 20 %d moveto 0 10 rlineto 10 0 rlineto 0 -10 rlineto closepath fill\n",
619                        15*$line, $cmpf);
620                printf("contourcolor 40 %d moveto (%s %s) show\n", 15*$line, $cmpf, $fontname{$cmpf});
621                $line++;
622        }
623        if( $#cmpfiles >=0 ) {
624                printf("0 %d moveto (Comparison files:) show\n", 15*$line++);
625        }
626        printf("0 %d moveto (code: %d  name: %s) show\n", 15*$line++, $xcode, $xname);
627        printf("0 %d moveto (%s) show\n", 15*$line++, $fname);
628        printf("0 %d moveto (%s) show\n", 15*$line++, $fontname{$fname});
629        printf("grestore\n\n");
630
631        printf("showpage grestore\n\n");
632}
633printf("%%%%Pages: %d\n", $pages);
Note: See TracBrowser for help on using the repository browser.