Discussion module:sinogramme

Code en perl

@radicals = (
	'一', '丨', '丶', '丿', '乙', '亅', '二', '亠', '人', '儿',
	'入', '八', '冂', '冖', '冫', '几', '凵', '刀', '力', '勹',
	'匕', '匚', '匸', '十', '卜', '卩', '厂', '厶', '又', '口',
	'囗', '土', '士', '夂', '夊', '夕', '大', '女', '子', '宀',
	'寸', '小', '尢', '尸', '屮', '山', '巛', '工', '己', '巾',
	'干', '幺', '广', '廴', '廾', '弋', '弓', '彐', '彡', '彳',
	'心', '戈', '戶', '手', '支', '攴', '文', '斗', '斤', '方',
	'无', '日', '曰', '月', '木', '欠', '止', '歹', '殳', '毋',
	'比', '毛', '氏', '气', '水', '火', '爪', '父', '爻', '爿',
	'片', '牙', '牛', '犬', '玄', '玉', '瓜', '瓦', '甘', '生',
	'用', '田', '疋', '疒', '癶', '白', '皮', '皿', '目', '矛',
	'矢', '石', '示', '禸', '禾', '穴', '立', '竹', '米', '糸',
	'缶', '网', '羊', '羽', '老', '而', '耒', '耳', '聿', '肉',
	'臣', '自', '至', '臼', '舌', '舛', '舟', '艮', '色', '艸',
	'虍', '虫', '血', '行', '衣', '襾', '見', '角', '言', '谷',
	'豆', '豕', '豸', '貝', '赤', '走', '足', '身', '車', '辛',
	'辰', '辵', '邑', '酉', '釆', '里', '金', '長', '門', '阜',
	'隶', '隹', '雨', '靑', '非', '面', '革', '韋', '韭', '音',
	'頁', '風', '飛', '食', '首', '香', '馬', '骨', '高', '髟',
	'鬥', '鬯', '鬲', '鬼', '魚', '鳥', '鹵', '鹿', '麥', '麻',
	'黃', '黍', '黑', '黹', '黽', '鼎', '鼓', '鼠', '鼻', '齊',
	'齒', '龍', '龜', '龠');

open(FILE, 'Unihan_IRGSources.txt') || die 'cannot open file, stopped';

while (<FILE>)
{  if (/^U\+(.*?)\tkRSUnicode\t(\d+)'?\.(\d+)/)
   {  $char = hex($1);
      $rad = $2;
      $stroke = $3;

      $file_index = int($char / 0x1000);
      if (!$dest[$file_index])
      {  $filename = sprintf("stroke_count_0x%x.txt", $file_index * 0x1000);
	 local *DEST;
	 open(DEST, ">$filename") || die "cannot open $filename, stopped";
	 $dest[$file_index] = *DEST;
	 print STDERR "$filename opened\n";	 
      }

      printf { $dest[$file_index] } "\t['%s'] = '%s%02d', -- U+%04X\n", &utf8($char), $radicals[$rad - 1], $stroke, $char;
   }
}

exit 0;

sub utf8
{  local($unicode) = @_;
   $unicode = $unicode + 0;

#   0x00000000 - 0x0000007F:
#       0xxxxxxx
#   0x00000080 - 0x000007FF:
#       110xxxxx 10xxxxxx
#   0x00000800 - 0x0000FFFF:
#       1110xxxx 10xxxxxx 10xxxxxx
#   0x00010000 - 0x001FFFFF:
#       11110xxx 10xxxxxx 10xxxxxx 10xxxxxx

   if ($unicode <= 0x7f)
   {  chr($unicode);
   }
   elsif ($unicode <= 0x7ff)
   {  pack('CC',
	   0xc0 | (($unicode >> 6) & 0x1f),
	   0x80 | ($unicode & 0x3f));
   }
   elsif ($unicode <= 0xffff)
   {  pack('CCC',
	   0xe0 | (($unicode >> 12) & 0x0f),
	   0x80 | (($unicode >> 6) & 0x3f),
	   0x80 | ($unicode & 0x3f));
   }
   elsif ($unicode <= 0x10ffff) # Unicode max
   {  pack('CCCC',
	   0xf0 | (($unicode >> 18) & 0x07),
	   0x80 | (($unicode >> 12) & 0x3f),
	   0x80 | (($unicode >> 6) & 0x3f),
	   0x80 | ($unicode & 0x3f));
   }
}

— TAKASUGI Shinji (d) 3 novembre 2015 à 14:35 (UTC)