extra/base32-crockford/base32-crockford.factor

   1 ! Copyright (C) 2019 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: ascii assocs byte-arrays kernel literals math sequences ;
   5
   6 IN: base32-crockford
   7
   8 <PRIVATE
   9
  10 <<
  11 CONSTANT: ALPHABET $[ "0123456789ABCDEFGHJKMNPQRSTVWXYZ" >byte-array ]
  12 >>
  13
  14 CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers-as ]
  15
  16 CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ]
  17
  18 : normalize-base32 ( base32 -- base32' )
  19     CHAR: - swap remove >upper H{
  20         { CHAR: I CHAR: 1 }
  21         { CHAR: L CHAR: 1 }
  22         { CHAR: O CHAR: 0 }
  23     } substitute ;
  24
  25 : parse-base32 ( base32 -- n )
  26     0 swap [ [ 32 * ] [ INVERSE nth + ] bi* ] each ;
  27
  28 PRIVATE>
  29
  30 : base32-crockford> ( base32 -- n )
  31     normalize-base32 parse-base32 ;
  32
  33 : >base32-crockford ( n -- base32 )
  34     dup 0 < [ non-negative-integer-expected ] when
  35     [ dup 0 > ] [ 32 /mod ALPHABET nth ] "" produce-as nip
  36     [ "0" ] when-empty reverse! ;
  37
  38 : base32-crockford-checksum> ( base32 -- n )
  39     normalize-base32 unclip-last [ parse-base32 ] dip
  40     CHECKSUM index over 37 mod assert= ;
  41
  42 : >base32-crockford-checksum ( n -- base32 )
  43     [ >base32-crockford ] keep 37 mod CHECKSUM nth suffix ;