#| 
   Russian transcription (according to IPA).
   
   Author: Dmitri Hrapof <yavannadil@yahoo.com>
   Version: 0.4
   Copyright (C) 2006 Dmitri Hrapof

This file is part of Geiriadur.

Geiriadur is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

Geiriadur is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Geiriadur; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  
|#

(in-package geiriadur)

(defparameter *bel-table*
  `(("([шщцчж])ь$" . "\\1") ("г([кч])" . "х\\1") ("здн" . "зн")
    ("б$" . "п") ("в$" . "ф") ("г$" . "к") ("д$" . "т") ("ж$" . "ш") 
    ("з$" . "с") 
    ("б([пктшсч])" . "п\\1") ("в([пктшсч])" . "ф\\1") ("г([пктшсч])" . "к\\1") 
    ("д([пктшсч])" . "т\\1") ("ж([пктшсч])" . "ш\\1") ("з([пктшсч])" . "с\\1") 
    ("п([бгджз])" . "б\\1") ("к([бгджз])" . "г\\1") ("т([бгджз])" . "д\\1")
    ("ш([бгджз])" . "ж\\1") ("с([бгджз])" . "з\\1")
    ("ться" . "ца") ("тс" . "ц") ("[дт]ц" . "ц") ("сч" . "щ")
    ("([жшц])и" . "\\1ы") ("([жшц])е" . "\\1э")
    ("([чщ])у" . "\\1ю") ("([чщ])а" . "\\1я")
    ("([жшц])И" . "\\1Ы") ("([жшц])Е" . "\\1Э")
    ("([чщ])У" . "\\1Ю") ("([чщ])А" . "\\1Я")))

(defparameter *ipa-table*
  `(("([ао])([бвгджзйклмнпрстфхцчшщъь]+)([АЕИОУЫЭЮЯЁ])" . "ʌ\\2\\3")
    ("([бвгдзклмнпрстфх])ь" . "\\1ʲ")
    ("б" . "b") ("в" . "v") ("г" . "g") ("д" . "d") ("ж" . "ʐ") ("з" . "z") 
    ("й" . "j") ("к" . "k") ("л" . "l") ("м" . "m") ("н" . "n") ("п" . "p") 
    ("р" . "r") ("с" . "s") ("т" . "t")  ("ф" . "f") ("х" . "х") ("ц" . "ʦ") 
    ("ч" . "ʧ") ("ш" . "ʂ") ("щ" . "ɕ") ("ъ" . "ъj") ("ь" . "ʲ")
    ("А" . "'a") ("Е" . "'ʲɛ") ("И" . "'ʲi") ("О" . "'o") ("У" . "'u")
    ("Ы" . "'ɨ") ("Э" . "'ɛ") ("Ю" . "'ʲu") ("Я" . "'ʲa") ("Ё" . "'ʲo")
    ("а" . "ə") ("е" . "ʲə") ("и" . "ʲɪ") ("о" . "ə") ("у" . "u")
    ("ы" . "ɨ") ("э" . "ə") ("ю" . "ʲu") ("я" . "ʲə")))

(defparameter *vsp-table*
  `(("([bvgdʐzjklmnprstfхʦʧʂɕ])'" . "'\\1") ("^([']*)ʲ([uɛoaə])" . "\\1j\\2") 
    ("^([']*)ʲ([iɪ])" . "\\1\\2") 
    ("([uɛoаəiɪɨʲ])([']*)ʲ" . "\\1\\2j") ; <- правильный?
    ("^([bvgdʐzjklmnprstfхʦʧʂɕ]+)'" . "'\\1") ("jʲ" . "ʲj") 
    ("ъ([']*)ʲ" . "\\1") ("([ʐʦʂʧɕ])ʲ" . "\\1") 
    ("ɛ([bvgdʐzjklmnprstfхʦʧʂɕ]ʲ)" . "e\\1")
    ("([uɛeoaəiɪɨ])ʲ([iɪɨj])" . "\\1\\2")
    ("([uɛeoaəiɪɨ])ʲ([uɛeoaə])" . "\\1j\\2")
))

(defparameter *the-table*
  (mapcar #'(lambda (p) (cons (cl-ppcre:create-scanner (car p)) (cdr p)))
	  (append *bel-table* *ipa-table* *vsp-table*)))

(defun process (table word)
  (reduce #'(lambda (str p) (cl-ppcre:regex-replace-all (car p) str (cdr p)))
	  table :initial-value word))

(defun transcribe (word) (process *the-table* word))

#|
(defun transcriball ()
  (let ((conn *conn*))
    (doquery 
     tuple ("select * from s where lang=0 and pron is not null")
     (db-exec 
      *conn* (format nil "update s set pron=~/gdr:stroqa/ where id=~a"
		     (transcribe (sixth tuple)) (first tuple))))))
|#