guile-examples/web-development/base64-encode-decode/encode.scm

(define-module (encode)
  #:use-module (rnrs base)
  #:use-module ((guile)
                #:select (lambda* λ
                          when unless
                          simple-format
                          peek))
  #:use-module (ice-9 textual-ports)
  ;; SRFI 1: list procedures
  #:use-module (srfi srfi-1)
  #:use-module ((base-64) #:prefix base-64:)
  #:use-module (bit-integers)
  #:use-module (string-helpers)
  #:use-module (pipeline)
  #:export (encode))


(define encode-6-bits
  (λ (bits)
    "Treat bits as an integer index into the vector of base 64 characters."
    (base-64:integer->char bits)))


(define encode-3-chars
  (λ (chars)
    "Encode 3 ASCII characters to base 64 characters."
    (let ([as-ints (map char->integer chars)]
          [char-width 8])
      (let ([concattenated (concat-integers as-ints char-width)]
            ;; a character in base64 is represented by 6 bits
            [char-width-base64 6]
            ;; 63 has all positions set to 1
            [mask-6-bits 63])
        (list->string
         (list (encode-6-bits (bit-integer-get-range concattenated
                                                     6
                                                     (* 3 char-width-base64)))
               (encode-6-bits (bit-integer-get-range concattenated
                                                     6
                                                     (* 2 char-width-base64)))
               (encode-6-bits (bit-integer-get-range concattenated
                                                     6
                                                     char-width-base64))
               (encode-6-bits (bit-integer-get-range concattenated
                                                     6
                                                     0))))))))


(define encode
  (λ (text)
    ;; pad the string with zeros to have a string of a length divisible by 3
    (define text-length (string-length text))
    (define padding-char (integer->char 0))
    (define padding-count
      (let ([last-group-length (remainder text-length 3)])
        (if (> last-group-length 0)
            (- 3 last-group-length)
            0)))
    (define padded-string
      (call-with-output-string
        (λ (port)
          (put-string port text)
          (let iter ([count° padding-count])
            (unless (= count° 0)
              (put-char port padding-char)
              (iter (- count° 1)))))))

    (let ([encoded-with-zeros
           (call-with-output-string
             (λ (port)
               (let iter ([chars° (string->list padded-string)])
                 (unless (null? chars°)
                   ;; (simple-format #t "not yet null: ~a\n" chars°)
                   (put-string port (encode-3-chars (take chars° 3)))
                   (iter (drop chars° 3))))))])
      ;; Remove the zeros which were only added to get a multiple of 3
      ;; in character count.
      (let ([encoded-without-zeros
             (substring encoded-with-zeros
                        0
                        (- (string-length encoded-with-zeros) padding-count))])
        ;; Add the = characters, to indicate the used padding count in
        ;; the resulting string.
        (string-append encoded-without-zeros
                       (string-repeat "=" padding-count))))))