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 ?T "Precomposed Thai character.")
  49   (modify-category-entry 'thai-xtis ?T)
  50   )
  51
  52 ;; This is the ccl-decode-thai-xtis automaton.
  53 ;;
  54 ;; "WRITE x y" == (insert (make-char 'thai-xtis x y))
  55 ;; "write x" == (insert x)
  56 ;; rx' == (tis620-to-thai-xtis-second-byte-bitpattern rx)
  57 ;; r3 == "no vower nor tone"
  58 ;; r4 == (charset-id 'thai-xtis)
  59 ;;
  60 ;;          |               input (= r0)
  61 ;;   state  |--------------------------------------------
  62 ;;          |  consonant  |    vowel    |    tone
  63 ;; ---------+-------------+-------------+----------------
  64 ;;  r1 == 0 | r1 = r0     | WRITE r0,r3 | WRITE r0,r3
  65 ;;  r2 == 0 |             |             |
  66 ;; ---------+-------------+-------------+----------------
  67 ;;  r1 == C | WRITE r1,r3 | r2 = r0'    | WRITE r1,r3|r0'
  68 ;;  r2 == 0 | r1 = r0     |             | r1 = 0
  69 ;; ---------+-------------+-------------+----------------
  70 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2|r0'
  71 ;;  r2 == V | r1 = r0     | WRITE r0,r3 | r1 = r2 = 0
  72 ;;          | r2 = 0      | r1 = r2 = 0 |
  73 ;;
  74 ;;
  75 ;;          |               input (= r0)
  76 ;;   state  |-----------------------------------------
  77 ;;          |    symbol   |    ASCII    |     EOF
  78 ;; ---------+-------------+-------------+-------------
  79 ;;  r1 == 0 | WRITE r0,r3 | write r0    |
  80 ;;  r2 == 0 |             |             |
  81 ;; ---------+-------------+-------------+-------------
  82 ;;  r1 == C | WRITE r1,r3 | WRITE r1,r3 | WRITE r1,r3
  83 ;;  r2 == 0 | WRITE r0,r3 | write r0    |
  84 ;;          | r1 = 0      | r1 = 0      |
  85 ;; ---------+-------------+-------------+-------------
  86 ;;  r1 == C | WRITE r1,r2 | WRITE r1,r2 | WRITE r1,r2
  87 ;;  r2 == V | WRITE r0,r3 | write r0    |
  88 ;;          | r1 = r2 = 0 | r1 = r2 = 0 |
  89
  90
  91 (eval-and-compile
  92
  93 ;; input  : r5 = 1st byte, r6 = 2nd byte
  94 ;; Their values will be destroyed.
  95 (define-ccl-program ccl-thai-xtis-write
  96   '(0
  97     ((r5 = ((r5 & #x7F) << 7))
  98      (r6 = ((r6 & #x7F) | r5))
  99      (write-multibyte-character r4 r6))))
 100
 101 (define-ccl-program ccl-thai-xtis-consonant
 102   '(0
 103     (if (r1 == 0)
 104         (r1 = r0)
 105       (if (r2 == 0)
 106           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 107            (r1 = r0))
 108         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 109          (r1 = r0)
 110          (r2 = 0))))))
 111
 112 (define-ccl-program ccl-thai-xtis-vowel
 113   '(0
 114     ((if (r1 == 0)
 115          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 116        ((if (r2 == 0)
 117             (r2 = ((r0 - 204) << 3))
 118           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 119            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 120            (r1 = 0)
 121            (r2 = 0))))))))
 122
 123 (define-ccl-program ccl-thai-xtis-vowel-d1
 124   '(0
 125     ((if (r1 == 0)
 126          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 127        ((if (r2 == 0)
 128             (r2 = #x38)
 129           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 130            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 131            (r1 = 0)
 132            (r2 = 0))))))))
 133
 134 (define-ccl-program ccl-thai-xtis-vowel-ee
 135   '(0
 136     ((if (r1 == 0)
 137          ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 138        ((if (r2 == 0)
 139             (r2 = #x78)
 140           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 141            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 142            (r1 = 0)
 143            (r2 = 0))))))))
 144
 145 (define-ccl-program ccl-thai-xtis-tone
 146   '(0
 147     (if (r1 == 0)
 148         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 149       (if (r2 == 0)
 150           ((r5 = r1) (r6 = ((r0 - #xE6) | r3)) (call ccl-thai-xtis-write)
 151            (r1 = 0))
 152         ((r5 = r1) (r6 = ((r0 - #xE6) | r2)) (call ccl-thai-xtis-write)
 153          (r1 = 0)
 154          (r2 = 0))))))
 155
 156 (define-ccl-program ccl-thai-xtis-symbol
 157   '(0
 158     (if (r1 == 0)
 159         ((r5 = r0) (r6 = r3) (call ccl-thai-xtis-write))
 160       (if (r2 == 0)
 161           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 162            (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 163            (r1 = 0))
 164         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 165          (r5 = r0) (r6 = r3) (call ccl-thai-xtis-write)
 166          (r1 = 0)
 167          (r2 = 0))))))
 168
 169 (define-ccl-program ccl-thai-xtis-ascii
 170   '(0
 171     (if (r1 == 0)
 172         (write r0)
 173       (if (r2 == 0)
 174           ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write)
 175            (write r0)
 176            (r1 = 0))
 177         ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write)
 178          (write r0)
 179          (r1 = 0)
 180          (r2 = 0))))))
 181
 182 (define-ccl-program ccl-thai-xtis-eof
 183   '(0
 184     (if (r1 != 0)
 185         (if (r2 == 0)
 186             ((r5 = r1) (r6 = r3) (call ccl-thai-xtis-write))
 187           ((r5 = r1) (r6 = r2) (call ccl-thai-xtis-write))))))
 188
 189 (define-ccl-program ccl-decode-thai-xtis
 190   `(4
 191     ((read r0)
 192      (r1 = 0)
 193      (r2 = 0)
 194      (r3 = #x30)
 195      (r4 = ,(charset-id 'thai-xtis))
 196      (loop
 197       (if (r0 < 161)
 198           (call ccl-thai-xtis-ascii)
 199         (branch (r0 - 161)
 200                 (call ccl-thai-xtis-consonant)
 201                 (call ccl-thai-xtis-consonant)
 202                 (call ccl-thai-xtis-consonant)
 203                 (call ccl-thai-xtis-consonant)
 204                 (call ccl-thai-xtis-consonant)
 205                 (call ccl-thai-xtis-consonant)
 206                 (call ccl-thai-xtis-consonant)
 207                 (call ccl-thai-xtis-consonant)
 208                 (call ccl-thai-xtis-consonant)
 209                 (call ccl-thai-xtis-consonant)
 210                 (call ccl-thai-xtis-consonant)
 211                 (call ccl-thai-xtis-consonant)
 212                 (call ccl-thai-xtis-consonant)
 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-symbol)
 236                 (call ccl-thai-xtis-consonant)
 237                 (call ccl-thai-xtis-symbol)
 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-symbol)
 247                 (call ccl-thai-xtis-symbol)
 248                 (call ccl-thai-xtis-vowel-d1)
 249                 (call ccl-thai-xtis-symbol)
 250                 (call ccl-thai-xtis-symbol)
 251                 (call ccl-thai-xtis-vowel)
 252                 (call ccl-thai-xtis-vowel)
 253                 (call ccl-thai-xtis-vowel)
 254                 (call ccl-thai-xtis-vowel)
 255                 (call ccl-thai-xtis-vowel)
 256                 (call ccl-thai-xtis-vowel)
 257                 (call ccl-thai-xtis-vowel)
 258                 nil
 259                 nil
 260                 nil
 261                 nil
 262                 (call ccl-thai-xtis-symbol)
 263                 (call ccl-thai-xtis-symbol)
 264                 (call ccl-thai-xtis-symbol)
 265                 (call ccl-thai-xtis-symbol)
 266                 (call ccl-thai-xtis-symbol)
 267                 (call ccl-thai-xtis-symbol)
 268                 (call ccl-thai-xtis-symbol)
 269                 (call ccl-thai-xtis-symbol)
 270                 (call ccl-thai-xtis-tone)
 271                 (call ccl-thai-xtis-tone)
 272                 (call ccl-thai-xtis-tone)
 273                 (call ccl-thai-xtis-tone)
 274                 (call ccl-thai-xtis-tone)
 275                 (call ccl-thai-xtis-tone)
 276                 (call ccl-thai-xtis-tone)
 277                 (call ccl-thai-xtis-vowel-ee)
 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-symbol)
 284                 (call ccl-thai-xtis-symbol)
 285                 (call ccl-thai-xtis-symbol)
 286                 (call ccl-thai-xtis-symbol)
 287                 (call ccl-thai-xtis-symbol)
 288                 (call ccl-thai-xtis-symbol)
 289                 (call ccl-thai-xtis-symbol)
 290                 (call ccl-thai-xtis-symbol)
 291                 nil
 292                 nil
 293                 nil))
 294       (read r0)
 295       (repeat)))
 296
 297     (call ccl-thai-xtis-eof)))
 298
 299 )
 300
 301 (defconst leading-code-private-21 #x9F)
 302
 303 (define-ccl-program ccl-encode-thai-xtis
 304   `(1
 305     ((read r0)
 306      (loop
 307       (if (r0 == ,leading-code-private-21)
 308           ((read r1)
 309            (if (r1 == ,(charset-id 'thai-xtis))
 310                ((read r0)
 311                 (write r0)
 312                 (read r0)
 313                 (r1 = (r0 & 7))
 314                 (r0 = ((r0 - #xB0) >> 3))
 315                 (if (r0 != 0)
 316                     (write r0 [0 209 212 213 214 215 216 217 218 238]))
 317                 (if (r1 != 0)
 318                     (write r1 [0 231 232 233 234 235 236 237]))
 319                 (read r0)
 320                 (repeat))
 321              ((write r0 r1)
 322               (read r0)
 323               (repeat))))
 324         (write-read-repeat r0))))))
 325
 326 (if (featurep 'xemacs)
 327     (make-coding-system
 328      'tis-620 'ccl
 329      "external=tis620, internal=thai-xtis"
 330      `(mnemonic "TIS620"
 331        decode ,ccl-decode-thai-xtis
 332        encode ,ccl-encode-thai-xtis))
 333   (make-coding-system
 334    'tis-620 4 ?T "external=tis620, internal=thai-xtis"
 335    '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
 336    '((safe-charsets . t)))
 337   )
 338
 339
 340 (set-language-info-alist
 341  "Thai-XTIS"
 342  '((setup-function . setup-thai-xtis-environment)
 343    (exit-function . exit-thai-xtis-environment)
 344    (charset thai-xtis)
 345    (coding-system tis-620 iso-2022-7bit)
 346    (coding-priority tis-620 iso-2022-7bit)
 347    (sample-text . "\e$(?!:\e(B")
 348    (documentation . t)))
 349
 350 ;; thai-xtis.el ends here.