base24: adding base24 encoding.

https://www.kuon.ch/post/2020-02-27-base24/

diff --git a/extra/base24/authors.txt b/extra/base24/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/base24/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/base24/base24-tests.factor b/extra/base24/base24-tests.factor
new file mode 100644 (file)
index 0000000..ba213cc
--- /dev/null
+++ b/extra/base24/base24-tests.factor
@@ -0,0 +1,60 @@
+USING: base24 grouping io.binary kernel math.parser sequences
+tools.test ;
+
+IN: base24.tests
+
+{ 49894920630459842177293598641814316632 } [
+    "2FC28KTA66WRST4XAHRRCF237S8Z" base24> be>
+] unit-test
+
+{ 49894920630459842177293598641814316632 } [
+    "2FC2 8KTA6 6WRST 4XAHR RCF23 7S8Z" base24> be>
+] unit-test
+
+{ 49894920630459842177293598641814316632 } [
+    "2fc2 8kta6 6wrst 4xahr rcf23 7s8z" base24> be>
+] unit-test
+
+{
+  "00000000" "ZZZZZZZ"
+  "00000001" "ZZZZZZA"
+  "00000002" "ZZZZZZC"
+  "00000004" "ZZZZZZB"
+  "00000008" "ZZZZZZ4"
+  "00000010" "ZZZZZZP"
+  "00000020" "ZZZZZA4"
+  "00000040" "ZZZZZCP"
+  "00000080" "ZZZZZ34"
+  "00000100" "ZZZZZHP"
+  "00000200" "ZZZZZW4"
+  "00000400" "ZZZZARP"
+  "00000800" "ZZZZ2K4"
+  "00001000" "ZZZZFCP"
+  "00002000" "ZZZZ634"
+  "00004000" "ZZZABHP"
+  "00008000" "ZZZC4W4"
+  "00010000" "ZZZB8RP"
+  "00020000" "ZZZG5K4"
+  "00040000" "ZZZRYCP"
+  "00080000" "ZZAKX34"
+  "00100000" "ZZ229HP"
+  "00200000" "ZZEFPW4"
+  "00400000" "ZZT7GRP"
+  "00800000" "ZAAESK4"
+  "01000000" "ZCCK7CP"
+  "02000000" "ZB32E34"
+  "04000000" "Z4HETHP"
+  "08000000" "ZP9KZW4"
+  "10000000" "AG8CARP"
+  "20000000" "CSHB2K4"
+  "40000000" "3694FCP"
+  "80000000" "53PP634"
+  "CAFEBABE" "8S8ZRYX"
+  "FFFFFFFF" "X5GGBH7"
+} 2 <groups> [
+    [let
+        first2 [ hex-string>bytes ] dip :> ( a b )
+        { a } [ b base24> ] unit-test
+        { b } [ a >base24 "" like ] unit-test
+    ]
+] each

diff --git a/extra/base24/base24.factor b/extra/base24/base24.factor
new file mode 100644 (file)
index 0000000..434866c
--- /dev/null
+++ b/extra/base24/base24.factor
@@ -0,0 +1,44 @@
+! Copyright (C) 2020 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: ascii assocs base64.private byte-arrays grouping
+io.binary kernel kernel.private literals math sequences ;
+
+IN: base24
+
+ERROR: malformed-base24 ;
+
+<PRIVATE
+
+<<
+CONSTANT: alphabet $[ "ZAC2B3EF4GH5TK67P8RS9WXY" >byte-array ]
+>>
+
+: ch>base24 ( ch -- ch )
+    alphabet nth ;
+
+: base24>ch ( ch -- ch )
+    $[ alphabet alphabet-inverse ] nth
+    [ malformed-base24 ] unless* { fixnum } declare ;
+
+PRIVATE>
+
+:: base24> ( base24 -- seq )
+    BV{ } clone :> accum
+    base24 [ "- " member? ] reject >upper
+    dup length 7 mod 0 assert=
+    7 <groups> [
+        0 [ base24>ch swap 24 * + ] reduce
+        4 >be accum push-all
+    ] each
+    accum B{ } like ;
+
+:: >base24 ( seq -- base24 )
+    BV{ } clone :> accum
+    seq length 4 mod 0 assert=
+    seq 4 <groups> [
+        be> 7 [
+            24 /mod ch>base24 accum push
+        ] times drop
+    ] each
+    accum reverse! B{ } like ;

diff --git a/extra/base24/summary.txt b/extra/base24/summary.txt
new file mode 100644 (file)
index 0000000..f822962
--- /dev/null
+++ b/extra/base24/summary.txt
@@ -0,0 +1 @@
+Base24 encoding/decoding