diff --git a/extra/base85/base85-tests.factor b/extra/base85/base85-tests.factor index 24692819954..9d03c56a89f 100644 --- a/extra/base85/base85-tests.factor +++ b/extra/base85/base85-tests.factor @@ -7,3 +7,15 @@ USING: base85 byte-arrays kernel sequences strings tools.test ; { "00" } [ B{ 0 } >base85 >string ] unit-test { "\0" } [ "00" base85> >string ] unit-test + +{ t } [ 256 >byte-array dup >z85 z85> = ] unit-test +{ "xK#0@zYz85 >string ] unit-test +{ "hello world" } [ "xK#0@zY >string ] unit-test + +{ t } [ 256 >byte-array dup >ascii85 ascii85> = ] unit-test +{ "BOu!rD]j7BEbo7" } [ "hello world" >ascii85 >string ] unit-test +{ "hello world" } [ "BOu!rD]j7BEbo7" ascii85> >string ] unit-test + +{ t } [ 256 >byte-array dup >adobe85 adobe85> = ] unit-test +{ "<~BOu!rD]j7BEbo7~>" } [ "hello world" >adobe85 >string ] unit-test +{ "hello world" } [ "<~BOu!rD]j7BEbo7~>" adobe85> >string ] unit-test diff --git a/extra/base85/base85.factor b/extra/base85/base85.factor index 59d7f297568..d7c7e40f567 100644 --- a/extra/base85/base85.factor +++ b/extra/base85/base85.factor @@ -2,7 +2,7 @@ ! See https://factorcode.org/license.txt for BSD license. USING: base64.private byte-arrays combinators endian io io.encodings.binary io.streams.byte-array kernel kernel.private -literals math namespaces sequences ; +literals math namespaces sequences splitting tr ; IN: base85 ERROR: malformed-base85 ; @@ -10,17 +10,17 @@ ERROR: malformed-base85 ; ?@^_`{|}~" >byte-array ] >> : ch>base85 ( ch -- ch ) - alphabet nth ; inline + base85-alphabet nth ; inline : base85>ch ( ch -- ch ) - $[ alphabet alphabet-inverse ] nth + $[ base85-alphabet alphabet-inverse ] nth [ malformed-base85 ] unless* { fixnum } declare ; inline : encode4 ( seq -- seq' ) @@ -76,3 +76,105 @@ PRIVATE> : >base85-lines ( seq -- base85 ) binary [ binary [ encode-base85-lines ] with-byte-reader ] with-byte-writer ; + +()[]{}@%$#" + >byte-array +] +>> + +TR: base85>z85 $ base85-alphabet $ z85-alphabet ; + +TR: z85>base85 $[ z85-alphabet ";_`|~" append ] $[ base85-alphabet B{ 0 0 0 0 0 } append ] ; + +PRIVATE> + +: >z85 ( seq -- z85 ) + >base85 base85>z85 ; + +: z85> ( z85 -- seq ) + z85>base85 base85> ; + +ERROR: malformed-ascii85 ; + +?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstu" + >byte-array +] +>> + +: ch>ascii85 ( ch -- ch ) + ascii85-alphabet nth ; inline + +: ascii85>ch ( ch -- ch ) + $[ ascii85-alphabet alphabet-inverse ] nth + [ malformed-ascii85 ] unless* { fixnum } declare ; inline + +: encode4' ( seq -- seq' ) + be> [ B{ CHAR: z } ] [ + 5 [ 85 /mod ch>ascii85 ] B{ } replicate-as reverse! nip + ] if-zero ; inline + +: (encode-ascii85) ( stream column -- ) + 4 pick stream-read dup length { + { 0 [ 3drop ] } + { 4 [ encode4' write-lines (encode-ascii85) ] } + [ + drop + [ 4 0 pad-tail encode4' ] + [ length 4 swap - head-slice* write-lines ] bi + (encode-ascii85) + ] + } case ; + +PRIVATE> + +: encode-ascii85 ( -- ) + input-stream get f (encode-ascii85) ; + +be ; inline + +: (decode-ascii85) ( stream -- ) + "\n\r" over read1-ignoring { + { CHAR: z [ B{ 0 0 0 0 } write (decode-ascii85) ] } + { f [ drop ] } + [ + [ 4 "\n\r" pick read-ignoring ] + [ prefix ] bi* dup length { + { 0 [ 2drop ] } + { 5 [ decode5' write (decode-ascii85) ] } + [ + drop + [ 5 CHAR: u pad-tail decode5' ] + [ length 5 swap - head-slice* write ] bi + (decode-ascii85) + ] + } case + ] + } case ; + +PRIVATE> + +: decode-ascii85 ( -- ) + input-stream get (decode-ascii85) ; + +: >ascii85 ( seq -- ascii85 ) + binary [ binary [ encode-ascii85 ] with-byte-reader ] with-byte-writer ; + +: ascii85> ( ascii85 -- seq ) + binary [ binary [ decode-ascii85 ] with-byte-reader ] with-byte-writer ; + +: >adobe85 ( seq -- adobe85 ) + >ascii85 "<~" "~>" surround ; + +: adobe85> ( adobe85 -- seq ) + "<~" ?head t assert= "~>" ?tail t assert= ascii85> ;