extra/base24/base24.factor

   1 ! Copyright (C) 2020 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: ascii base64.private byte-arrays endian grouping
   5 kernel kernel.private literals math sequences ;
   6
   7 IN: base24
   8
   9 ERROR: malformed-base24 ;
  10
  11 <PRIVATE
  12
  13 <<
  14 CONSTANT: alphabet $[ "ZAC2B3EF4GH5TK67P8RS9WXY" >byte-array ]
  15 >>
  16
  17 : ch>base24 ( ch -- ch )
  18     alphabet nth ;
  19
  20 : base24>ch ( ch -- ch )
  21     $[ alphabet alphabet-inverse ] nth
  22     [ malformed-base24 ] unless* { fixnum } declare ;
  23
  24 PRIVATE>
  25
  26 :: base24> ( base24 -- seq )
  27     BV{ } clone :> accum
  28     base24 [ "- " member? ] reject >upper
  29     dup length 7 mod 0 assert=
  30     7 <groups> [
  31         0 [ base24>ch swap 24 * + ] reduce
  32         4 >be accum push-all
  33     ] each
  34     accum B{ } like ;
  35
  36 :: >base24 ( seq -- base24 )
  37     BV{ } clone :> accum
  38     seq length 4 mod 0 assert=
  39     seq 4 <groups> [
  40         be> 7 [
  41             24 /mod ch>base24 accum push
  42         ] times drop
  43     ] each
  44     accum reverse! B{ } like ;