(U+6222): Apply new conventions for glyph granularity.
[chise/xemacs-chise.git.1] / lisp / mule / thai-xtis.el
1 ;;; thai-xtis.el --- Support for Thai (XTIS) -*- coding: iso-2022-7bit; -*-
2
3 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation.
5
6 ;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
7 ;;         MORIOKA Tomohiko <tomo@etl.go.jp>
8 ;; Created: 1998-03-27 for Emacs-20.3 by TAKAHASHI Naoto
9 ;;          1999-03-29 imported and modified for XEmacs by MORIOKA Tomohiko
10
11 ;; Keywords: mule, multilingual, Thai, XTIS
12
13 ;; This file is part of XEmacs.
14
15 ;; XEmacs is free software; you can redistribute it and/or modify it
16 ;; under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; any later version.
19
20 ;; XEmacs is distributed in the hope that it will be useful, but
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23 ;; General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
28 ;; 02111-1307, USA.
29
30 ;;; Commentary:
31
32 ;; For Thai, the pre-composed character set proposed by
33 ;; Virach Sornlertlamvanich <virach@links.nectec.or.th> is supported.
34
35 ;;; Code:
36
37 (when (featurep 'xemacs)
38   (let ((deflist        '(;; chars      syntax
39                           ("\e$(?!0\e(B-\e$(?NxP0R0S0`0\e(B-\e$(?e0\e(B"      "w")
40                           ("\e$(?p0\e(B-\e$(?y0\e(B"        "w")
41                           ("\e$(?O0f0_0o0z0{0\e(B"        "_")
42                           ))
43         elm chars len syntax to ch i)
44     (while deflist
45       (setq elm (car deflist))
46       (setq chars (car elm)
47             len (length chars)
48             syntax (nth 1 elm)
49             i 0)
50       (while (< i len)
51         (if (= (aref chars i) ?-)
52             (setq i (1+ i)
53                   to (nth 1 (split-char (aref chars i))))
54           (setq ch (nth 1 (split-char (aref chars i)))
55                 to ch))
56         (while (<= ch to)
57           (modify-syntax-entry (vector 'thai-xtis ch) syntax)
58           (setq ch (1+ ch)))
59         (setq i (1+ i)))
60       (setq deflist (cdr deflist))))
61
62   (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620)
63   )
64
65 ;; This is the ccl-decode-thai-xtis automaton.
66 ;;
67 ;; "WRITE x y" == (insert (make-char 'thai-xtis x y))
68 ;; "write x" == (insert x)
69 ;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx)
70 ;; r3 == "no vower nor tone"
71 ;; r4 == (charset-id 'thai-xtis)
72 ;; 
73 ;;          |               input (= r0)
74 ;;   state  |--------------------------------------------
75 ;;          |  consonant  |    vowel    |    tone
76 ;; ---------+-------------+-------------+----------------
77 ;;  r1 == 0 | r1 = r0     | WRITE r0,r3 | WRITE r0,r3
78 ;;  r2 == 0 |             |             |
79 ;; ---------+-------------+-------------+----------------
80 ;;  r1 == C | WRITE r1,r3 | r2 = r0'    | WRITE r1,r3|r0'
81 ;;  r2 == 0 | r1 = r0     |             | r1 = 0
82 ;; ---------+-------------+-------------+----------------
83 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0'
84 ;;  r2 == V | r1 = r0     | WRITE r0,r3 | r1 = r2 = 0
85 ;;          | r2 = 0      | r1 = r2 = 0 |
86 ;; 
87 ;; 
88 ;;          |               input (= r0) 
89 ;;   state  |-----------------------------------------
90 ;;          |    symbol   |    ASCII    |     EOF
91 ;; ---------+-------------+-------------+-------------
92 ;;  r1 == 0 | WRITE r0,r3 | write r0    |
93 ;;  r2 == 0 |             |             |
94 ;; ---------+-------------+-------------+-------------
95 ;;  r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3
96 ;;  r2 == 0 | WRITE r0,r3 | write r0    |
97 ;;          | r1 = 0      | r1 = 0      |
98 ;; ---------+-------------+-------------+-------------
99 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2
100 ;;  r2 == V | WRITE r0,r3 | write r0    |
101 ;;          | r1 = r2 = 0 | r1 = r2 = 0 |
102
103
104 (eval-and-compile
105
106 ;; input  : r5 = 1st byte, r6 = 2nd byte
107 ;; Their values will be destroyed.
108 (define-ccl-program ccl-thai-xtis-write
109   '(0
110     ((r5 = ((r5 & #x7F) << 7))
111      (r6 = ((r6 & #x7F) | r5))
112      (write-multibyte-character r4 r6))))
113
114 (define-ccl-program ccl-thai-xtis-consonant
115   '(0
116     (if (r1 == 0)
117         (r1 = r0)
118       (if (r2 == 0)
119           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
120            (r1 = r0))
121         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
122          (r1 = r0)
123          (r2 = 0))))))
124
125 (define-ccl-program ccl-thai-xtis-vowel
126   '(0
127     ((if (r1 == 0)
128          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
129        ((if (r2 == 0)
130             (r2 = ((r0 - 204) << 3))
131           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
132            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
133            (r1 = 0)
134            (r2 = 0))))))))
135
136 (define-ccl-program ccl-thai-xtis-vowel-d1
137   '(0
138     ((if (r1 == 0)
139          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
140        ((if (r2 == 0)
141             (r2 = #x38)
142           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
143            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
144            (r1 = 0)
145            (r2 = 0))))))))
146
147 (define-ccl-program ccl-thai-xtis-vowel-ee
148   '(0
149     ((if (r1 == 0)
150          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
151        ((if (r2 == 0)
152             (r2 = #x78)
153           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
154            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
155            (r1 = 0)
156            (r2 = 0))))))))
157
158 (define-ccl-program ccl-thai-xtis-tone
159   '(0
160     (if (r1 == 0)
161         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
162       (if (r2 == 0)
163           ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write)
164            (r1 = 0))
165         ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write)
166          (r1 = 0)
167          (r2 = 0))))))
168
169 (define-ccl-program ccl-thai-xtis-symbol
170   '(0
171     (if (r1 == 0)
172         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
173       (if (r2 == 0)
174           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
175            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
176            (r1 = 0))
177         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
178          (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
179          (r1 = 0)
180          (r2 = 0))))))
181
182 (define-ccl-program ccl-thai-xtis-ascii
183   '(0
184     (if (r1 == 0)
185         (write r0)
186       (if (r2 == 0)
187           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
188            (write r0)
189            (r1 = 0))
190         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
191          (write r0)
192          (r1 = 0)
193          (r2 = 0))))))
194
195 (define-ccl-program ccl-thai-xtis-eof
196   '(0
197     (if (r1 != 0)
198         (if (r2 == 0)
199             ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write))
200           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write))))))
201
202 (define-ccl-program ccl-decode-thai-xtis
203   `(4
204     ((read r0)
205      (r1 = 0)
206      (r2 = 0)
207      (r3 = #x30)
208      (r4 = ,(charset-id 'thai-xtis))
209      (loop
210       (if (r0 < 161)
211           (call ccl-thai-xtis-ascii)
212         (branch (r0 - 161)
213                 (call ccl-thai-xtis-consonant)
214                 (call ccl-thai-xtis-consonant)
215                 (call ccl-thai-xtis-consonant)
216                 (call ccl-thai-xtis-consonant)
217                 (call ccl-thai-xtis-consonant)
218                 (call ccl-thai-xtis-consonant)
219                 (call ccl-thai-xtis-consonant)
220                 (call ccl-thai-xtis-consonant)
221                 (call ccl-thai-xtis-consonant)
222                 (call ccl-thai-xtis-consonant)
223                 (call ccl-thai-xtis-consonant)
224                 (call ccl-thai-xtis-consonant)
225                 (call ccl-thai-xtis-consonant)
226                 (call ccl-thai-xtis-consonant)
227                 (call ccl-thai-xtis-consonant)
228                 (call ccl-thai-xtis-consonant)
229                 (call ccl-thai-xtis-consonant)
230                 (call ccl-thai-xtis-consonant)
231                 (call ccl-thai-xtis-consonant)
232                 (call ccl-thai-xtis-consonant)
233                 (call ccl-thai-xtis-consonant)
234                 (call ccl-thai-xtis-consonant)
235                 (call ccl-thai-xtis-consonant)
236                 (call ccl-thai-xtis-consonant)
237                 (call ccl-thai-xtis-consonant)
238                 (call ccl-thai-xtis-consonant)
239                 (call ccl-thai-xtis-consonant)
240                 (call ccl-thai-xtis-consonant)
241                 (call ccl-thai-xtis-consonant)
242                 (call ccl-thai-xtis-consonant)
243                 (call ccl-thai-xtis-consonant)
244                 (call ccl-thai-xtis-consonant)
245                 (call ccl-thai-xtis-consonant)
246                 (call ccl-thai-xtis-consonant)
247                 (call ccl-thai-xtis-consonant)
248                 (call ccl-thai-xtis-symbol)
249                 (call ccl-thai-xtis-consonant)
250                 (call ccl-thai-xtis-symbol)
251                 (call ccl-thai-xtis-consonant)
252                 (call ccl-thai-xtis-consonant)
253                 (call ccl-thai-xtis-consonant)
254                 (call ccl-thai-xtis-consonant)
255                 (call ccl-thai-xtis-consonant)
256                 (call ccl-thai-xtis-consonant)
257                 (call ccl-thai-xtis-consonant)
258                 (call ccl-thai-xtis-consonant)
259                 (call ccl-thai-xtis-symbol)
260                 (call ccl-thai-xtis-symbol)
261                 (call ccl-thai-xtis-vowel-d1)
262                 (call ccl-thai-xtis-symbol)
263                 (call ccl-thai-xtis-symbol)
264                 (call ccl-thai-xtis-vowel)
265                 (call ccl-thai-xtis-vowel)
266                 (call ccl-thai-xtis-vowel)
267                 (call ccl-thai-xtis-vowel)
268                 (call ccl-thai-xtis-vowel)
269                 (call ccl-thai-xtis-vowel)
270                 (call ccl-thai-xtis-vowel)
271                 nil
272                 nil
273                 nil
274                 nil
275                 (call ccl-thai-xtis-symbol)
276                 (call ccl-thai-xtis-symbol)
277                 (call ccl-thai-xtis-symbol)
278                 (call ccl-thai-xtis-symbol)
279                 (call ccl-thai-xtis-symbol)
280                 (call ccl-thai-xtis-symbol)
281                 (call ccl-thai-xtis-symbol)
282                 (call ccl-thai-xtis-symbol)
283                 (call ccl-thai-xtis-tone)
284                 (call ccl-thai-xtis-tone)
285                 (call ccl-thai-xtis-tone)
286                 (call ccl-thai-xtis-tone)
287                 (call ccl-thai-xtis-tone)
288                 (call ccl-thai-xtis-tone)
289                 (call ccl-thai-xtis-tone)
290                 (call ccl-thai-xtis-vowel-ee)
291                 (call ccl-thai-xtis-symbol)
292                 (call ccl-thai-xtis-symbol)
293                 (call ccl-thai-xtis-symbol)
294                 (call ccl-thai-xtis-symbol)
295                 (call ccl-thai-xtis-symbol)
296                 (call ccl-thai-xtis-symbol)
297                 (call ccl-thai-xtis-symbol)
298                 (call ccl-thai-xtis-symbol)
299                 (call ccl-thai-xtis-symbol)
300                 (call ccl-thai-xtis-symbol)
301                 (call ccl-thai-xtis-symbol)
302                 (call ccl-thai-xtis-symbol)
303                 (call ccl-thai-xtis-symbol)
304                 nil
305                 nil
306                 nil))
307       (read r0)
308       (repeat)))
309
310     (call ccl-thai-xtis-eof)))
311
312 )
313
314 (defconst leading-code-private-21 #x9F)
315
316 (define-ccl-program ccl-encode-thai-xtis
317   `(1
318     ((read r0)
319      (loop
320       (if (r0 == ,leading-code-private-21)
321           ((read r1)
322            (if (r1 == ,(charset-id 'thai-xtis))
323                ((read r0)
324                 (write r0)
325                 (read r0)
326                 (r1 = (r0 & 7))
327                 (r0 = ((r0 - #xB0) >> 3))
328                 (if (r0 != 0)
329                     (write r0 [0 209 212 213 214 215 216 217 218 238]))
330                 (if (r1 != 0)
331                     (write r1 [0 231 232 233 234 235 236 237]))
332                 (read r0)
333                 (repeat))
334              ((write r0 r1)
335               (read r0)
336               (repeat))))
337         (write-read-repeat r0))))))
338
339 (if (featurep 'xemacs)
340     (progn
341       (make-coding-system
342        'tis-620 'ccl
343        "external=tis620, internal=thai-xtis"
344        `(mnemonic "TIS620"
345                   decode ccl-decode-thai-xtis
346                   encode ccl-encode-thai-xtis))
347       (coding-system-put 'tis-620 'category 'iso-8-1))
348   (make-coding-system
349    'tis-620 4 ?T "external=tis620, internal=thai-xtis"
350    '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
351    '((safe-charsets . t)))
352   )
353
354
355 (set-language-info-alist
356  "Thai-XTIS"
357  '((charset thai-xtis)
358    (coding-system tis-620 iso-2022-7bit)
359    (tutorial . "TUTORIAL.th")
360    (tutorial-coding-system . tis-620)
361    (coding-priority tis-620 iso-2022-7bit)
362    (sample-text . "\e$(?!:\e(B")
363    (documentation . t)))
364
365 ;; thai-xtis.el ends here.