base85: adding ascii85, adobe85, and z85.

mrjbq7 · Aug 4, 2024 · 436b082 · 436b082
1 parent 143f1b2
commit 436b082
Show file tree

Hide file tree

Showing 2 changed files with 118 additions and 4 deletions.
diff --git 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 <iota> >byte-array dup >z85 z85> = ] unit-test
+{ "xK#0@zY<mxA+]m" } [ "hello world" >z85 >string ] unit-test
+{ "hello world" } [ "xK#0@zY<mxA+]m" z85> >string ] unit-test
+
+{ t } [ 256 <iota> >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 <iota> >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
@@ -2,25 +2,25 @@
 ! 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 ;
 
 <PRIVATE
 
 <<
-CONSTANT: alphabet $[
+CONSTANT: base85-alphabet $[
     "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!#$%&()*+-;<=>?@^_`{|}~"
     >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 ;
+
+<PRIVATE
+
+<<
+CONSTANT: z85-alphabet $[
+    "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ.-:+=^!/*?&<>()[]{}@%$#"
+    >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 ;
+
+<PRIVATE
+
+<<
+CONSTANT: ascii85-alphabet $[
+    "!\"#$%&'()*+,-./0123456789:;<=>?@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) ;
+
+<PRIVATE
+
+: decode5' ( seq -- seq' )
+    0 [ [ 85 * ] [ 33 - ] bi* + ] reduce 4 >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> ;