home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / defoma / scripts / gs.defoma < prev    next >
Encoding:
Text File  |  2005-11-16  |  19.9 KB  |  913 lines
  1. @ACCEPT_CATEGORIES = qw(type1 type3 gsfontderivative truetype cid
  2.             cmap psprint);
  3.  
  4. package gs;
  5. use strict;
  6. use POSIX;
  7.  
  8. use vars qw($DEFOMA_TEST_DIR $ROOTDIR);
  9.  
  10. use Debian::Defoma::Common;
  11. use Debian::Defoma::Font;
  12. use Debian::Defoma::Id;
  13. use Debian::Defoma::Subst;
  14. import Debian::Defoma::Font;
  15. import Debian::Defoma::Id;
  16. import Debian::Defoma::Subst;
  17. import Debian::Defoma::Common;
  18.  
  19. my $Id;
  20. my $IdCmap;
  21. my $Sb1;
  22. my $Sb2;
  23.  
  24. my $PkgDir = "$ROOTDIR/gs.d";
  25. my $CidDir = "$PkgDir/dirs/CIDFont";
  26. my $CMapDir = "$PkgDir/dirs/CMap";
  27. my $TTCidDir = "$PkgDir/dirs/TTCIDFont";
  28. my $FontDir = "$PkgDir/dirs/fonts";
  29. my $FontMap = "$FontDir/Fontmap";
  30. my $CIDFontMap = "$FontDir/CIDFnmap";
  31. my $Subst4psprint = 0;
  32. # for gs8 or later
  33. my $FAPIfmap = "$FontDir/FAPIfontmap";
  34. my $Cidmap = "$FontDir/cidfmap";
  35.  
  36. sub init {
  37.     unless ($Id) {
  38.     $Id = defoma_id_open_cache();
  39.     }
  40.     unless ($IdCmap) {
  41.     $IdCmap = defoma_id_open_cache('cmap');
  42.     }
  43.     unless ($Sb1) {
  44.     $Sb1 = defoma_subst_open(rulename => 'psprint', threshold => 50,
  45.                  idobject => $Id, private => 1);
  46.     }
  47.     unless ($Sb2) {
  48.     $Sb2 = defoma_subst_open(rulename => 'ghostscript', threshold => 30,
  49.                  idobject => $Id);
  50.     }
  51.     
  52.     return 0;
  53. }
  54.  
  55. sub term {
  56.     my @list;
  57.     my $i;
  58.     
  59.     if ($Id) {
  60.     if (open(F, '>' . $FontMap) && open(FF, '>' . $CIDFontMap) &&
  61.         open(FFF, '>' . $FAPIfmap) && open(FFFF, '>' . $Cidmap)) {
  62.         @list = defoma_id_get_font($Id, 'installed');
  63.  
  64.         foreach $i (@list) {
  65.         next if ($Id->{2}->[$i] ne 'SrI');
  66.         my $c = $Id->{4}->[$i];
  67.         my $f;
  68.         my @h;
  69.         my $cmap;
  70.         my @cmaplist;
  71.         my $j;
  72.         my @ch;
  73.         my %hh;
  74.  
  75.         if ($c =~ /^(type1|type3|gsfontderivative)$/) {
  76.             $f = $Id->{1}->[$i];
  77.             $f =~ s/^.*\///;
  78.             print F '/', $Id->{0}->[$i], ' (', $f, ") ;\n";
  79.         } elsif ($c =~ /^truetype$/) {
  80.             $f = $Id->{1}->[$i];
  81.             # FIXME: need to support the sub font id for the collection.
  82.             print FFF '/', $Id->{0}->[$i], ' << /Path (', $f, ') /FontType 1 /FAPI /FreeType /SubfontId ', '0' , " >> ;\n"
  83.         } elsif ($c =~ /^(truetype-cjk|cid)$/) {
  84.             $f = $Id->{1}->[$i];
  85.  
  86.             @h = split(/ +/, $Id->{7}->[$i]);
  87.  
  88.             print FF '/', $Id->{0}->[$i], ' (', $f, ') ';
  89.             if ($c eq 'truetype-cjk') {
  90.             print FF '/', $h[0], '-', $h[1], '-', $h[2];
  91.             }
  92.             print FF " ;\n";
  93.  
  94.             # for gs8
  95.             ## FIXME: the font packages should probably provides
  96.             ##        a CIDSupplement information where the fonts
  97.             ##        actually supports.
  98.             @cmaplist = defoma_id_get_font($IdCmap, 'installed');
  99.             foreach $j (@cmaplist) {
  100.                 @ch = split(/ +/, $IdCmap->{7}->[$j]);
  101.             if (!defined($hh{$ch[1]}) ||
  102.                 $hh{$ch[1]} < $ch[9]) {
  103.                 $hh{$ch[1]} = $ch[9];
  104.             }
  105.             }
  106.             if ($c eq 'truetype-cjk') {
  107.                # FIXME: need to support the sub font id for the collection.
  108.                print FFFF '/', $Id->{0}->[$i], ' << /FileType /TrueType /Path (', $f, ') /SubfontID ', '0', ' /CSI [(', $h[6], ') ', $hh{$h[6]}, "] >> ;\n";
  109.             }
  110.         }
  111.         }
  112.  
  113.         @list = defoma_id_get_font($Id, 'installed');
  114.         
  115.         foreach $i (@list) {
  116.         next if ($Id->{2}->[$i] !~ /^.[aS]/);
  117.         
  118.         my $c = $Id->{4}->[$i];
  119.  
  120.         if ($c =~ /^(truetype|type1|type3|gsfontderivative)$/) {
  121.             print F '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ; \n";
  122.         } elsif ($c =~ /^(truetype-cjk|cid)$/) {
  123.             print FF '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ;\n";
  124.             print FFFF '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ;\n"
  125.         }
  126.         
  127.         }
  128.  
  129.         close F;
  130.         close FF;
  131.         close FFF;
  132.         close FFFF;
  133.         unlink($FontMap) unless(-s $FontMap);
  134.         unlink($CIDFontMap) unless(-s $CIDFontMap);
  135.         unlink($FAPIfmap) unless(-s $FAPIfmap);
  136.         unlink($Cidmap) unless(-s $Cidmap);
  137.     }
  138.  
  139.     defoma_id_close_cache($Id);
  140.     $Id = 0;
  141.     }
  142.     if ($IdCmap) {
  143.     defoma_id_close_cache($IdCmap);
  144.     $IdCmap = 0;
  145.     }
  146.     if ($Sb1) {
  147.     defoma_subst_close($Sb1);
  148.     $Sb1 = 0;
  149.     }
  150.     if ($Sb2) {
  151.     defoma_subst_close($Sb2);
  152.     $Sb2 = 0;
  153.     }
  154.  
  155.     return 0;
  156. }
  157.  
  158. sub create_symlink {
  159.     my $font = shift;
  160.     my $dir = shift || $FontDir;
  161.     
  162.     if ($font =~ /^(.*)\/(.+)$/) {
  163.     my $fontpath = $1;
  164.     my $fontfile = $2;
  165.     my $newfile = $dir . '/' . $fontfile;
  166.         
  167.     return 1 if (-e $newfile);
  168.     
  169.     symlink($font, $newfile) || return 1;
  170.     } else {
  171.     return 1;
  172.     }
  173.  
  174.     return 0;
  175. }
  176.  
  177. sub remove_symlink {
  178.     my $font = shift;
  179.     my $dir = shift || $FontDir;
  180.     
  181.     if ($font =~ /^(.*)\/(.+)$/) {
  182.     my $fontpath = $1;
  183.     my $fontfile = $2;
  184.     my $newfile = $dir . '/' . $fontfile;
  185.     
  186.     return 1 unless (-l $newfile);
  187.     
  188.     unlink($newfile);
  189.     } else {
  190.     return 1;
  191.     }
  192.  
  193.     return 0;
  194. }
  195.  
  196. sub register_ps {
  197.     my $id = shift;
  198.     
  199.     defoma_font_register('postscript', '<gs>/' . $id, @_);
  200. }
  201.  
  202. sub unregister_ps {
  203.     my $id = shift;
  204.  
  205.     if (defoma_font_if_register('postscript', '<gs>/' . $id)) {
  206.     defoma_font_unregister('postscript', '<gs>/' . $id);
  207.     }
  208. }
  209.  
  210. sub t1_register {
  211.     my $type = shift;
  212.     my $font = shift;
  213.     my $h = parse_hints_start(@_);
  214.  
  215.     my $fontname = $h->{FontName};
  216.     return 1 unless ($fontname);
  217.     $fontname =~ s/ .*//;
  218.     
  219.     my $priority = $h->{Priority} || 0;
  220.     
  221.     my %add;
  222.     $add{hints} = join(' ', @_);
  223.  
  224.     if ($type eq 'gsfontderivative') {
  225.     my $ofont = $h->{'GSF-OriginFont'};
  226.     my $oid = $h->{'GSF-OriginID'};
  227.  
  228.     if ($ofont && $oid) {
  229.         $add{depend} = $ofont.' '.$oid;
  230.     } else {
  231.         return 2;
  232.     }
  233.     }
  234.  
  235.     return 3 if (create_symlink($font));
  236.  
  237.     defoma_id_register($Id, type => 'real', font => $font, id => $fontname,
  238.                priority => $priority, %add);
  239.     
  240.     my @alias = ($h->{Alias}) ? split(/ +/, $h->{Alias}) : ();
  241.     my $i;
  242.  
  243.     foreach $i (@alias) {
  244.     defoma_id_register($Id, type => 'alias', font => $font, id => $i,
  245.                priority => $priority, origin => $fontname);
  246.     }
  247.  
  248.     defoma_subst_register($Sb1, $font, $fontname);
  249.     defoma_subst_register($Sb2, $font, $fontname);
  250.  
  251.     return 0;
  252. }
  253.  
  254. sub t1_unregister {
  255.     my $font = shift;
  256.     
  257.     defoma_subst_unregister($Sb1, $font);
  258.     defoma_subst_unregister($Sb2, $font);
  259.     defoma_id_unregister($Id, type => 'alias', font => $font);
  260.     defoma_id_unregister($Id, type => 'real', font => $font);
  261.  
  262.     remove_symlink($font);
  263.  
  264.     return 0;
  265. }
  266.  
  267. sub t1_install {
  268.     my $type = shift;
  269.     my $font = shift;
  270.     my $id = shift;
  271.     my $depfont = shift;
  272.     my $depid = shift;
  273.     my @add = ();
  274.     
  275.     if ($type eq 'real') {
  276.     return 0 if (grep($_ eq '--Alias', @_));
  277.  
  278.     $add[0] = '--RealName';
  279.     }
  280.  
  281.     register_ps($id, @_, @add);
  282.  
  283.     return 0;
  284. }
  285.  
  286. sub t1_remove {
  287.     my $type = shift;
  288.     my $font = shift;
  289.     my $id = shift;
  290.     my $depfont = shift;
  291.     my $depid = shift;
  292.     
  293.     unregister_ps($id);
  294.  
  295.     return 0;
  296. }
  297.  
  298. sub type1 {
  299.     my $com = shift;
  300.  
  301.     if ($com eq 'register') {
  302.     return t1_register('type1', @_);
  303.     } elsif ($com eq 'unregister') {
  304.     return t1_unregister(@_);
  305.     } elsif ($com =~ /^do-install-(.*)$/) {
  306.     return t1_install($1, @_);
  307.     } elsif ($com =~ /^do-remove-(.*)$/) {
  308.     return t1_remove($1, @_);
  309.     } elsif ($com eq 'init') {
  310.     return init();
  311.     } elsif ($com eq 'term') {
  312.     return term();
  313.     }
  314.     
  315.     return 0;
  316. }
  317.  
  318. sub type3 {
  319.     return type1(@_);
  320. }
  321.  
  322. sub gsfontderivative {
  323.     my $com = shift;
  324.  
  325.     if ($com eq 'register') {
  326.     return t1_register('gsfontderivative', @_);
  327.     } else {
  328.     return type1($com, @_);
  329.     }
  330. }
  331.  
  332. sub tt_register_cjk {
  333.     my %addstr = ('Japanese' => '-Ja',
  334.           'Korean' => '-Ko',
  335.           'Chinese-China' => '-GB',
  336.           'Chinese-Taiwan' => '-CNS');
  337.     my %ordering = ('Japanese' => 'Japan1',
  338.             'Korean' => 'Korea1',
  339.             'Chinese-China' => 'GB1',
  340.             'Chinese-Taiwan' => 'CNS1');
  341.     my %coding = ('Unicode' => 'Unicode',
  342.           'BIG5' => 'Big5',
  343.           'ShiftJIS' => 'ShiftJIS',
  344.           'WanSung' => 'WanSung',
  345.           'Johab' => 'Johab');
  346.     
  347.     my $cnt = shift;
  348.     my $loc = shift;
  349.     my $font = shift;
  350.     my $fontname = shift;
  351.     my $alias = shift;
  352.     my $charset = shift;
  353.     my $encoding = shift;
  354.     my $priority = shift;
  355.  
  356.     return $cnt unless (exists($addstr{$loc}) && exists($ordering{$loc}) &&
  357.             exists($coding{$encoding}));
  358.     my $ord = $ordering{$loc};
  359.     my $enc = $coding{$encoding};
  360.     
  361.     my $add = '';
  362.     $add = $addstr{$loc} if ($cnt > 0);
  363.  
  364.     my @hints = ('Adobe', $ord, $enc,
  365.          '--CIDRegistry', 'Adobe', '--CIDOrdering', $ord);
  366.  
  367.     defoma_id_register($Id, type => 'real', font => $font,
  368.                id => $fontname . $add, priority => $priority,
  369.                category => 'truetype-cjk',
  370.                hints => join(' ', @hints, @_));
  371.  
  372.     foreach my $i (@{$alias}) {
  373.     defoma_id_register($Id, type => 'alias', font => $font,
  374.                id => $i . $add, priority => $priority,
  375.                category => 'truetype-cjk',
  376.                origin => $fontname . $add);
  377.     }
  378.  
  379.     defoma_subst_register($Sb1, $font, $fontname . $add);
  380.     defoma_subst_register($Sb2, $font, $fontname . $add);
  381.  
  382.     $cnt++;
  383.     return $cnt unless ($charset =~ /JISX0212/ && $loc eq 'Japanese' &&
  384.             $encoding eq 'Unicode');
  385.  
  386.     $add = '-JaH';
  387.     @hints = ('Adobe', 'Japan2', 'Unicode',
  388.          '--CIDRegistry', 'Adobe', '--CIDOrdering', 'Japan2');
  389.     
  390.     defoma_id_register($Id, type => 'real', font => $font,
  391.                id => $fontname . $add, priority => $priority,
  392.                category => 'truetype-cjk',
  393.                hints => join(' ', @hints, @_));
  394.  
  395.     foreach my $i (@{$alias}) {
  396.     defoma_id_register($Id, type => 'alias', font => $font,
  397.                id => $i . $add, priority => $priority,
  398.                category => 'truetype-cjk',
  399.                origin => $fontname . $add);
  400.     }
  401.  
  402.     defoma_subst_register($Sb1, $font, $fontname . $add);
  403.     defoma_subst_register($Sb2, $font, $fontname . $add);
  404.  
  405.     $cnt++;
  406.     return $cnt;
  407. }
  408.  
  409. sub tt_register {
  410.     my $font = shift;
  411.     my $h = parse_hints_start(@_);
  412.     my $i;
  413.  
  414.     my $fontname = $h->{FontName};
  415.     my $location = $h->{Location};
  416.     my $encoding = $h->{Encoding};
  417.     my $priority = $h->{Priority} || 0;
  418.     my $charset = $h->{Charset};
  419.  
  420.     return 1 unless ($fontname && $location && $encoding);
  421.     $fontname =~ s/ .*//;
  422.     my @alias = ($h->{Alias}) ? split(/ +/, $h->{Alias}) : ();
  423.  
  424.     return 2 if (create_symlink($font));
  425.     
  426.     parse_hints_cut($h, 'Encoding', 'Location', 'FontName');
  427.     my @hints;
  428.     
  429.     if ($location !~ /Japanese|Korean|Chinese/) {
  430.     @hints = parse_hints_build($h);
  431.     
  432.     defoma_id_register($Id, type => 'real', font => $font, id => $fontname,
  433.                priority => $priority, hints => join(' ', @hints));
  434.  
  435.     foreach $i (@alias) {
  436.         defoma_id_register($Id, type => 'alias', font => $font, id => $i,
  437.                    priority => $priority, origin => $fontname);
  438.     }
  439.     
  440.     defoma_subst_register($Sb1, $font, $fontname);
  441.     defoma_subst_register($Sb2, $font, $fontname);
  442.     } else {
  443.     parse_hints_cut($h, 'Charset');
  444.     @hints = parse_hints_build($h);
  445.     
  446.     my $loc;
  447.     my @locs = split(/ /, $location);
  448.     my $cnt = 0;
  449.     
  450.     foreach $loc (@locs) {
  451.         $cnt = tt_register_cjk($cnt, $loc, $font, $fontname, \@alias,
  452.                    $charset, $encoding, $priority, @hints);
  453.     }
  454.     }
  455.  
  456.     return 0;
  457. }
  458.  
  459. sub tt_unregister {
  460.     my $font = shift;
  461.     
  462.     defoma_subst_unregister($Sb1, $font);
  463.     defoma_subst_unregister($Sb2, $font);
  464.     defoma_id_unregister($Id, type => 'alias', font => $font);
  465.     defoma_id_unregister($Id, type => 'real', font => $font);
  466.  
  467.     remove_symlink($font);
  468.     
  469.     return 0;
  470. }
  471.  
  472. sub tt_install {
  473.     my $type = shift;
  474.     my $font = shift;
  475.     my $id = shift;
  476.     my $depfont = shift;
  477.     my $depid = shift;
  478.  
  479.     my @add = ();
  480.     
  481.     $add[0] = '--RealName' if ($type eq 'real');
  482.  
  483.     register_ps($id, @_, @add);
  484.     
  485.     return 0;
  486. }
  487.  
  488. sub tt_remove {
  489.     my $type = shift;
  490.     my $font = shift;
  491.     my $id = shift;
  492.     my $depfont = shift;
  493.     my $depid = shift;
  494.  
  495.     unregister_ps($id);
  496.     
  497.     return 0;
  498. }
  499.  
  500. sub truetype {
  501.     my $com = shift;
  502.  
  503.     if ($com eq 'register') {
  504.     return tt_register(@_);
  505.     } elsif ($com eq 'unregister') {
  506.     return tt_unregister(@_);
  507.     } elsif ($com =~ /^do-install-(.*)$/) {
  508.     return tt_install($1, @_);
  509.     } elsif ($com =~ /^do-remove-(.*)$/) {
  510.     return tt_remove($1, @_);
  511.     } elsif ($com eq 'init') {
  512.     return init();
  513.     } elsif ($com eq 'term') {
  514.     return term();
  515.     }
  516.     
  517.     return 0;
  518. }
  519.  
  520. sub truetype_cjk {
  521.     my $com = shift;
  522.  
  523.     if ($com =~ /^do-install-(.*)$/) {
  524.     return cid_install($1, @_);
  525.     } elsif ($com =~ /^do-remove-(.*)$/) {
  526.     return cid_remove($1, @_);
  527.     } elsif ($com eq 'init') {
  528.     return init();
  529.     } elsif ($com eq 'term') {
  530.     return term();
  531.     }
  532.  
  533.     return 0;
  534. }
  535.  
  536. sub cid_register {
  537.     my $type = shift;
  538.     my $font = shift;
  539.     my $h = parse_hints_start(@_);
  540.  
  541.     my $fontname = $h->{FontName};
  542.     my $registry = $h->{CIDRegistry};
  543.     my $ordering = $h->{CIDOrdering};
  544.     my $priority = $h->{Priority} || 0;
  545.     
  546.     return 1 unless($fontname && $registry && $ordering);
  547.     $fontname =~ s/ .*//;
  548.     $registry =~ s/ .*//;
  549.     $ordering =~ s/ .*//;
  550.     my @alias = ($h->{Alias}) ? split(/ +/, $h->{Alias}) : ();
  551.  
  552.     return 2 if (create_symlink($font));
  553.  
  554.     parse_hints_cut($h, 'PSCharset', 'PSEncoding', 'Charset', 'Encoding');
  555.     my @hints = parse_hints_build($h);
  556.     @hints = ($registry, $ordering, '.', @hints);
  557.  
  558.     defoma_id_register($Id, type => 'real', font => $font,
  559.                id => $fontname, priority => $priority,
  560.                category => $type, hints => join(' ', @hints));
  561.  
  562.     my $i;
  563.     foreach $i (@alias) {
  564.     defoma_id_register($Id, type => 'alias', font => $font, id => $i,
  565.                priority => $priority, origin => $fontname,
  566.                category => $type);
  567.     }
  568.  
  569.     defoma_subst_register($Sb1, $font, $fontname);
  570.     defoma_subst_register($Sb2, $font, $fontname);
  571.     
  572.     return 0;
  573. }
  574.     
  575. sub cid_unregister {
  576.     my $font = shift;
  577.  
  578.     defoma_subst_unregister($Sb1, $font);
  579.     defoma_subst_unregister($Sb2, $font);
  580.     defoma_id_unregister($Id, type => 'alias', font => $font);
  581.     defoma_id_unregister($Id, type => 'real', font => $font);
  582.  
  583.     remove_symlink($font);
  584.  
  585.     return 0;
  586. }
  587.  
  588. sub cid_install_all {
  589.     my $type = shift;
  590.     my $id = shift;
  591.     my $registry = shift;
  592.     my $ordering = shift;
  593.     
  594.     my @cmaps = defoma_id_get_font($IdCmap, 'installed');
  595.     foreach my $c (@cmaps) {
  596.     my @chs = split(/ +/, $IdCmap->{7}->[$c]);
  597.  
  598.     next if ($chs[0] ne $registry);
  599.     next if ($chs[1] ne $ordering && $chs[1] ne 'Identity');
  600.  
  601.     shift(@chs);
  602.     shift(@chs);
  603.     
  604.     my $psname = $id . '-' . $IdCmap->{0}->[$c];
  605.  
  606.     my @add = ();
  607.     $add[0] = '--RealName' if ($type eq 'real');
  608.     
  609.     register_ps($psname, @_, @add, @chs);
  610.     }
  611.  
  612.     return 0;
  613. }
  614.  
  615. sub cid_remove_all {
  616.     my $type = shift;
  617.     my $id = shift;
  618.     my $registry = shift;
  619.     my $ordering = shift;
  620.     
  621.     my @cmaps = defoma_id_get_font($IdCmap, 'installed');
  622.     foreach my $c (@cmaps) {
  623.     my @chs = split(/ +/, $IdCmap->{7}->[$c]);
  624.  
  625.     next if ($chs[0] ne $registry);
  626.     next if ($chs[1] ne $ordering && $chs[1] ne 'Identity');
  627.  
  628.     my $psname = $id . '-' . $IdCmap->{0}->[$c];
  629.  
  630.     unregister_ps($psname);
  631.     }
  632.  
  633.     return 0;
  634. }
  635.  
  636. sub cid_install {
  637.     my $type = shift;
  638.     my $font = shift;
  639.     my $id = shift;
  640.     my $depfont = shift;
  641.     my $depid = shift;
  642.     my $registry = shift;
  643.     my $ordering = shift;
  644.     my $encoding = shift;
  645.  
  646.     cid_install_all($type, $id, $registry, $ordering, @_);
  647.  
  648.     return 0;
  649. }
  650.  
  651. sub cid_remove {
  652.     my $type = shift;
  653.     my $font = shift;
  654.     my $id = shift;
  655.     my $depfont = shift;
  656.     my $depid = shift;
  657.     my $registry = shift;
  658.     my $ordering = shift;
  659.     my $encoding = shift;
  660.  
  661.     cid_remove_all($type, $id, $registry, $ordering);
  662.     
  663.     return 0;
  664. }
  665.  
  666. sub cid {
  667.     my $com = shift;
  668.  
  669.     if ($com eq 'register') {
  670.     return cid_register('cid', @_);
  671.     } elsif ($com eq 'unregister') {
  672.     return cid_unregister(@_);
  673.     } elsif ($com =~ /^do-install-(.*)$/) {
  674.     return cid_install($1, @_);
  675.     } elsif ($com =~ /^do-remove-(.*)$/) {
  676.     return cid_remove($1, @_);
  677.     } elsif ($com eq 'init') {
  678.     return init();
  679.     } elsif ($com eq 'term') {
  680.     return term();
  681.     }
  682.  
  683.     return 0;
  684. }
  685.  
  686. sub cmap_register {
  687.     my $font = shift;
  688.  
  689.     if ($font =~ /\/gs-cjk-resource\//) {
  690.     return 2 if (create_symlink($font, $CMapDir));
  691.     return 0;
  692.     }
  693.     
  694.     my $h = parse_hints_start(@_);
  695.  
  696.     my $cmap = $h->{CMapName};
  697.     my $reg = $h->{CIDRegistry};
  698.     my $ord = $h->{CIDOrdering};
  699.     
  700.     return 1 unless ($cmap && $reg && $ord);
  701.     $reg =~ s/ .*//;
  702.     $ord =~ s/ .*//;
  703.     $cmap =~ s/ .*//;
  704.     
  705.     my @hints = ($reg, $ord, @_);
  706.  
  707.     defoma_id_register($IdCmap, type => 'real', font => $font, id => $cmap,
  708.                priority => 0, hints => join(' ', @hints));
  709.  
  710.     return 0;
  711. }
  712.  
  713. sub cmap_unregister {
  714.     my $font = shift;
  715.  
  716.     if ($font =~ /\/gs-cjk-resource\//) {
  717.     remove_symlink($font, $CMapDir);
  718.     return 0;
  719.     }
  720.     
  721.     defoma_id_unregister($IdCmap, type => 'real', font => $font);
  722.  
  723.     return 0;
  724. }
  725.  
  726. sub cmap_install {
  727.     my $font = shift;
  728.     my $cmap = shift;
  729.     my $df = shift;
  730.     my $di = shift;
  731.     my $reg = shift;
  732.     my $ord = shift;
  733.     my %hash;
  734.     my @nonreal = ();
  735.     
  736.     return 1 if (create_symlink($font, $CMapDir));
  737.  
  738.     my @list = (defoma_id_get_font($Id, 'installed', f4 => 'cid'),
  739.         defoma_id_get_font($Id, 'installed', f4 => 'truetype-cjk'));
  740.     
  741.     foreach my $i (@list) {
  742.     my $type = $Id->{2}->[$i];
  743.     my $id = $Id->{0}->[$i];
  744.     
  745.     if ($type ne 'SrI') {
  746.         push(@nonreal, $i);
  747.         next;
  748.     }
  749.  
  750.     my @hints = split(/ +/, $Id->{7}->[$i]);
  751.  
  752.     next if ($hints[0] ne $reg);
  753.     next if ($hints[1] ne $ord && $ord ne 'Identity');
  754.  
  755.     $hash{$id} = $i;
  756.  
  757.     shift(@hints);
  758.     shift(@hints);
  759.     shift(@hints);
  760.  
  761.     my $psname = $id . '-' . $cmap;
  762.  
  763.     register_ps($psname, @hints, '--RealName', @_);
  764.     }
  765.  
  766.     foreach my $i (@nonreal) {
  767.     my $depid = $Id->{5}->[$i];
  768.     next unless (exists($hash{$depid}));
  769.     
  770.     my @hints = split(/ +/, $Id->{7}->[$hash{$depid}]);
  771.  
  772.     next if ($hints[0] ne $reg);
  773.     next if ($hints[1] ne $ord && $ord ne 'Identity');
  774.  
  775.     shift(@hints);
  776.     shift(@hints);
  777.     shift(@hints);
  778.  
  779.     my $psname = $Id->{0}->[$i] . '-' . $cmap;
  780.  
  781.     register_ps($psname, @hints, @_);
  782.     }
  783.  
  784.     return 0;
  785. }
  786.  
  787. sub cmap_remove {
  788.     my $font = shift;
  789.     my $cmap = shift;
  790.     my $df = shift;
  791.     my $di = shift;
  792.     my $reg = shift;
  793.     my $ord = shift;
  794.     my %hash;
  795.  
  796.     remove_symlink($font, $CMapDir);
  797.  
  798.     my @list = (defoma_id_get_font($Id, 'installed', f4 => 'cid'),
  799.         defoma_id_get_font($Id, 'installed', f4 => 'truetype-cjk'));
  800.  
  801.     foreach my $i (@list) {
  802.     my @hints = split(/ +/, $Id->{7}->[$i]);
  803.  
  804.     if (@hints > 0) {
  805.         next if ($hints[0] ne $reg);
  806.         next if ($hints[1] ne $ord && $ord ne 'Identity');
  807.     }
  808.     
  809.     my $psname = $Id->{0}->[$i] . '-' . $cmap;
  810.  
  811.     unregister_ps($psname);
  812.     }
  813.     
  814.     return 0;
  815. }
  816.  
  817. sub cmap {
  818.     my $com = shift;
  819.  
  820.     if ($com eq 'register') {
  821.     return cmap_register(@_);
  822.     } elsif ($com eq 'unregister') {
  823.     return cmap_unregister(@_);
  824.     } elsif ($com eq 'do-install-real') {
  825.     return cmap_install(@_);
  826.     } elsif ($com eq 'do-remove-real') {
  827.     return cmap_remove(@_);
  828.     } elsif ($com eq 'init') {
  829.     return init();
  830.     } elsif ($com eq 'term') {
  831.     return term();
  832.     }
  833.  
  834.     return 0;
  835. }
  836.  
  837. sub psprint_register {
  838.     my $font = shift;
  839.     return 0 unless ($Subst4psprint);
  840.     return 1 if ($font !~ /(.+)\/(.+)/);
  841.  
  842.     return 0 if ($1 eq '<gs>');
  843.     my $fontname = $2;
  844.  
  845.     return 2 if ($Sb1->grep_rule('', $fontname));
  846.  
  847.     my @hints;
  848.     my $h = parse_hints_start(@_);
  849.     my $cset = $h->{PSCharset};
  850.     my $enc = $h->{PSEncoding};
  851.     
  852.     if ($cset && $enc && $cset =~ /^Adobe-([^-]+).*$/) {
  853.     my $ord = $1;
  854.     $fontname =~ s/-$enc$//;
  855.  
  856.     parse_hints_cut($h, 'PSCharset', 'PSEncoding', 'Charset', 'Encoding',
  857.             'Direction');
  858.     @hints = parse_hints_build($h);
  859.     push(@hints, '--CIDRegistry,*', 'Adobe', '--CIDOrdering,*', $ord);
  860.     } else {
  861.     @hints = @_;
  862.     }
  863.  
  864.     for my $i (@hints) {
  865.     $i = '--Charset,*' if ($i eq '--Charset');
  866.     $i = '--Encoding,*' if ($i eq '--Encoding');
  867.     $i = '--Direction,*' if ($i eq '--Direction');
  868.     $i = '--Shape,2' if ($i eq '--Shape');
  869.     }
  870.     
  871.     defoma_subst_add_rule($Sb1, $fontname, @hints);
  872.  
  873.     return 0;
  874. }
  875.  
  876. sub psprint_unregister {
  877.     my $font = shift;
  878.     return 0 if ($font !~ /(.+)\/(.+)/);
  879.  
  880.     return 0 if ($1 eq '<gs>');
  881.     my $fontname = $2;
  882.  
  883.     my $h = parse_hints_start(@_);
  884.     my $cset = $h->{PSCharset};
  885.     my $enc = $h->{PSEncoding};
  886.  
  887.     if ($cset && $enc && $cset =~ /^Adobe-.*$/) {
  888.     $fontname =~ s/-$enc$//;
  889.     }
  890.  
  891.     defoma_subst_remove_rule($Sb1, $fontname);
  892.  
  893.     return 0;
  894. }
  895.  
  896. sub psprint {
  897.     my $com = shift;
  898.  
  899.     if ($com eq 'register') {
  900.     return psprint_register(@_);
  901.     } elsif ($com eq 'unregister') {
  902.     return psprint_unregister(@_);
  903.     } elsif ($com eq 'init') {
  904.     return init();
  905.     } elsif ($com eq 'term') {
  906.     return term();
  907.     }
  908.  
  909.     return 0;
  910. }
  911.  
  912. 1;
  913.