--- /dev/null
+# -*- coding: utf-8 -*-
+# Baxter-Segart Old Chinese Reconstruction
+
+# BSOCR = 'PubReleasePY2011-02-20b-2.txt'
+BSOCR = 'BSReconstruction.txt'
+SOURCE = File.join(File.dirname(__FILE__), BSOCR)
+TARGET = File.join(File.dirname(__FILE__), 'bsocr.pl')
+HEADER = ":- module(bsconstruction, [char/6]).\n\n" +
+ "% char(Char, Pinyin1, Mci, Mcf, Mct)\n"
+
+class Converter
+ def initialize
+ @in = File.open(File.join(SOURCE), "r")
+ @out = File.open(File.join(TARGET), "w")
+ end
+ def convert
+ @out.print(HEADER)
+ @in.readlines.each do |line|
+ line.chomp!
+ unless line.empty?
+ (char, pinyin, pinyin1, mc, mci, mcf, mct, oc, gloss, gsr, utf) =
+ line.split(/\t/)
+ mc2 = mc.tr_s("'", "?") # TODO: escape -> adds 'gloss'
+ mci2 = mci.tr_s("'", "?") # TODO: escape -> adds 'gloss'
+ @out.printf("char('%s', '%s', '%s', '%s', '%s', '%s').\n",
+ char, pinyin1, mc2, mci2, mcf, mct) unless mc == "MC"
+
+ end
+ end
+ end
+end
+
+conv = Converter.new
+conv.convert
--- /dev/null
+%-*- Prolog -*-
+% Baxter-Sagart Transcription
+
+:- module(emclib, [mc_concat/4, mc_initial/2, mc_final/2, mc_tone/2,
+ trad_cat/2, ph_cat/2, char/2]).
+:- use_module(bsocr, [char/6]).
+:- use_module(initials, [initial/3, initial/1, palatal/1]).
+:- use_module(finals, [rhyme/5, final/4]).
+
+% mc_concat(+MCI, +MCF, +MCT, -MC)
+mc_concat(MCI, MCF, MCT, MC) :-
+ atom_length_sub(MCI, ILengthSub),
+ atom_length_sub(MCF, FLengthSub),
+ sub_atom(MCI, 0, ILengthSub, _, Initial),
+ sub_atom(MCF, 1, FLengthSub, _, Final),
+ tone_transcription(MCT, ToneTrans),
+ mc_triple_concat(Initial, Final, ToneTrans, MC).
+
+% mc_triple_concat(+Initial, +Final, +ToneTrans, -MC).
+% Initials -y- + Final -j- => -y-
+% Initials -yh- + Final -j- => -yh- ?
+mc_triple_concat(Initial, Final, ToneTrans, MC) :-
+ (atom_suffix(Initial, 'y') ; atom_suffix(Initial, 'yh')),
+ atom_prefix(Final, 'j'), !,
+ atom_split(Final, 'j', Final1), !,
+ atomic_list_concat([Initial, Final1, ToneTrans], MC).
+mc_triple_concat(Initial, Final, ToneTrans, MC) :-
+ atomic_list_concat([Initial, Final, ToneTrans], MC).
+
+% tone_transcription(?ABCD, ?Trancription).
+tone_transcription('A', '').
+tone_transcription('B', 'X').
+tone_transcription('C', 'H').
+tone_transcription('D', '').
+
+% tone_name(?ABCD, ?Name).
+tone_name('A', '平').
+tone_name('B', '上').
+tone_name('C', '去').
+tone_name('D', '入').
+
+% mc_initial(+MC, -MCI).
+mc_initial(MC, MCI) :-
+ mc_initial_sub(MC, I),
+ atom_concat(I, '-', MCI).
+mc_initial_sub(MC, MCI) :-
+ atom_length_sub(MC, MCLengthSub),
+ sub_atom(MC, 0, MCLengthSub, _, MCSub),
+ mc_initial_match(MCSub, MCI).
+mc_initial_match('', _) :- !, fail.
+mc_initial_match(MC, MC) :- initial(MC), !.
+mc_initial_match(MC, MCI) :-
+ mc_initial_sub(MC, MCI).
+
+% mc_final(+MC, -MCF).
+mc_final(MC, MCF) :-
+ mc_final_sub(MC, Final),
+ atom_concat('-', Final, MCF).
+mc_final_sub(MC, Final) :-
+ mc_initial_sub(MC, MCI), !,
+ mc_core_syllable(MC, Core, _),
+ atom_split(Core, MCI, F),
+ palatalized(MCI, F, Final).
+
+% palatalized(+Initial, +F, -Final)
+% TSyF => TSy + jF
+% TSyiF => TSy + iF
+% TSywiF => TSy + iF
+palatalized(_, Final, Final) :-
+ (atom_prefix(Final, 'i'); atom_prefix(Final, 'wi')), !.
+palatalized(Initial, F, Final) :-
+ palatal(Initial), !,
+ atom_concat('j', F, Final).
+palatalized(_, Final, Final).
+
+% mc_tone(+MC, -ABCD).
+mc_tone(MC, T) :-
+ mc_core_syllable(MC, _, T).
+mc_core_syllable(MC, Core, 'B') :-
+ atom_suffix(MC, 'X'), !,
+ atom_length_sub(MC, Lsub),
+ sub_atom(MC, 0, Lsub, _, Core).
+mc_core_syllable(MC, Core, 'C') :-
+ atom_suffix(MC, 'H'), !,
+ atom_length_sub(MC, Lsub),
+ sub_atom(MC, 0, Lsub, _, Core).
+mc_core_syllable(MC, MC, 'D') :-
+ (atom_suffix(MC, 'p') ; atom_suffix(MC, 't') ; atom_suffix(MC, 'k')), !.
+mc_core_syllable(MC, MC, 'A') :- !.
+
+% Phonological Category
+% ph_cat(+Zi, -Cat)
+ph_cat(Zi, Cat) :-
+ char(Zi, MC),
+ trad_cat(MC, Cat).
+char(Zi, MC) :-
+ char(Zi, _, MC, _, _, _).
+
+% Traditional Category
+% trad_cat(+MC, -Cat)
+% TODO: Adds kaikou, division?, and she
+trad_cat(MC, Cat) :-
+ mc_initial_sub(MC, I),
+ mc_final_sub(MC, F),
+ mc_tone(MC, T),
+ initial(I, IName, _),
+ rhyme_name(F, T, FName, Div),
+ tone_name(T, TName),
+ atomic_list_concat([IName, FName, Div, TName], Cat).
+
+% rhyme_name(+Final, +ABCD, -Rhyme, -Division)
+% TODO: final
+rhyme_name(Final, 'A', Rhyme, Div) :- !,
+ final(Final, Name, Div, _),
+ rhyme(Name, Rhyme, _, _, _).
+rhyme_name(Final, 'B', Rhyme, Div) :- !,
+ final(Final, Name, Div, _),
+ rhyme(Name, _, Rhyme, _, _).
+rhyme_name(Final, 'C', Rhyme, Div) :- !,
+ final(Final, Name, Div, _),
+ rhyme(Name, _, _, Rhyme, _).
+rhyme_name(Final, 'D', Rhyme, Div) :- !,
+ final(_, Name, Div, Final),
+ rhyme(Name, _, _, _, Rhyme).
+
+
+%--------------------
+% Utility Predicates
+%--------------------
+
+% atom_length_sub(+Atom, -LP)
+atom_length_sub(Atom, LP) :-
+ atom_length(Atom, Length),
+ LP is Length - 1.
+
+% atom_prefix(+Atom, -Prefix) Duplicated
+% atom_prefix(Atom, Prefix) :-
+% sub_atom(Atom, 0, _, _, Prefix).
+
+% atom_split(+Atom, +Prefix, -Suffix)
+atom_split(Atom, Prefix, Suffix) :-
+ atom_length(Prefix, PLength),
+ sub_atom(Atom, PLength, _, 0, Suffix).
+
+% atom_suffix(+Atom, -Suffix)
+atom_suffix(Atom, Suffix) :-
+ sub_atom(Atom, _, _, 0, Suffix).
\ No newline at end of file
--- /dev/null
+%-*- Prolog -*-
+:- module(finals, [she/2, rhyme/5, final/4]).
+
+% she(+She, -RhymeList).
+% rhyme(Name, ?Ping, ?Sheng, ?Qu, ?Ru)
+% final(?Final, ?Name, ?Division:Int, ?FinalRu)
+
+she('通', ['東', '冬', '鍾']).
+she('江', ['江']).
+she('止', ['支', '脂', '之', '微']).
+she('遇', ['魚', '虞', '模']).
+she('蟹', ['齊', '祭', '泰', '佳', '皆', '夬', '灰', '咍', '廢']).
+
+%% 通攝
+%% 平上去入
+%% 東 董 送 屋
+%% 冬 湩 宋 沃
+%% 鍾 腫 用 燭
+
+rhyme('東', '東', '董', '送', '屋').
+rhyme('冬', '冬', '湩', '宋', '沃').
+rhyme('鍾', '鍾', '腫', '用', '燭').
+
+final('uwng', '東', 1, 'uwk').
+final('owng', '冬', 1, 'owk').
+final('juwng', '東', 3, 'juwk').
+final('jowng', '鐘', 3, 'jowk').
+
+%% 江攝
+%% 平上去入
+%% 江 講 絳 覺
+
+rhyme('江', '江', '講', '絳', '覺').
+final('aewng', '江', 2, 'aewk').
+
+%% 止攝
+%% 平上去入
+%% 支A 紙A 寘A
+%% 支B 紙B 寘B
+%% 脂A 旨A 至A
+%% 脂B 旨B 至B
+%% 之 止 志
+%% 微 尾 未
+
+rhyme('支', '支', '紙', '寘', nil).
+rhyme('脂', '脂', '旨', '至', nil).
+rhyme('之', '之', '止', '志', nil).
+rhyme('微', '微', '尾', '未', nil).
+final(['je', 'jwe', 'jie', 'jwie'], '支', 3, nil).
+final(['ij', 'wij', 'jij', 'jwij'], '脂', 3, nil).
+final('i', '之', 3, nil).
+final(['j+j', 'jw+j'], '微', 3, nil).
+
+%% 遇攝
+%% 平上去入
+%% 魚 語 御
+%% 虞 麌 遇
+%% 模 姥 暮
+
+rhyme('魚', '魚', '語', '御', nil).
+rhyme('虞', '虞', '麌', '遇', nil).
+rhyme('模', '模', '姥', '暮', nil).
+final('u', '模', 1, nil).
+final('jo', '魚', 3, nil).
+final('ju', '虞', 3, nil).
+
+%% 蟹攝
+%% 平上去入
+%% 齊 薺 霽
+%% 祭A
+%% 祭B
+%% 泰
+%% 佳 蟹 卦
+%% 皆 駭 怪
+%% 夬
+%% 灰 賄 隊
+%% 咍 海 代
+%% 廢
+
+rhyme('齊', '齊', '薺', '霽', nil).
+rhyme('祭', nil, nil, '祭', nil).
+rhyme('泰', nil, nil, '泰', nil).
+rhyme('佳', '佳', '蟹', '卦', nil).
+rhyme('皆', '皆', '駭', '怪', nil).
+rhyme('夬', nil, nil, nil, nil).
+rhyme('灰', '灰', '賄', '隊', nil).
+rhyme('咍', '咍', '海', '代', nil).
+rhyme('廢', nil, nil, '廢', nil).
+
+%% 臻攝
+%% 平上去入
+%% 眞A 軫A 震A 質A
+%% 眞B 軫B 震B 質B
+%% 諄 準 稕 術
+%% 臻 𧤛 櫬 櫛
+%% 文 吻 問 物
+%% 欣 隱 焮 迄
+
+she('臻', ['眞', '諄', '臻', '文', '欣']).
+rhyme('眞', '眞', '軫', '震', '質').
+rhyme('諄', '諄', '準', '稕', '術').
+rhyme('臻', '臻', '𧤛', '櫬', '櫛').
+rhyme('文', '文', '吻', '問', '物').
+rhyme('欣', '欣', '隱', '焮', '迄').
+
+%% 山攝
+%% 平上去入
+%% 元 阮 願 月
+%% 臻攝
+%% 平上去入
+%% 魂 混 慁 沒
+%% 痕 很 恨 麧
+%% 山攝
+%% 平上去入
+%% 寒 旱 翰 曷
+%% 桓 緩 換 末
+%% 刪 潸 諫 黠
+%% 山 產 襇 鎋
+%% 先 銑 霰 屑
+%% 仙A 獮A 線A 薛A
+%% 仙B 獮B 線B 薛B
+%% 效攝
+%% 平上去入
+%% 蕭 篠 嘯
+%% 宵A 小A 笑A
+%% 宵B 小B 笑B
+%% 肴 巧 效
+%% 豪 晧 号
+%% 果攝
+%% 平上去入
+%% 歌 哿 箇
+%% 戈 果 過
+%% 麻 馬 禡
+%% 宕攝
+%% 平上去入
+%% 陽 養 漾 藥
+%% 唐 蕩 宕 鐸
+%% 梗攝
+%% 平上去入
+%% 庚 梗 映 陌
+%% 耕 耿 諍 麥
+%% 清 靜 勁 昔
+%% 青 迥 徑 錫
+%% 曾攝
+%% 平上去入
+%% 蒸 拯 證 職
+%% 登 等 嶝 德
+%% 流攝
+%% 平上去入
+%% 尤 有 宥
+%% 侯 厚 候
+%% 幽 黝 幼
+%% 深攝
+%% 平上去入
+%% 侵A 寑A 沁A 緝A
+%% 侵B 寑B 沁B 緝B
+%% 咸攝
+%% 平上去入
+%% 覃 感 勘 合
+%% 談 敢 闞 盍
+%% 鹽A 琰A 豔A 葉A
+%% 鹽B 琰B 豔B 葉B
+%% 添 忝 㮇 怗
+%% 咸 豏 陷 洽
+%% 銜 檻 鑑 狎
+%% 嚴 儼 釅 業
+%% 凡 梵 范 乏
%-*- Prolog -*-
-:- module(middle_chinese, [initial/3, transcript/3, labial/1]).
+:- module(middle_chinese, [initial/3, initial/1, transcript/3,
+ palatal/1, labial/1]).
% Transcriptions Initials
% p ph b m labials
initial('dzr', '崇', 'TSr').
initial('sr', '生', 'TSr').
initial('zr', '俟', 'TSr'). /* no standard name */
-initial('tsy', '章', 'TSy'). % Paratal sibilants 正齒音章組(三等)
+initial('tsy', '章', 'TSy'). % Palatal sibilants 正齒音章組(三等)
initial('tsyh', '昌', 'TSy').
initial('dzy', '禪', 'TSy'). /* 常? */
initial('sy', '書', 'TSy').
initial('y', '喩', 'y').
%initial('hj', '云', 'y'). /* 于? */
%initial('y', '以', 'y').
-%initial('ny', '日', 'y').
+initial('ny', '日', 'TSy'). /* Type? */
initial(X) :- initial(X, _, _).
+% initial(X) :-
+% sub_atom(X, _, _, 0, 'w'), !,
+% atom_length(X, XLength),
+% XL is XLength - 1,
+% sub_atom(X, 0, XL, XL, XPrefix),
+% initial(XPrefix, _, _).
% transcript(Name, Pinyin, EMC)
transcript('幫', 'bang1', 'pang'). % Labials 唇音
transcript('來', 'lai2', 'loj'). % Lateral 半舌音
transcript('', '', '').
-
labial(X) :- initial(X, _, 'P').
dental(X) :- initial(X, _, 'T').
lateral(X) :- initial(X, _, 'l').
retroflex_stop(X) :- initial(X, _, 'Tr').
dental_sibilant(X) :- initial(X, _, 'TS').
-retroflex_sibilant(X) :- initial(X, _, '').
-palatal(X) :- initial(X, _, '').
+retroflex_sibilant(X) :- initial(X, _, 'TSr').
+palatal(X) :- initial(X, _, 'TSy').
+palatal(X) :- initial(X, _, 'y'). /* ? */
velar(X) :- initial(X, _, 'K').
laryngeal(X) :- initial(X, _, '').
--- /dev/null
+%-*- Prolog -*-
+% Tests for emclib
+
+:- module(test_emclib, [list_chars/0, test_mc/0,
+ test_initial/0, test_final/0, test_tone/0,
+ test_cat/0]).
+:- use_module(emclib, [mc_concat/4, mc_initial/2, mc_final/2, mc_tone/2,
+ trad_cat/2, ph_cat/2]).
+:- use_module(bsocr, [char/6]).
+%:- use_module(initials, [initial/3, initial/1, palatal/1]).
+
+list_chars :-
+ char(Z, P, MC, I, F, T),
+ countup(chars),
+ count(chars, N),
+ writef("[%w] %w %w %w %w %w %w\n", [N, Z, P, MC, I, F, T]),
+ fail.
+list_chars :- true.
+
+test_mc :-
+ char(Z, P, MC, I, F, T),
+ countup(mc),
+ count(mc, N),
+ mc_concat(I, F, T, MC1),
+ MC \== MC1,
+ writef("[%w] %w %w %w %w %w %w: ", [N, Z, P, MC, I, F, T]),
+ writef("MC(%w)\n", [MC1]),
+ fail.
+test_mc :- true.
+
+test_initial :-
+ char(Z, P, MC, I, F, T),
+ countup(initial),
+ count(initial, N),
+ mc_initial(MC, I1),
+ I \== I1, !,
+ writef("[%w] %w %w %w %w %w %w: ", [N, Z, P, MC, I, F, T]),
+ writef("I(%w)\n", [I1]),
+ fail.
+test_initial :- true.
+
+test_final :-
+ char(Z, P, MC, I, F, T),
+ countup(final),
+ count(final, N),
+ mc_final(MC, F1),
+ F \== F1, !,
+ writef("[%w] %w %w %w %w %w %w: ", [N, Z, P, MC, I, F, T]),
+ writef("F(%w)\n", [F1]),
+ fail.
+test_final :- true.
+
+test_tone :-
+ char(Z, P, MC, I, F, T),
+ countup(tone),
+ count(tone, N),
+ mc_tone(MC, T1),
+ T \== T1, !,
+ writef("[%w] %w %w %w %w %w %w: ", [N, Z, P, MC, I, F, T]),
+ writef("T(%w)\n", [T1]),
+ fail.
+test_tone :- true.
+
+test_cat :-
+ trad_cat('tuwng', Cat1),
+ writef("tuwng: %w\n", [Cat1]), % 端東1平
+ trad_cat('tuwngX', Cat2),
+ writef("tuwngX: %w\n", [Cat2]), % 端董1上
+ trad_cat('tuwngH', Cat3),
+ writef("tuwngH: %w\n", [Cat3]),% 端送1去
+ trad_cat('tuwk', Cat4),
+ writef("tuwk: %w\n", [Cat4]), % 端屋1入
+ ph_cat('東', '端東1平').
+% trad_cat('towng', Cat5),
+% writef("towng: %w\n", [Cat5]), % 端3平
+
+%----- Utility -----
+countup(Name) :-
+ retract(count(Name, N)), !,
+ M is N + 1,
+ asserta(count(Name, M)).
+countup(Name) :- asserta(count(Name, 0)), !.
OSDN Git Service
