extra/base85/base85.factor

   1 ! Copyright (C) 2013 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: base64.private combinators io io.binary
   4 io.encodings.binary io.streams.byte-array kernel literals math
   5 namespaces sequences ;
   6 IN: base85
   7
   8 ERROR: malformed-base85 ;
   9
  10 <PRIVATE
  11
  12 <<
  13 CONSTANT: alphabet
  14     "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!#$%&()*+-;<=>?@^_`{|}~\";"
  15 >>
  16 : ch>base85 ( ch -- ch )
  17     alphabet nth ; inline
  18
  19 : base85>ch ( ch -- ch )
  20     $[ alphabet alphabet-inverse ] nth
  21     [ malformed-base85 ] unless* ; inline
  22
  23 : encode4 ( seq -- seq' )
  24     be> 5 [ 85 /mod ch>base85 ] B{ } replicate-as reverse! nip ; inline
  25
  26 : (encode-base85) ( stream column -- )
  27     4 pick stream-read dup length {
  28         { 0 [ 3drop ] }
  29         { 4 [ encode4 write-lines (encode-base85) ] }
  30         [ drop 4 0 pad-tail encode4 write-lines (encode-base85) ]
  31     } case ;
  32
  33 PRIVATE>
  34
  35 : encode-base85 ( -- )
  36     input-stream get f (encode-base85) ;
  37
  38 : encode-base85-lines ( -- )
  39     input-stream get 0 (encode-base85) ;
  40
  41 <PRIVATE
  42
  43 : decode5 ( seq -- )
  44     0 [ [ 85 * ] [ base85>ch ] bi* + ] reduce 4 >be
  45     [ zero? ] trim-tail-slice write ; inline
  46
  47 : (decode-base85) ( stream -- )
  48     5 "\n\r" pick read-ignoring dup length {
  49         { 0 [ 2drop ] }
  50         { 5 [ decode5 (decode-base85) ] }
  51         [ malformed-base85 ]
  52     } case ;
  53
  54 PRIVATE>
  55
  56 : decode-base85 ( -- )
  57     input-stream get (decode-base85) ;
  58
  59 : >base85 ( seq -- base85 )
  60     binary [ binary [ encode-base85 ] with-byte-reader ] with-byte-writer ;
  61
  62 : base85> ( base85 -- seq )
  63     binary [ binary [ decode-base85 ] with-byte-reader ] with-byte-writer ;
  64
  65 : >base85-lines ( seq -- base85 )
  66     binary [ binary [ encode-base85-lines ] with-byte-reader ] with-byte-writer ;