lisp/mule/thai-xtis.el

   1 ;;; thai-xtis.el --- Thai support for pre-composed font (for XTIS).
   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   (make-charset 'thai-xtis "Precomposed Thai (XTIS by Virach)."
  39                 '(registry "xtis-0"
  40                            dimension 2
  41                            columns 1
  42                            chars 94
  43                            final ??
  44                            graphic 0))
  45
  46   (modify-syntax-entry 'thai-xtis "w")
  47
  48   (define-category ?x "Precomposed Thai character.")
  49   (modify-category-entry 'thai-xtis ?x)
  50
  51   (let ((deflist        '(;; chars      syntax
  52                           ("\e$(?!0\e(B-\e$(?NxP0R0S0`0\e(B-\e$(?e0\e(B"      "w")
  53                           ("\e$(?p0\e(B-\e$(?y0\e(B"        "w")
  54                           ("\e$(?O0f0_0o0z0{0\e(B"        "_")
  55                           ))
  56         elm chars len syntax category to ch i)
  57     (while deflist
  58       (setq elm (car deflist))
  59       (setq chars (car elm)
  60             len (length chars)
  61             syntax (nth 1 elm)
  62             i 0)
  63       (while (< i len)
  64         (if (= (aref chars i) ?-)
  65             (setq i (1+ i)
  66                   to (nth 1 (split-char (aref chars i))))
  67           (setq ch (nth 1 (split-char (aref chars i)))
  68                 to ch))
  69         (while (<= ch to)
  70           (modify-syntax-entry (vector 'thai-xtis ch) syntax)
  71           (setq ch (1+ ch)))
  72         (setq i (1+ i)))
  73       (setq deflist (cdr deflist))))
  74
  75   (put-charset-property 'thai-xtis 'preferred-coding-system 'tis-620)
  76   )
  77
  78 ;; This is the ccl-decode-thai-xtis automaton.
  79 ;;
  80 ;; "WRITE x y" == (insert (make-char 'thai-xtis x y))
  81 ;; "write x" == (insert x)
  82 ;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx)
  83 ;; r3 == "no vower nor tone"
  84 ;; r4 == (charset-id 'thai-xtis)
  85 ;;
  86 ;;          |               input (= r0)
  87 ;;   state  |--------------------------------------------
  88 ;;          |  consonant  |    vowel    |    tone
  89 ;; ---------+-------------+-------------+----------------
  90 ;;  r1 == 0 | r1 = r0     | WRITE r0,r3 | WRITE r0,r3
  91 ;;  r2 == 0 |             |             |
  92 ;; ---------+-------------+-------------+----------------
  93 ;;  r1 == C | WRITE r1,r3 | r2 = r0'    | WRITE r1,r3|r0'
  94 ;;  r2 == 0 | r1 = r0     |             | r1 = 0
  95 ;; ---------+-------------+-------------+----------------
  96 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0'
  97 ;;  r2 == V | r1 = r0     | WRITE r0,r3 | r1 = r2 = 0
  98 ;;          | r2 = 0      | r1 = r2 = 0 |
  99 ;;
 100 ;;
 101 ;;          |               input (= r0)
 102 ;;   state  |-----------------------------------------
 103 ;;          |    symbol   |    ASCII    |     EOF
 104 ;; ---------+-------------+-------------+-------------
 105 ;;  r1 == 0 | WRITE r0,r3 | write r0    |
 106 ;;  r2 == 0 |             |             |
 107 ;; ---------+-------------+-------------+-------------
 108 ;;  r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3
 109 ;;  r2 == 0 | WRITE r0,r3 | write r0    |
 110 ;;          | r1 = 0      | r1 = 0      |
 111 ;; ---------+-------------+-------------+-------------
 112 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2
 113 ;;  r2 == V | WRITE r0,r3 | write r0    |
 114 ;;          | r1 = r2 = 0 | r1 = r2 = 0 |
 115
 116
 117 (eval-and-compile
 118
 119 ;; input  : r5 = 1st byte, r6 = 2nd byte
 120 ;; Their values will be destroyed.
 121 (define-ccl-program ccl-thai-xtis-write
 122   '(0
 123     ((r5 = ((r5 & #x7F) << 7))
 124      (r6 = ((r6 & #x7F) | r5))
 125      (write-multibyte-character r4 r6))))
 126
 127 (define-ccl-program ccl-thai-xtis-consonant
 128   '(0
 129     (if (r1 == 0)
 130         (r1 = r0)
 131       (if (r2 == 0)
 132           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 133            (r1 = r0))
 134         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 135          (r1 = r0)
 136          (r2 = 0))))))
 137
 138 (define-ccl-program ccl-thai-xtis-vowel
 139   '(0
 140     ((if (r1 == 0)
 141          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 142        ((if (r2 == 0)
 143             (r2 = ((r0 - 204) << 3))
 144           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 145            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 146            (r1 = 0)
 147            (r2 = 0))))))))
 148
 149 (define-ccl-program ccl-thai-xtis-vowel-d1
 150   '(0
 151     ((if (r1 == 0)
 152          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 153        ((if (r2 == 0)
 154             (r2 = #x38)
 155           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 156            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 157            (r1 = 0)
 158            (r2 = 0))))))))
 159
 160 (define-ccl-program ccl-thai-xtis-vowel-ee
 161   '(0
 162     ((if (r1 == 0)
 163          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 164        ((if (r2 == 0)
 165             (r2 = #x78)
 166           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 167            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 168            (r1 = 0)
 169            (r2 = 0))))))))
 170
 171 (define-ccl-program ccl-thai-xtis-tone
 172   '(0
 173     (if (r1 == 0)
 174         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 175       (if (r2 == 0)
 176           ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write)
 177            (r1 = 0))
 178         ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write)
 179          (r1 = 0)
 180          (r2 = 0))))))
 181
 182 (define-ccl-program ccl-thai-xtis-symbol
 183   '(0
 184     (if (r1 == 0)
 185         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 186       (if (r2 == 0)
 187           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 188            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 189            (r1 = 0))
 190         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 191          (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 192          (r1 = 0)
 193          (r2 = 0))))))
 194
 195 (define-ccl-program ccl-thai-xtis-ascii
 196   '(0
 197     (if (r1 == 0)
 198         (write r0)
 199       (if (r2 == 0)
 200           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 201            (write r0)
 202            (r1 = 0))
 203         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 204          (write r0)
 205          (r1 = 0)
 206          (r2 = 0))))))
 207
 208 (define-ccl-program ccl-thai-xtis-eof
 209   '(0
 210     (if (r1 != 0)
 211         (if (r2 == 0)
 212             ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write))
 213           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write))))))
 214
 215 (define-ccl-program ccl-decode-thai-xtis
 216   `(4
 217     ((read r0)
 218      (r1 = 0)
 219      (r2 = 0)
 220      (r3 = #x30)
 221      (r4 = ,(charset-id 'thai-xtis))
 222      (loop
 223       (if (r0 < 161)
 224           (call ccl-thai-xtis-ascii)
 225         (branch (r0 - 161)
 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-consonant)
 249                 (call ccl-thai-xtis-consonant)
 250                 (call ccl-thai-xtis-consonant)
 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-consonant)
 260                 (call ccl-thai-xtis-consonant)
 261                 (call ccl-thai-xtis-symbol)
 262                 (call ccl-thai-xtis-consonant)
 263                 (call ccl-thai-xtis-symbol)
 264                 (call ccl-thai-xtis-consonant)
 265                 (call ccl-thai-xtis-consonant)
 266                 (call ccl-thai-xtis-consonant)
 267                 (call ccl-thai-xtis-consonant)
 268                 (call ccl-thai-xtis-consonant)
 269                 (call ccl-thai-xtis-consonant)
 270                 (call ccl-thai-xtis-consonant)
 271                 (call ccl-thai-xtis-consonant)
 272                 (call ccl-thai-xtis-symbol)
 273                 (call ccl-thai-xtis-symbol)
 274                 (call ccl-thai-xtis-vowel-d1)
 275                 (call ccl-thai-xtis-symbol)
 276                 (call ccl-thai-xtis-symbol)
 277                 (call ccl-thai-xtis-vowel)
 278                 (call ccl-thai-xtis-vowel)
 279                 (call ccl-thai-xtis-vowel)
 280                 (call ccl-thai-xtis-vowel)
 281                 (call ccl-thai-xtis-vowel)
 282                 (call ccl-thai-xtis-vowel)
 283                 (call ccl-thai-xtis-vowel)
 284                 nil
 285                 nil
 286                 nil
 287                 nil
 288                 (call ccl-thai-xtis-symbol)
 289                 (call ccl-thai-xtis-symbol)
 290                 (call ccl-thai-xtis-symbol)
 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-tone)
 297                 (call ccl-thai-xtis-tone)
 298                 (call ccl-thai-xtis-tone)
 299                 (call ccl-thai-xtis-tone)
 300                 (call ccl-thai-xtis-tone)
 301                 (call ccl-thai-xtis-tone)
 302                 (call ccl-thai-xtis-tone)
 303                 (call ccl-thai-xtis-vowel-ee)
 304                 (call ccl-thai-xtis-symbol)
 305                 (call ccl-thai-xtis-symbol)
 306                 (call ccl-thai-xtis-symbol)
 307                 (call ccl-thai-xtis-symbol)
 308                 (call ccl-thai-xtis-symbol)
 309                 (call ccl-thai-xtis-symbol)
 310                 (call ccl-thai-xtis-symbol)
 311                 (call ccl-thai-xtis-symbol)
 312                 (call ccl-thai-xtis-symbol)
 313                 (call ccl-thai-xtis-symbol)
 314                 (call ccl-thai-xtis-symbol)
 315                 (call ccl-thai-xtis-symbol)
 316                 (call ccl-thai-xtis-symbol)
 317                 nil
 318                 nil
 319                 nil))
 320       (read r0)
 321       (repeat)))
 322
 323     (call ccl-thai-xtis-eof)))
 324
 325 )
 326
 327 (defconst leading-code-private-21 #x9F)
 328
 329 (define-ccl-program ccl-encode-thai-xtis
 330   `(1
 331     ((read r0)
 332      (loop
 333       (if (r0 == ,leading-code-private-21)
 334           ((read r1)
 335            (if (r1 == ,(charset-id 'thai-xtis))
 336                ((read r0)
 337                 (write r0)
 338                 (read r0)
 339                 (r1 = (r0 & 7))
 340                 (r0 = ((r0 - #xB0) >> 3))
 341                 (if (r0 != 0)
 342                     (write r0 [0 209 212 213 214 215 216 217 218 238]))
 343                 (if (r1 != 0)
 344                     (write r1 [0 231 232 233 234 235 236 237]))
 345                 (read r0)
 346                 (repeat))
 347              ((write r0 r1)
 348               (read r0)
 349               (repeat))))
 350         (write-read-repeat r0))))))
 351
 352 (if (featurep 'xemacs)
 353     (make-coding-system
 354      'tis-620 'ccl
 355      "external=tis620, internal=thai-xtis"
 356      `(mnemonic "TIS620"
 357        decode ,ccl-decode-thai-xtis
 358        encode ,ccl-encode-thai-xtis))
 359   (make-coding-system
 360    'tis-620 4 ?T "external=tis620, internal=thai-xtis"
 361    '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
 362    '((safe-charsets . t)))
 363   )
 364
 365
 366 (set-language-info-alist
 367  "Thai-XTIS"
 368  '((setup-function . setup-thai-xtis-environment)
 369    (exit-function . exit-thai-xtis-environment)
 370    (charset thai-xtis)
 371    (coding-system tis-620 iso-2022-7bit)
 372    (coding-priority tis-620 iso-2022-7bit)
 373    (sample-text . "\e$(?!:\e(B")
 374    (documentation . t)))
 375
 376 ;; thai-xtis.el ends here.