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

   1 ! Copyright (C) 2008 Daniel Ehrenberg, Doug Coleman.
   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 lexer ;
   8 IN: io.encodings.8-bit
   9
  10 <PRIVATE
  11
  12 : encoding-file ( file-name -- stream )
  13     "vocab:io/encodings/8-bit/" ".TXT" surround ;
  14
  15 SYMBOL: 8-bit-encodings
  16 8-bit-encodings [ H{ } clone ] initialize
  17
  18 TUPLE: 8-bit biassoc ;
  19
  20 : encode-8-bit ( char stream assoc -- )
  21     swapd value-at
  22     [ swap stream-write1 ] [ encode-error ] if* ; inline
  23
  24 M: 8-bit encode-char biassoc>> encode-8-bit ;
  25
  26 : decode-8-bit ( stream assoc -- char/f )
  27     swap stream-read1
  28     [ swap at [ replacement-char ] unless* ]
  29     [ drop f ] if* ; inline
  30
  31 M: 8-bit decode-char biassoc>> decode-8-bit ;
  32
  33 MIXIN: 8-bit-encoding
  34
  35 M: 8-bit-encoding <encoder>
  36     8-bit-encodings get-global at <encoder> ;
  37
  38 M: 8-bit-encoding <decoder>
  39     8-bit-encodings get-global at <decoder> ;
  40
  41 : create-encoding ( name -- word )
  42     create-in
  43     [ define-singleton-class ]
  44     [ 8-bit-encoding add-mixin-instance ]
  45     [ ] tri ;
  46
  47 : load-encoding ( name iana-name file-name -- )
  48     [ create-encoding dup ]
  49     [ register-encoding ]
  50     [ encoding-file flat-file>biassoc 8-bit boa ] tri*
  51     swap 8-bit-encodings get-global set-at ;
  52
  53 PRIVATE>
  54
  55 SYNTAX: 8-BIT: scan scan scan load-encoding ;