-
- (define in-biwa #f)
-
- (define idiv (if in-biwa div quotient))
- (define imod (if in-biwa mod remainder))
- (define ls (lambda (n i) (* n (expt 2 i))))
- (define rs (lambda (n i) (if (> i 0) (rs (idiv n 2) (- i 1)) n)))
- (define b64map (map (lambda (p) (map char->integer p)) (list '(#\A #\Z) '(#\a #\z) '(#\0 #\9) '(#\+ #\+) '(#\/ #\/))))
-
- ;; (char->sixtet a-char)
- ;; =>
- ;; (a-six-bit-integer)
- (define char->sixtet (lambda (c)
- (let ([n (char->integer c)])
- (let check-range ([rest b64map] [base 0])
- (let* ([trial (car rest)] [nmin (car trial)] [nmax (cadr trial)])
- (if (and (>= n nmin) (<= n nmax))
- (+ base (- n (car trial)))
- (check-range (cdr rest) (+ base 1 (- nmax nmin)))))))))
-
- ;; (base64->char (string->list a-base64-string))
- ;; =>
- ;; (string->list the-original)
- (define base64->char
- (lambda (source)
- (call-with-values
- (lambda ()
- (let parse-next ([rest source] [offset 0])
- (let parse-sixtet ([rest rest])
- (if (null? rest)
- (values (list) 0)
- (if (memv (car rest) '(#\space #\newline #\tab #\=))
- (parse-sixtet (cdr rest))
- (let ([current (char->sixtet (car rest))])
- (call-with-values (lambda () (parse-next (cdr rest) (imod (+ offset 2) 8)))
- (lambda (result next)
- (values
- (if (= offset 6)
- result
- (append (list (integer->char (+ (imod (ls current (+ offset 2)) (ls 1 8)) (rs next (- 4 offset))))) result))
- current)))))))))
- (lambda (result ignore) result))))
-
- (display (base64->char (string->list "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=")))
-