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                            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
  53 (defvar leading-code-private-21 #x9F)
  54
  55 (defconst thai-xtis-leading-code
  56   (concat (char-to-string leading-code-private-21)
  57           (char-to-string (charset-id 'thai-xtis))))
  58
  59 (define-ccl-program ccl-thai-xtis-consonant
  60   `(0
  61     (if (r1 == 0)
  62         ((write ,thai-xtis-leading-code)
  63          (write r0)
  64          (r1 = r2))
  65       (if (r1 == r2)
  66           ((write r1)
  67            (write ,thai-xtis-leading-code)
  68            (write r0))
  69         ((write r1)
  70          (write ,thai-xtis-leading-code)
  71          (write r0)
  72          (r1 = r2))))))
  73
  74 (define-ccl-program ccl-thai-xtis-vowel-d1
  75   `(0
  76     (if (r1 == 0)
  77         ((write ,thai-xtis-leading-code)
  78          (write r0 r2))
  79       (if (r1 == r2)
  80           (r1 = ?\xb8)
  81         ((write r1)
  82          (write ,thai-xtis-leading-code)
  83          (write r0 r2)
  84          (r1 = 0))))))
  85
  86 (define-ccl-program ccl-thai-xtis-vowel
  87   `(0
  88     (if (r1 == 0)
  89         ((write ,thai-xtis-leading-code)
  90          (write r0 r2))
  91       (if (r1 == r2)
  92           (r1 = ((r0 - 188) << 3))
  93         ((write r1)
  94          (write ,thai-xtis-leading-code)
  95          (write r0 r2)
  96          (r1 = 0))))))
  97
  98 (define-ccl-program ccl-thai-xtis-vowel-ee
  99   `(0
 100     (if (r1 == 0)
 101         ((write ,thai-xtis-leading-code)
 102          (write r0 r2))
 103       (if (r1 == r2)
 104           (r1 = ?\xf8)
 105         ((write r1)
 106          (write ,thai-xtis-leading-code)
 107          (write r0 r2)
 108          (r1 = 0))))))
 109
 110 (define-ccl-program ccl-thai-xtis-tone
 111   `(0
 112     (if (r1 == 0)
 113         ((write ,thai-xtis-leading-code)
 114          (write r0 r2))
 115       (if (r1 == r2)
 116           ((r0 -= 54)
 117            (write r0)
 118            (r1 = 0))
 119         ((r1 += (r0 - ?\xe6))
 120          (write r1)
 121          (r1 = 0))))))
 122
 123 (define-ccl-program ccl-thai-xtis-symbol
 124   `(0
 125     (if (r1 == 0)
 126         ((write ,thai-xtis-leading-code)
 127          (write r0 r2))
 128       (if (r1 == r2)
 129           ((write r2)
 130            (write ,thai-xtis-leading-code)
 131            (write r0 r2)
 132            (r1 = 0))
 133         ((write r1)
 134          (write ,thai-xtis-leading-code)
 135          (write r0 r2)
 136          (r1 = 0))))))
 137
 138 (define-ccl-program ccl-decode-thai-xtis
 139   `(4
 140     ((read r0)
 141      (r1 = 0)
 142      (r2 = ?\xb0)
 143      (loop
 144       (if (r0 < 161)
 145           (if (r1 == 0)
 146               (write r0)
 147             (if (r1 == r2)
 148                 ((write r2 r0)
 149                  (r1 = 0))
 150               ((write r1 r0)
 151                (r1 = 0))))
 152         (branch (r0 - 161)
 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-consonant)
 188                 (call ccl-thai-xtis-symbol)
 189                 (call ccl-thai-xtis-consonant)
 190                 (call ccl-thai-xtis-symbol)
 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-consonant)
 199                 (call ccl-thai-xtis-symbol)
 200                 (call ccl-thai-xtis-symbol)
 201                 (call ccl-thai-xtis-vowel-d1)
 202                 (call ccl-thai-xtis-symbol)
 203                 (call ccl-thai-xtis-symbol)
 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                 (call ccl-thai-xtis-vowel)
 211                 nil
 212                 nil
 213                 nil
 214                 nil
 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-symbol)
 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-tone)
 230                 (call ccl-thai-xtis-vowel-ee)
 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                 (call ccl-thai-xtis-symbol)
 244                 nil
 245                 nil
 246                 nil))
 247       (read r0)
 248       (repeat)))
 249
 250     (if (r1 != 0)
 251         (write r1)
 252       nil)))
 253
 254 (define-ccl-program ccl-encode-thai-xtis
 255   `(1
 256     ((read r0)
 257      (loop
 258       (if (r0 == ,leading-code-private-21)
 259           ((read r1)
 260            (if (r1 == ,(charset-id 'thai-xtis))
 261                ((read r0)
 262                 (write r0)
 263                 (read r0)
 264                 (r1 = (r0 & 7))
 265                 (r0 = ((r0 - ?\xb0) >> 3))
 266                 (if (r0 != 0)
 267                     (write r0 [0 209 212 213 214 215 216 217 218 238]))
 268                 (if (r1 != 0)
 269                     (write r1 [0 231 232 233 234 235 236 237]))
 270                 (read r0)
 271                 (repeat))
 272              ((write r0 r1)
 273               (read r0)
 274               (repeat))))
 275         (write-read-repeat r0))))))
 276
 277 (if (featurep 'xemacs)
 278     (make-coding-system
 279      'tis-620 'ccl
 280      "external=tis620, internal=thai-xtis"
 281      `(mnemonic "TIS620"
 282        decode ,ccl-decode-thai-xtis
 283        encode ,ccl-encode-thai-xtis))
 284   (make-coding-system
 285    'tis-620 4 ?T "external=tis620, internal=thai-xtis"
 286    '(ccl-decode-thai-xtis . ccl-encode-thai-xtis)
 287    '((safe-charsets . t)))
 288   )
 289
 290
 291 (set-language-info-alist
 292  "Thai-XTIS"
 293  '((setup-function . setup-thai-xtis-environment)
 294    (exit-function . exit-thai-xtis-environment)
 295    (charset thai-xtis)
 296    (coding-system tis-620 iso-2022-7bit)
 297    (coding-priority tis-620 iso-2022-7bit)
 298    (sample-text . "\e$(?!:\e(B")
 299    (documentation . t)))
 300
 301 ;; thai-xtis.el ends here.