basis/io/encodings/8-bit/8-bit.factor

   1 ! Copyright (C) 2008 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: math.parser arrays io.encodings sequences kernel assocs
   4 hashtables io.encodings.ascii generic parser classes.tuple words
   5 words.symbol io io.files splitting namespaces math
   6 compiler.units accessors classes.singleton classes.mixin
   7 io.encodings.iana fry simple-flat-file ;
   8 IN: io.encodings.8-bit
   9
  10 <PRIVATE
  11
  12 CONSTANT: mappings {
  13     ! encoding-name iana-name file-name
  14     { "latin1" "ISO_8859-1:1987" "8859-1" }
  15     { "latin2" "ISO_8859-2:1987" "8859-2" }
  16     { "latin3" "ISO_8859-3:1988" "8859-3" }
  17     { "latin4" "ISO_8859-4:1988" "8859-4" }
  18     { "latin/cyrillic" "ISO_8859-5:1988" "8859-5" }
  19     { "latin/arabic" "ISO_8859-6:1987" "8859-6" }
  20     { "latin/greek" "ISO_8859-7:1987" "8859-7" }
  21     { "latin/hebrew" "ISO_8859-8:1988" "8859-8" }
  22     { "latin5" "ISO_8859-9:1989" "8859-9" }
  23     { "latin6" "ISO-8859-10" "8859-10" }
  24     { "latin/thai" "TIS-620" "8859-11" }
  25     { "latin7" "ISO-8859-13" "8859-13" }
  26     { "latin8" "ISO-8859-14" "8859-14" }
  27     { "latin9" "ISO-8859-15" "8859-15" }
  28     { "latin10" "ISO-8859-16" "8859-16" }
  29     { "koi8-r" "KOI8-R" "KOI8-R" }
  30     { "windows-1252" "windows-1252" "CP1252" }
  31     { "ebcdic" "IBM037" "CP037" }
  32     { "mac-roman" "macintosh" "ROMAN" }
  33 }
  34
  35 : encoding-file ( file-name -- stream )
  36     "vocab:io/encodings/8-bit/" ".TXT" surround ;
  37
  38 SYMBOL: 8-bit-encodings
  39
  40 TUPLE: 8-bit biassoc ;
  41
  42 : encode-8-bit ( char stream assoc -- )
  43     swapd value-at
  44     [ swap stream-write1 ] [ encode-error ] if* ; inline
  45
  46 M: 8-bit encode-char biassoc>> encode-8-bit ;
  47
  48 : decode-8-bit ( stream assoc -- char/f )
  49     swap stream-read1
  50     [ swap at [ replacement-char ] unless* ]
  51     [ drop f ] if* ; inline
  52
  53 M: 8-bit decode-char biassoc>> decode-8-bit ;
  54
  55 MIXIN: 8-bit-encoding
  56
  57 M: 8-bit-encoding <encoder>
  58     8-bit-encodings get-global at <encoder> ;
  59
  60 M: 8-bit-encoding <decoder>
  61     8-bit-encodings get-global at <decoder> ;
  62
  63 : create-encoding ( name -- word )
  64     "io.encodings.8-bit" create
  65     [ define-singleton-class ]
  66     [ 8-bit-encoding add-mixin-instance ]
  67     [ ] tri ;
  68
  69 PRIVATE>
  70
  71 [
  72     mappings [
  73         first3
  74         [ create-encoding ]
  75         [ dupd register-encoding ]
  76         [ encoding-file flat-file>biassoc 8-bit boa ]
  77         tri*
  78     ] H{ } map>assoc
  79     8-bit-encodings set-global
  80 ] with-compilation-unit