git.chise.org Git - chise/xemacs-chise.git.1/blob - 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                            chars 94
  42                            final ??
  43                            graphic 0))
  44
  45   (modify-syntax-entry 'thai-xtis "w")
  46
  47   (define-category ?T "Precomposed Thai character.")
  48   (modify-category-entry 'thai-xtis ?T)
  49   )
  50
  51
  52 (defvar leading-code-private-21 #x9F)
  53
  54 (defconst thai-xtis-leading-code
  55   (concat (char-to-string leading-code-private-21)
  56           (char-to-string (charset-id 'thai-xtis))))
  57
  58 (define-ccl-program ccl-thai-xtis-consonant
  59   `(0
  60     (if (r1 == 0)
  61         ((write ,thai-xtis-leading-code)
  62          (write r0)
  63          (r1 = r2))
  64       (if (r1 == r2)
  65           ((write r1)
  66            (write ,thai-xtis-leading-code)
  67            (write r0))
  68         ((write r1)
  69          (write ,thai-xtis-leading-code)
  70          (write r0)
  71          (r1 = r2))))))
  72
  73 (define-ccl-program ccl-thai-xtis-vowel-d1
  74   `(0
  75     (if (r1 == 0)
  76         ((write ,thai-xtis-leading-code)
  77          (write r0 r2))
  78       (if (r1 == r2)
  79           (r1 = ?\xb8)
  80         ((write r1)
  81          (write ,thai-xtis-leading-code)
  82          (write r0 r2)
  83          (r1 = 0))))))
  84
  85 (define-ccl-program ccl-thai-xtis-vowel
  86   `(0
  87     (if (r1 == 0)
  88         ((write ,thai-xtis-leading-code)
  89          (write r0 r2))
  90       (if (r1 == r2)
  91           (r1 = ((r0 - 188) << 3))
  92         ((write r1)
  93          (write ,thai-xtis-leading-code)
  94          (write r0 r2)
  95          (r1 = 0))))))
  96
  97 (define-ccl-program ccl-thai-xtis-vowel-ee
  98   `(0
  99     (if (r1 == 0)
 100         ((write ,thai-xtis-leading-code)
 101          (write r0 r2))
 102       (if (r1 == r2)
 103           (r1 = ?\xf8)
 104         ((write r1)
 105          (write ,thai-xtis-leading-code)
 106          (write r0 r2)
 107          (r1 = 0))))))
 108
 109 (define-ccl-program ccl-thai-xtis-tone
 110   `(0
 111     (if (r1 == 0)
 112         ((write ,thai-xtis-leading-code)
 113          (write r0 r2))
 114       (if (r1 == r2)
 115           ((r0 -= 54)
 116            (write r0)
 117            (r1 = 0))
 118         ((r1 += (r0 - ?\xe6))
 119          (write r1)
 120          (r1 = 0))))))
 121
 122 (define-ccl-program ccl-thai-xtis-symbol
 123   `(0
 124     (if (r1 == 0)
 125         ((write ,thai-xtis-leading-code)
 126          (write r0 r2))
 127       (if (r1 == r2)
 128           ((write r2)
 129            (write ,thai-xtis-leading-code)
 130            (write r0 r2)
 131            (r1 = 0))
 132         ((write r1)
 133          (write ,thai-xtis-leading-code)
 134          (write r0 r2)
 135          (r1 = 0))))))
 136
 137 (define-ccl-program ccl-decode-thai-xtis
 138   `(4
 139     ((read r0)
 140      (r1 = 0)
 141      (r2 = ?\xb0)
 142      (loop
 143       (if (r0 < 161)
 144           (if (r1 == 0)
 145               (write r0)
 146             (if (r1 == r2)
 147                 ((write r2 r0)
 148                  (r1 = 0))
 149               ((write r1 r0)
 150                (r1 = 0))))
 151         (branch (r0 - 161)
 152                 (call ccl-thai-xtis-consonant)
 153                 (call ccl-thai-xtis-consonant)
 154                 (call ccl-thai-xtis-consonant)
 155                 (call ccl-thai-xtis-consonant)
 156                 (call ccl-thai-xtis-consonant)
 157                 (call ccl-thai-xtis-consonant)
 158                 (call ccl-thai-xtis-consonant)
 159                 (call ccl-thai-xtis-consonant)
 160                 (call ccl-thai-xtis-consonant)
 161                 (call ccl-thai-xtis-consonant)
 162                 (call ccl-thai-xtis-consonant)
 163                 (call ccl-thai-xtis-consonant)
 164                 (call ccl-thai-xtis-consonant)
 165                 (call ccl-thai-xtis-consonant)
 166                 (call ccl-thai-xtis-consonant)
 167                 (call ccl-thai-xtis-consonant)
 168                 (call ccl-thai-xtis-consonant)
 169                 (call ccl-thai-xtis-consonant)
 170                 (call ccl-thai-xtis-consonant)
 171                 (call ccl-thai-xtis-consonant)
 172                 (call ccl-thai-xtis-consonant)
 173                 (call ccl-thai-xtis-consonant)
 174                 (call ccl-thai-xtis-consonant)
 175                 (call ccl-thai-xtis-consonant)
 176                 (call ccl-thai-xtis-consonant)
 177                 (call ccl-thai-xtis-consonant)
 178                 (call ccl-thai-xtis-consonant)
 179                 (call ccl-thai-xtis-consonant)
 180                 (call ccl-thai-xtis-consonant)
 181                 (call ccl-thai-xtis-consonant)
 182                 (call ccl-thai-xtis-consonant)
 183                 (call ccl-thai-xtis-consonant)
 184                 (call ccl-thai-xtis-consonant)
 185                 (call ccl-thai-xtis-consonant)
 186                 (call ccl-thai-xtis-consonant)
 187                 (call ccl-thai-xtis-symbol)
 188                 (call ccl-thai-xtis-consonant)
 189                 (call ccl-thai-xtis-symbol)
 190                 (call ccl-thai-xtis-consonant)
 191                 (call ccl-thai-xtis-consonant)
 192                 (call ccl-thai-xtis-consonant)
 193                 (call ccl-thai-xtis-consonant)
 194                 (call ccl-thai-xtis-consonant)
 195                 (call ccl-thai-xtis-consonant)
 196                 (call ccl-thai-xtis-consonant)
 197                 (call ccl-thai-xtis-consonant)
 198                 (call ccl-thai-xtis-symbol)
 199                 (call ccl-thai-xtis-symbol)
 200                 (call ccl-thai-xtis-vowel-d1)
 201                 (call ccl-thai-xtis-symbol)
 202                 (call ccl-thai-xtis-symbol)
 203                 (call ccl-thai-xtis-vowel)
 204                 (call ccl-thai-xtis-vowel)
 205                 (call ccl-thai-xtis-vowel)
 206                 (call ccl-thai-xtis-vowel)
 207                 (call ccl-thai-xtis-vowel)
 208                 (call ccl-thai-xtis-vowel)
 209                 (call ccl-thai-xtis-vowel)
 210                 nil
 211                 nil
 212                 nil
 213                 nil
 214                 (call ccl-thai-xtis-symbol)
 215                 (call ccl-thai-xtis-symbol)
 216                 (call ccl-thai-xtis-symbol)
 217                 (call ccl-thai-xtis-symbol)
 218                 (call ccl-thai-xtis-symbol)
 219                 (call ccl-thai-xtis-symbol)
 220                 (call ccl-thai-xtis-symbol)
 221                 (call ccl-thai-xtis-symbol)
 222                 (call ccl-thai-xtis-tone)
 223                 (call ccl-thai-xtis-tone)
 224                 (call ccl-thai-xtis-tone)
 225                 (call ccl-thai-xtis-tone)
 226                 (call ccl-thai-xtis-tone)
 227                 (call ccl-thai-xtis-tone)
 228                 (call ccl-thai-xtis-tone)
 229                 (call ccl-thai-xtis-vowel-ee)
 230                 (call ccl-thai-xtis-symbol)
 231                 (call ccl-thai-xtis-symbol)
 232                 (call ccl-thai-xtis-symbol)
 233                 (call ccl-thai-xtis-symbol)
 234                 (call ccl-thai-xtis-symbol)
 235                 (call ccl-thai-xtis-symbol)
 236                 (call ccl-thai-xtis-symbol)
 237                 (call ccl-thai-xtis-symbol)
 238                 (call ccl-thai-xtis-symbol)
 239                 (call ccl-thai-xtis-symbol)
 240                 (call ccl-thai-xtis-symbol)
 241                 (call ccl-thai-xtis-symbol)
 242                 (call ccl-thai-xtis-symbol)
 243                 nil
 244                 nil
 245                 nil))
 246       (read r0)
 247       (repeat)))
 248
 249     (if (r1 != 0)
 250         (write r1)
 251       nil)))
 252
 253 (define-ccl-program ccl-encode-thai-xtis
 254   `(1
 255     ((read r0)
 256      (loop
 257       (if (r0 == ,leading-code-private-21)
 258           ((read r1)
 259            (if (r1 == ,(charset-id 'thai-xtis))
 260                ((read r0)
 261                 (write r0)
 262                 (read r0)
 263                 (r1 = (r0 & 7))
 264                 (r0 = ((r0 - ?\xb0) >> 3))
 265                 (if (r0 != 0)
 266                     (write r0 [0 209 212 213 214 215 216 217 218 238]))
 267                 (if (r1 != 0)
 268                     (write r1 [0 231 232 233 234 235 236 237]))
 269                 (read r0)
 270                 (repeat))
 271              ((write r0 r1)
 272               (read r0)
 273               (repeat))))
 274         (write-read-repeat r0))))))
 275
 276 (if (featurep 'xemacs)
 277     (make-coding-system
 278      'tis-620 'ccl
 279      "external=tis620, internal=thai-xtis"
 280      `(mnemonic "TIS620"
 281        decode ,ccl-decode-thai-xtis
 282        encode ,ccl-encode-thai-xtis))
 283   (make-coding-system
 284    'tis-620 4 ?T "external=tis620, internal=thai-xtis"
 285    '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
 286    '((safe-charsets . t)))
 287   )
 288
 289
 290 (set-language-info-alist
 291  "Thai-XTIS"
 292  '((setup-function . setup-thai-xtis-environment)
 293    (exit-function . exit-thai-xtis-environment)
 294    (charset thai-xtis)
 295    (coding-system tis-620 iso-2022-7bit)
 296    (coding-priority tis-620 iso-2022-7bit)
 297    (sample-text . "\e$(?!:\e(B")
 298    (documentation . t)))
 299
 300 ;; thai-xtis.el ends here.