extra/base85/base85.factor

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