extra/yenc/yenc.factor

   1 ! Copyright (C) 2022 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs checksums checksums.crc32 combinators
   5 endian formatting io.encodings.binary io.files io.files.info
   6 kernel make math math.functions math.order namespaces sequences
   7 splitting strings ;
   8
   9 IN: yenc
  10
  11 ! TODO: Support yparts
  12
  13 SYMBOL: yenc-line-length
  14 yenc-line-length [ 128 ] initialize
  15
  16 <PRIVATE
  17
  18 : yenc-line% ( -- )
  19     building get length yenc-line-length get
  20     [ 2 + ] bi@ divisor? [ "\r\n" % ] when ;
  21
  22 : yenc% ( bytes -- )
  23     [
  24         42 + 256 mod
  25         dup "\0\r\n=" member? [ CHAR: = , 64 + 256 mod ] when ,
  26         yenc-line%
  27     ] each ;
  28
  29 PRIVATE>
  30
  31 : yenc ( bytes -- yenc )
  32     [ yenc% ] B{ } make ;
  33
  34 <PRIVATE
  35
  36 : ybegin% ( path -- )
  37     [ file-info size>> yenc-line-length get ] keep
  38     "=ybegin size=%d line=%d name=%s\n" sprintf % ;
  39
  40 : yend% ( path -- )
  41     [ file-info size>> ] [ crc32 checksum-bytes be> ] bi
  42     "\n=yend size=%d crc32=%08X" sprintf % ;
  43
  44 PRIVATE>
  45
  46 : yenc-file ( path -- yenc )
  47     [
  48         [ ybegin% ]
  49         [ binary file-contents yenc% ]
  50         [ yend% ] tri
  51     ] B{ } make ;
  52
  53 <PRIVATE
  54
  55 : ydec, ( encode? ch -- encode?' )
  56     dup "\r\n" member? [ drop ] [
  57         2dup [ not ] [ CHAR: = = ] bi* and [ 2drop t ] [
  58             over [ 64 - [ drop f ] dip ] when
  59             dup 0 41 between? [ 214 + ] [ 42 - ] if ,
  60         ] if
  61     ] if ;
  62
  63 PRIVATE>
  64
  65 : ydec ( yenc -- bytes )
  66     [ f swap [ ydec, ] each drop ] B{ } make ;
  67
  68 <PRIVATE
  69
  70 : parse-metadata ( line -- metadata )
  71     >string " " split [ "=" split1 ] H{ } map>assoc ;
  72
  73 : find-metadata ( lines type -- metadata i )
  74    [ '[ _ head? ] find ] keep ?head drop parse-metadata swap ;
  75
  76 PRIVATE>
  77
  78 : ydec-file ( yenc -- ybegin yend bytes )
  79     "\n" split {
  80         [ "=ybegin " find-metadata 1 + ]
  81         [ "=yend " find-metadata swapd ]
  82         [ <slice> ]
  83     } cleave [
  84         f swap [ [ ydec, ] each ] each drop
  85     ] B{ } make ;