-: (write-lines) ( column byte-array -- column' )
- output-stream get dup '[
- _ stream-write1 1 + dup 76 = [
- drop B{ CHAR: \r CHAR: \n } _ stream-write 0
- ] when
- ] each ; inline
-
-: write-lines ( column byte-array -- column' )
- over [ (write-lines) ] [ write ] if ; inline
-
-: encode3 ( seq -- byte-array )
- be> { -18 -12 -6 0 } '[
- shift 0x3f bitand ch>base64
- ] with B{ } map-as ; inline
-
-: encode-pad ( seq n -- byte-array )
- [ 3 0 pad-tail encode3 ] [ 1 + ] bi* head-slice
- 4 CHAR: = pad-tail ; inline
-
-: (encode-base64) ( stream column -- )
- 3 pick stream-read dup length {
- { 0 [ 3drop ] }
- { 3 [ encode3 write-lines (encode-base64) ] }
- [ encode-pad write-lines (encode-base64) ]
- } case ;
+: encode3 ( x y z -- a b c d )
+ { fixnum fixnum fixnum } declare {
+ [ [ -2 shift ch>base64 ] [ 2 bits 4 shift ] bi ]
+ [ [ -4 shift bitor ch>base64 ] [ 4 bits 2 shift ] bi ]
+ [ [ -6 shift bitor ch>base64 ] [ 6 bits ch>base64 ] bi ]
+ } spread ; inline
+
+:: (stream-write-lines) ( column data stream -- column' )
+ column data over 71 > [
+ [
+ stream stream-write1 1 + dup 76 = [
+ drop 0
+ B{ CHAR: \r CHAR: \n } stream stream-write
+ ] when
+ ] each
+ ] [
+ stream stream-write 4 +
+ ] if ; inline
+
+: stream-write-lines ( column data stream -- column' )
+ pick [ (stream-write-lines) ] [ stream-write ] if ; inline
+
+: write-lines ( column data -- column' )
+ output-stream get stream-write-lines ; inline
+
+:: (encode-base64) ( input output column -- )
+ 4 <byte-array> :> data
+ column [ input stream-read1 dup ] [
+ input stream-read1
+ input stream-read1
+ [ [ 0 or ] bi@ encode3 ] 2keep [ 0 1 ? ] bi@ + {
+ { 0 [ ] }
+ { 1 [ drop CHAR: = ] }
+ { 2 [ 2drop CHAR: = CHAR: = ] }
+ } case data (4sequence) output stream-write-lines
+ ] while 2drop ; inline