;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; -*-
;;;
;;;   Touched: Thu Jan 11 10:19:24 2007 +0530 <enometh@net.meer>
;;;   Time-stamp: <07/01/10 22:41:32 madhu>
;;;   Copyright 2007 (C) Madhu. All Rights Reserved
;;;   Bugs-To: <enometh@net.meer>

(defpackage "ITRANS-SKT"
  (:use "CL")
  (:export "OUTPUT-SKT"))

(in-package "ITRANS-SKT")

(defvar *itrans-skt-map*
  '((TOK:A (SKTCHAR:|a|)) (TOK:AA (SKTCHAR:|aa|)) (TOK:I (SKTCHAR:|i|))
    (TOK:II (SKTCHAR:|ii|)) (TOK:U (SKTCHAR:|u|)) (TOK:UU (SKTCHAR:|uu|))
    (TOK:RI (SKTCHAR:|.r|)) (TOK:RII (SKTCHAR:|.r.r|)) (TOK:LI (SKTCHAR:|.l|))
    (TOK:LII (SKTCHAR:|e|)) (TOK:AY (SKTCHAR:|e|)) (TOK:AI (SKTCHAR:|ai|))
    (TOK:O (SKTCHAR:|o|)) (TOK:AU (SKTCHAR:|au|)) (TOK:AHA (SKTCHAR:|.h|))
    (TOK:KA (SKTCHAR:|k|)) (TOK:KHA (SKTCHAR:|kh|)) (TOK:GA (SKTCHAR:|g|))
    (TOK:GHA (SKTCHAR:|gh|)) (TOK:NGA (SKTCHAR:|"n|)) (TOK:CHA (SKTCHAR:|c|))
    (TOK:CHHA (SKTCHAR:|ch|)) (TOK:JA (SKTCHAR:|j|)) (TOK:JHA (SKTCHAR:|jh|))
    (TOK:JNH (SKTCHAR:|~n|)) (TOK:TTA (SKTCHAR:|.t|))
    (TOK:TTHA (SKTCHAR:|.th|)) (TOK:DDA (SKTCHAR:|.d|))
    (TOK:DDHA (SKTCHAR:|.dh|)) (TOK:NNA (SKTCHAR:|.n|)) (TOK:TA (SKTCHAR:|t|))
    (TOK:THA (SKTCHAR:|th|)) (TOK:DA (SKTCHAR:|d|)) (TOK:DHA (SKTCHAR:|dh|))
    (TOK:NA (SKTCHAR:|n|)) (TOK:PA (SKTCHAR:|p|)) (TOK:PHA (SKTCHAR:|ph|))
    (TOK:BA (SKTCHAR:|b|)) (TOK:BHA (SKTCHAR:|bh|)) (TOK:MA (SKTCHAR:|m|))
    (TOK:YA (SKTCHAR:|y|)) (TOK:RA (SKTCHAR:|r|)) (TOK:LA (SKTCHAR:|l|))
    (TOK:VA (SKTCHAR:|v|)) (TOK:SHA (SKTCHAR:|"s|)) (TOK:SHHA (SKTCHAR:|.s|))
    (TOK:SA (SKTCHAR:|s|)) (TOK:HA (SKTCHAR:|h|))
    (TOK:KSHA (SKTCHAR:|k| SKTCHAR:|.s|)) (TOK:GYA (SKTCHAR:|j| SKTCHAR:|~n|))
    (TOK:ANUSVARA (SKTCHAR:|.m|))
    (TOK:VIRAAM ('SKTCHAR::|\||))	; XXX
    (TOK:AVAGRAHA (SKTCHAR:|.a|)) (TOK:AUM (SKTCHAR:|.o|))))

(loop for (tok props) in *itrans-skt-map*
      do (setf (get tok :skt) props))

(defmacro define-itrans-skt-lexer nil
  `(clex:deflexer ITRANS-SKT nil
    ,@(loop for token being the external-symbols of :TOK
	    for type = (get token :type) and names = (get token :names)
	    nconc (mapcar #'(lambda (name)
			      `(,name (return (values ,type ',token)))) names))
    (#\Tab     (return (values :punctuation #\Tab)))
    (#\Space   (return (values :punctuation #\Space)))
    (#\Newline (return (values :punctuation #\Newline)))
    (#\.       (return (values :punctuation #\.)))
    (#\\       (return (values :punctuation #\\)))
    (#\(	(return (values :punctuation #\()))
    (#\)	(return (values :punctuation #\))))
    ((or "0123456789")
     (return (values :punctuation (schar clex:bag 0))))))

(define-itrans-skt-lexer)


(defun parse-itrans-line (line &key (start 0) end)
  (with-input-from-string (stream line :start start :end end)
    (let ((lexer (make-ITRANS-SKT-lexer stream)))
      (loop with bag = nil  do
	    (multiple-value-bind (cat token) (funcall lexer)
	      (when (eq cat :eof) (return bag))
	      (setq bag (nconc bag (list (cons token cat)))))))))


(defun output-skt (itrans-line &key (start 0) end (stream *standard-output*))
  (loop for (tok . cat) in
	(parse-itrans-line itrans-line :start start :end end)
	do (ecase cat
	     ((:vowel :consonant :special)
	      (mapcar (lambda (sktchar)
			(write-string (symbol-name sktchar) stream)
			sktchar)
		      (get tok :skt)))
	     (:punctuation
	      (write-char tok stream)
	      (list tok)))))


#||
(setq $line  "karmaNyevaadhikaaraste maa phaleshhu kadaachana .")
(setq $line  "ruddhvA cha vivashA dInA rAkShasIbhiH surakShitA .. 11..\\\\")
(setq $line  "ruddhvA cha vivashA dInA rAkShasIbhiH surakShitA .. 11..\\\\")
(output-skt $line)
||#