linkmap/map.pl

   1 #-----------------------------------------------------------------------------
   2 use utf8;
   3 binmode STDOUT, ":utf8";
   4 require 'chiseperl.pl';
   5 use Encode;
   6
   7 $rate = 0.75;
   8 $x = -10;
   9 $y = 14;
  10 %char = ();
  11 %link = ();
  12 %family = ();
  13 %object = ();
  14 @list= ();
  15 $file= @ARGV[1];
  16 $txt = "txt";
  17 $png = "png";
  18 $svg = "svg";
  19 $graphviz = '/usr/bin/dot';
  20 $html = "html";
  21
  22 #-----------------------------------------------------------------------------
  23 &init_chise;
  24
  25 foreach(@chise_feature){
  26   if($_ !~ m/sources/){
  27     push(@list, $_);
  28   }
  29 }
  30
  31 &process(eval('0x'.$ARGV[0]));
  32
  33 #-----------------------------------------------------------------------------
  34
  35 # create txt
  36 open FH, ">:utf8", "$file.$txt";
  37 print FH "digraph g{\r\n";
  38 print FH "\trankdir = \"LR\";\r\n";
  39 $be_child = ",".join(",", values(%family)).",";
  40 foreach(sort(keys %family)){
  41   if($be_child =~ m/,$_,/){
  42     next;
  43   }
  44   &ireko($_,1);
  45 }
  46 foreach(sort(keys %char)){
  47   printf FH "\t\"%X\" [ label = \"$char{$_}\", shape = \"record\" ];\r\n", $_;
  48 }
  49 foreach(sort(keys %link)){
  50   @temp = split(/-/, $_);
  51   printf FH "\t\"%X\" -> \"%X\" [ label = \"$link{$_}\" ];\r\n", $temp[0], $temp[1];
  52 }
  53 print FH "}\r\n";
  54 close FH;
  55
  56 #create png
  57 $dummy = `$graphviz -Tpng -o$file.$png $file.$txt`;
  58
  59 #create svg
  60 $dummy = `$graphviz -Tsvg -o$file.$svg $file.$txt`;
  61
  62 #create html
  63 open FH, "<:utf8", "$file.$svg";
  64 open FH2, ">:utf8", "$file.$html";
  65 print FH2 <<EOT;
  66 <html xmlns="http://www.w3.org/1999/xhtml">
  67 <head>
  68 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
  69 <link rel="stylesheet" type="text/css" href="map.css">
  70 <title>chise_linkmap : u$ARGV[0]</title>
  71 </head>
  72 <body>
  73 <img src="$file.$png" usemap="#object" border="0">
  74 EOT
  75 foreach(<FH>){
  76   if(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=cns11643\&\#45\;([1-9])\:([0-9A-F]{4})/){
  77     $left = int($1 / $rate) + $x;
  78     $top = int($2 / $rate) + $y;
  79     print FH2 "<div class=\"general\" style=\"top: $top; left: $left;\">";
  80     print FH2 "<img src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/CNS$3/$4.gif\">\r\n";
  81     print FH2 "</div>";
  82   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=jef\&\#45\;china3\:([0-9A-F]{4})/){
  83     $left = int($1 / $rate) + $x;
  84     $top = int($2 / $rate) + $y;
  85     $target = $3;
  86     $target =~ tr/A-F/a-f/;
  87     print FH2 "<div class=\"general\" style=\"top: $top; left: $left;\">";
  88     print FH2 "<img src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/$target.gif\" width=\"40\" height=\"40\">\r\n";
  89     print FH2 "</div>";
  90   #} elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=gb2312\:([0-9A-F]{4})/){
  91   #  $left = int($1 / $rate) + $x;
  92   #  $top = int($2 / $rate) + $y;
  93   #  print FH2 "<div style=\"position: absolute; top: $top; left: $left;\">";
  94   #  $ku = int(eval('0x'.$3) / 0x100) - 0x20;
  95   #  $ten = sprintf "%02d", eval('0x'.$3) % 0x100 - 0x20;
  96   #  print FH2 "<img src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/GB0/$ku-$ten.gif\">\r\n";
  97   #  print FH2 "</div>";
  98   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=gb2312\:([0-9A-F]{4})/){
  99     $left = int($1 / $rate) + $x;
 100     $top = int($2 / $rate) + $y;
 101     print FH2 "<div class=\"gb\" style=\"top: $top; left: $left;\">";
 102     $char = $3;
 103     $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 104     Encode::from_to($char, 'gb2312-raw', 'utf-8');
 105     utf8::decode($char);
 106     print FH2 "$char\r\n";
 107     print FH2 "</div>";
 108   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=jis\&\#45\;x0208\@19(78|83|90|97)\:([0-9A-F]{4})/){
 109     $left = int($1 / $rate) + $x;
 110     $top = int($2 / $rate) + $y;
 111     print FH2 "<div class=\"general\" style=\"top: $top; left: $left;\">";
 112     $ku = int(eval('0x'.$4) / 0x100) - 0x20;
 113     $ten = sprintf "%02d", eval('0x'.$4) % 0x100 - 0x20;
 114     print FH2 "<img src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/JIS-$3/$ku-$ten.gif\">\r\n";
 115     print FH2 "</div>";
 116   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=jis\&\#45\;x0212\:([0-9A-F]{4})/){
 117     $left = int($1 / $rate) + $x;
 118     $top = int($2 / $rate) + $y;
 119     print FH2 "<div class=\"general\" style=\"top: $top; left: $left;\">";
 120     $ku = int(eval('0x'.$3) / 0x100) - 0x20;
 121     $ten = sprintf "%02d", eval('0x'.$3) % 0x100 - 0x20;
 122     print FH2 "<img src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/JIS-SP/$ku-$ten.gif\">\r\n";
 123     print FH2 "</div>";
 124   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=zinbun\&\#45;oracle\:([0-9A-F]{1,4})/){
 125     $left = int($1 / $rate) + $x - 20;
 126     $top = int($2 / $rate) + $y;
 127     my $number = sprintf "%04d", eval('0x'.$3);
 128     print FH2 "<img style=\"position: absolute; top: $top; left: $left;\" src=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/glyphs/ZOB-1968/$number.png\" width=\"80\" height=\"80\">";
 129     print FH2 "</div>";
 130   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=ucs\:([0-9A-F]{4,6})/){
 131     $left = int($1 / $rate) + $x - 20;
 132     $top = int($2 / $rate) + $y;
 133     print FH2 "<div class=\"ucs\" style=\"top: $top; left: $left;\">";
 134     print FH2 "[".pack('U',eval('0x'.$3))."]\r\n";
 135     print FH2 "</div>";
 136   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=big5\:([0-9A-F]{4,6})/){
 137     $left = int($1 / $rate) + $x;
 138     $top = int($2 / $rate) + $y;
 139     print FH2 "<div class=\"big5\" style=\"top: $top; left: $left;\">";
 140     $char = $3;
 141     $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 142     Encode::from_to($char, 'big5', 'utf-8');
 143     utf8::decode($char);
 144     print FH2 "$char\r\n";
 145     print FH2 "</div>";
 146   #} elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=hanziku\&\#45\;([0-9]{1,2})\:([0-9A-F]{4})/){
 147   #  $left = int($1 / $rate) + $x;
 148   #  $top = int($2 / $rate) + $y;
 149   #  #$number = sprintf "%02d", $3;
 150   #  $number = $3;
 151   #  $numberk = $3;
 152   #  $numberk =~ tr/12345678/一二三四五六七八/;
 153   #  #print FH2 "<div style=\"position: absolute; top: $top; left: $left; font-family: 'hzk${number}u'; font-size: 40px;\">";
 154   #  print FH2 "<div style=\"position: absolute; top: $top; left: $left; font-family: '細明體外字集$numberk'; font-size: 40px;\">";
 155   #  #printf FH2 pack('U', chise::chise_ds_decode_char($chise_ds, chise_tools::get_uchar("=hanziku-$number"), eval('0x'.$4)));
 156   #  #printf FH2 pack('U', chise::chise_ds_decode_char($chise_ds, chise_tools::get_uchar("=big5"), eval('0x'.$4)));
 157   #  $char = $4;
 158   #  $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 159   #  Encode::from_to($char, 'big5', 'utf-8');
 160   #  utf8::decode($char);
 161   #  print FH2 "$char\r\n";
 162   #  print FH2 "</div>";
 163   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=big5\&\#45\;cdp\:([0-9A-F]{4,6})/){
 164     $left = int($1 / $rate) + $x;
 165     $top = int($2 / $rate) + $y;
 166     print FH2 "<div class=\"cdp\" style=\"top: $top; left: $left;\">";
 167     printf FH2 pack('U', chise::chise_ds_decode_char($chise_ds, chise::get_uchar('=big5-pua'), eval('0x'.$3)));
 168     print FH2 "</div>";
 169   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=jis\&\#45\;x0208\:([0-9A-F]{4,6})/){
 170     $left = int($1 / $rate) + $x;
 171     $top = int($2 / $rate) + $y;
 172     print FH2 "<div class=\"jis\" style=\"top: $top; left: $left;\">";
 173     $char = $3;
 174     $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 175     Encode::from_to($char, 'jis0208-raw', 'utf-8');
 176     utf8::decode($char);
 177     print FH2 "$char\r\n";
 178     print FH2 "</div>";
 179   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=ks\&\#45\;x1001\:([0-9A-F]{4,6})/){
 180     $left = int($1 / $rate) + $x;
 181     $top = int($2 / $rate) + $y;
 182     print FH2 "<div class=\"ks\" style=\"top: $top; left: $left;\">";
 183     $char = $3;
 184     $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 185     Encode::from_to($char, 'ksc5601-raw', 'utf-8');
 186     utf8::decode($char);
 187     print FH2 "$char\r\n";
 188     print FH2 "</div>";
 189   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=gt\&\#45\;pj\&\#45\;([0-9]{1,2}):([0-9A-F]{4})/){
 190     $left = int($1 / $rate) + $x;
 191     $top = int($2 / $rate) + $y;
 192     $number = sprintf("%02d", $3);
 193     print FH2 "<div class=\"gt$number\" style=\"top: $top; left: $left;\">";
 194     $char = $4;
 195     $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 196     Encode::from_to($char, 'jis0208-raw', 'utf-8');
 197     utf8::decode($char);
 198     print FH2 "$char\r\n";
 199     print FH2 "</div>";
 200   } elsif(m/x\=\"([0-9]+)\" y\=\"([0-9]+)\"\>\=gt\&\#45\;pj\&\#45\;(k[12]):([0-9A-F]{4})/){
 201     $left = int($1 / $rate) + $x;
 202     $top = int($2 / $rate) + $y;
 203     print FH2 "<div class=\"gt$3\" style=\"top: $top; left: $left;\">";
 204     $char = $4;
 205     $char =~ s/([0-9A-F]{2})/pack('H2', $1)/eg;
 206     Encode::from_to($char, 'jis0208-raw', 'utf-8');
 207     utf8::decode($char);
 208     print FH2 "$char\r\n";
 209     print FH2 "</div>";
 210   }
 211 }
 212
 213 print FH2 "<map name=\"object\">\n";
 214 seek FH, 0, 0;
 215 $i = 0;
 216 foreach(<FH>){
 217   if($i == 1){
 218     m/points=\"[0-9]+,[0-9]+ ([0-9]+),([0-9]+) [0-9]+,[0-9]+ ([0-9]+),([0-9]+) /;
 219     print FH2 "<area href=\"http://mousai.kanji.zinbun.kyoto-u.ac.jp/char-desc?char=%26u-$target%3B\" shape=\"rect\" coords=\"".int($3 / $rate).", ".int($4 / $rate).", ".int($1 / $rate).", ".int($2 / $rate)."\">\n";
 220     $i = 0;
 221   }
 222   elsif(m/^<g id=\"node[0-9]+\" class=\"node\"><title>(2{0,1}[0-9A-F]{4})<\/title>\n$/){
 223     $target = $1;
 224     $i = 1;
 225   }
 226 }
 227 print FH2 "</map>\n";
 228 close FH;
 229
 230 print FH2 <<EOT;
 231 </body>
 232 </html>
 233 EOT
 234 close FH2;
 235
 236 &close_chise;
 237
 238 #-----------------------------------------------------------------------------
 239 sub process{
 240   my ($buffer, @buffer, $feature);
 241   if(exists($char{$_[0]})){
 242     return;
 243   }
 244
 245   #S-exporession
 246   if($_[0] =~ m/^\(\(/){
 247     $char{$_[0]} .= "$_[0]\\n";
 248     next;
 249   }
 250
 251   #ccs-feature
 252   foreach(@list){
 253     if((substr($_,0,1) eq '=' && substr($_,1,1) ne '>') || $_ eq "morohashi-daikanwa"){
 254       $buffer = get_feature_value($_, $_[0]);
 255       if($buffer ne ""){
 256         if($_ eq "=daikanwa" || $_ eq "=gt" || $_ eq "=gt-k"){
 257           $char{$_[0]} .= sprintf("$_:%05d\\n", $buffer);
 258         #} elsif($_ =~ m/^\=(gt-pj-[0-9]{1,2}|gt-pj-k[12]|big5|big5-cdp|jis-x0208|ks-x1001|ucs|cns11643-[1-9]|gb2312|jis-x0208\@1978|jis-x0208\@1983|jis-x0208\@1990|jis-x0208\@1997|jis-x0212|hanziku-[1-8]|jef-china3)$/){
 259         } elsif($_ =~ m/^\=(gt-pj-[0-9]{1,2}|gt-pj-k[12]|big5|big5-cdp|jis-x0208|ks-x1001|ucs|cns11643-[1-9]|gb2312|jis-x0208\@1978|jis-x0208\@1983|jis-x0208\@1990|jis-x0208\@1997|jis-x0212|jef-china3)$/){
 260           $char{$_[0]} .= sprintf("$_:%X\\n \\n \\n", $buffer);
 261         } elsif($_ =~ m/^\=(zinbun-oracle)$/){
 262           $char{$_[0]} .= sprintf("$_:%X\\n \\n \\n \\n \\n", $buffer);
 263         } elsif($_ eq "morohashi-daikanwa"){
 264           $char{$_[0]} .= "$_:$buffer\\n";
 265         } else {
 266           $char{$_[0]} .= sprintf("$_:%X\\n", $buffer);
 267         }
 268       }
 269     }
 270   }
 271   #goto-feature
 272   foreach(@list){
 273     if(substr($_,0,2) eq '->'){
 274       $buffer = get_feature_value($_, $_[0]);
 275       if($buffer ne ""){
 276         $feature = $_;
 277         @buffer = &parse($buffer);
 278         if(scalar(@buffer) == 0){
 279           next;
 280         }
 281         foreach(@buffer){
 282           if($feature eq "->subsumptive" || $feature eq "->denotational"){
 283             $family{$_[0]} .= "$_,";
 284             &process($_);
 285           } else {
 286             $feature =~ s/->//;
 287             $link{$_[0]."-".$_} .= $feature."\\n";
 288             &process($_);
 289           }
 290         }
 291       }
 292     }
 293   }
 294   #comefrom-feature
 295   foreach(@list){
 296     if(substr($_,0,2) eq '<-'){
 297       $buffer = get_feature_value($_, $_[0]);
 298       if($buffer ne ""){
 299         $feature = $_;
 300         @buffer = &parse($buffer);
 301         if(scalar(@buffer) == 0){
 302           next;
 303         }
 304         foreach(@buffer){
 305           #$link{$_."-".$_[0]} .= $feature."\\n";
 306           &process($_);
 307         }
 308       }
 309     }
 310   }
 311   #nearlyequal-feature
 312   foreach(@list){
 313     if(substr($_,0,2) eq '=>'){
 314       $buffer = get_feature_value($_, $_[0]);
 315       if($buffer ne ""){
 316         $feature = $_;
 317         @buffer = &parse($buffer);
 318         if(scalar(@buffer) == 0){
 319           next;
 320         }
 321         foreach(@buffer){
 322           $link{$_."-".$_[0]} .= $feature."\\n";
 323           &process($_);
 324         }
 325       }
 326     }
 327   }
 328 }
 329
 330 sub parse{
 331   my $target = $_[0];
 332   my (@temp, @temp2);
 333   utf8::decode($target);
 334   if(substr($target,0,1) eq '('){
 335     if(substr($target,0,2) eq '(('){ # feature is S-expression
 336       push(@temp2, substr($target,1,length($substr)-1));
 337     } else {
 338       @temp = split(/ /, substr($target, 1, length($target) - 2));
 339       foreach(@temp){
 340         push(@temp2, unpack('U*', substr($_, 1)));
 341       }
 342     }
 343     return @temp2;
 344   } else{
 345   }
 346 }
 347
 348 sub ireko{
 349   my @temp = split(/,/, $family{$_[0]});
 350   printf FH "\t"x$_[1]."subgraph cluster%X\ {\n", $_[0];
 351   if($_[1] == 1){
 352     printf FH "\t\t\"%X\" [ color = white ];\n", $_[0];
 353   } else {
 354     printf FH "\t"x($_[1] + 1)."style = filled; color = gray%d;\n", 100 - ($_[1] - 1) * 20;
 355     printf FH "\t"x($_[1] + 1)."\"%X\" [ color = gray%d ];\n", $_[0], 100 - ($_[1] - 1) * 20;
 356   }
 357   foreach(@temp){
 358     if(exists($family{$_})){
 359       &ireko($_, $_[1]+1);
 360     } else{
 361       printf FH "\t"x($_[1] + 1)."\"%X\";\n", $_;
 362     }
 363   }
 364   print FH "\t"x$_[1]."}\n";
 365 }
 366 #-----------------------------------------------------------------------------